背景：因工作上使用者提出一個需求，當手術室開始動刀的同時，希望能將訊息自動即時通知護理站之人員，並撥放音效。
Note：此功能只有在XP系統以上方可支援，不支援Win2000以下作業系統。
概念：
P2P概念：本身是伺服器(監聽者)，可以傾聽其他電腦對自己的呼叫並作出回應的能力，同時也是用戶端可以對其他電腦作出請求的動作。
前置作業：
1.建立一個table進行IP 之Mapping
2.在畫面上佈制WebBrower元件作為顯示接收訊息用
3.利用BackgroundWorker元件建立非同步作業
4.利用Timmer之Tick事件在接收訊後將訊息顯示於WebBrower上
事件撰寫：
Server功能：
1.在Form_load利用BackgroundWorker元件建立非同步執行緒啟動監聽功能，並讓Timmer開始運作
2.在BackgroundWorker 之DoWork內撰寫監聽功能程式
3.在Timer之Tick市件內撰寫接收訊息處理程式
以上即為Server部分之功能，可對其他電腦所發出之請求進行監聽，並在接收訊息後將訊息顯示於WebBrower物件上。
Client功能：
1.在Button之Click事件觸發SendMessage(目的地之IP位置由Mapping Table取得)
其他相關事件：
1.form Close時需將執行緒取消
程式碼：
Server部分：
Dim sp As New System.Media.SoundPlayer '撥放通知音效
Dim db As dbAccess
Dim IP_ADDRESS As String
Private Sub FrmMain01_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.WebBrowser1.Navigate("about:blank")
If My.Computer.Network.IsAvailable = False Then
MsgBox("您沒有連上網路，本程式無法執行", MsgBoxStyle.Critical)
Me.Close()
End If
'取得欲傳送訊息之OR護理站IP位置
Dim sql As String
Dim dtQry As New DataTable
sql = "select * from Surgery where SurgeryId='01'"
dtQry = db.GetData(sql)
IP_ADDRESS = IIf(IsDBNull(dtQry.Rows(0)("ORIP")), "", dtQry.Rows(0)("ORIP").ToString)
If IP_ADDRESS = "" Then
MsgBox("尚未設定對應之OR護理站之IP位置!")
End If
'開始傾聽(啟動多執行緒)
If Not BackgroundWorker.IsBusy Then
BackgroundWorker.RunWorkerAsync()
End If
'Timer開始運作
Me.Timer1.Enabled = True
End Sub
Public Function Decrypt(ByVal inputString As String, ByVal decryptKey As String) As String
Dim byKey As Byte() = Nothing
Dim IV As Byte() = {1, 2, 3, 4, 5, 6, 7, 8}
Dim inputByteArray(inputString.Length) As Byte
Try
byKey = System.Text.Encoding.UTF8.GetBytes(Right(decryptKey.PadRight(8), 8))
Dim des As DESCryptoServiceProvider = New DESCryptoServiceProvider
inputByteArray = Convert.FromBase64String(inputString)
Dim ms As MemoryStream = New MemoryStream
Dim cs As CryptoStream = New CryptoStream(ms, des.CreateDecryptor(byKey, IV), CryptoStreamMode.Write)
cs.Write(inputByteArray, 0, inputByteArray.Length)
cs.FlushFinalBlock()
Dim encoding As System.Text.Encoding = New System.Text.UTF8Encoding
Return encoding.GetString(ms.ToArray)
Catch er As System.Exception
Throw New Exception(Decrypt = er.Message)
Return Nothing
End Try
End Function
'利用BackGroupdWorker元件啟動多執行緒(非同步)，進行監聽服務
Private Sub BackgroundWorker_DoWork(ByVal sender As System.Object, ByVal e As System.ComponentModel.DoWorkEventArgs) Handles BackgroundWorker.DoWork
MainProcess()
End Sub
Sub MainProcess()
Dim Ports() As String = {"http://*:80/"}
ListenerProcess(Ports)
End Sub
'啟動監聽服務(listener)
Public Sub ListenerProcess(ByVal prefixes As String())
Static flag As Boolean = False
If flag = True Then Exit Sub
flag = True
If Not HttpListener.IsSupported Then
MsgBox("此系統需要 Windows XP 且安裝 SP2 以上版本 或 Server 2003 才可以使用.", MsgBoxStyle.Critical)
End
End If
'prefixes是傳入的參數(port)
If prefixes Is Nothing OrElse prefixes.Length = 0 Then
Throw New ArgumentException("連接port不正常")
End If
'加入連接port
Dim listener As HttpListener = New HttpListener
For Each s As String In prefixes
listener.Prefixes.Add(s)
Next
'開始
listener.Start()
Do While True
Application.DoEvents()
Dim context As HttpListenerContext = listener.GetContext
Dim request As HttpListenerRequest = context.Request
Dim response As HttpListenerResponse = context.Response
Dim msg As String
msg = Microsoft.VisualBasic.Right(request.RawUrl, Len(request.RawUrl) - 1)
'將訊息解密
msg = Decrypt(msg, "Key")
'輸出字串
TalkingMsg += msg & "<font color=gray size=2>(" & request.UserHostAddress & ")</font><br>"
Dim responseString As String = "Get:" & request.RawUrl & "......"
Dim buffer As Byte() = System.Text.Encoding.UTF8.GetBytes(responseString)
response.ContentLength64 = buffer.Length
Dim output As System.IO.Stream = response.OutputStream
output.Write(buffer, 0, buffer.Length)
output.Close()
Application.DoEvents()
Loop
listener.Stop()
End Sub
'利用Timmer 若有接收到訊息，則將訊息顯示在WebBrowser元件，並撥放通知音效
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If TalkingMsg <> "" Then
Me.WebBrowser1.Document.Body.InnerHtml = TalkingMsg & Me.WebBrowser1.Document.Body.InnerHtml
TalkingMsg = ""
'撥放通知音效
PlaySound()
End If
End Sub
'撥放通知音效
Public Sub PlaySound()
'設定音效撥放路徑
sp.SoundLocation = PlayPath
'取得音效
sp.LoadAsync()
'判斷音效是否取得
If sp.IsLoadCompleted = True Then
'循環撥放音效
sp.Play()
sp.PlayLooping()
End If
End Sub
Client部分：
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
SendMsg("啟動下台刀，病患姓名：MARY", IP_ADDRESS) '送出通知訊息
End Sub
'傳送訊息(Flownm:通知訊息 / IP_ADDRESS:IP位置)
Public Sub SendMsg(ByVal Flownm As String, ByVal IP_ADDRESS As String)
Dim URL As String
'從輸入區取得要傳送給對方的訊息
Dim msg As String = "通知訊息：啟動流程-" & Flownm
'初步處理(文字處理)
msg = Trim(msg)
If Microsoft.VisualBasic.Left(msg, 2) = vbCrLf Then msg = Microsoft.VisualBasic.Right(msg, Len(msg) - 2)
If Trim(Replace(msg, vbCrLf, "")) = "" Then Exit Sub
'在訊息前加入自己的暱稱(加入通知之護理站名稱及IP)
'msg = "<font color=Blue><b>" & Me.txb_MyName.Text & "</b></font>:" & msg
'先顯示在自己的畫面上
'Me.WebBrowser1.Document.Body.InnerHtml = msg & "<br>" + Me.WebBrowser1.Document.Body.InnerHtml
'將訊息加密
msg = Encrypt(msg, "Key")
'透過HttpRquest方式傳送給對方(使用標準80Port)
URL = "http://" & IP_ADDRESS & ":80/" & msg
If GetWebPage(URL) = "" Then MsgBox("無法傳遞啟動訊息，請檢查對方IP位置，或是您的連線狀態。", MsgBoxStyle.Critical)
End Sub
'取得網頁HTML
Public Function GetWebPage(ByVal URL As String, Optional ByVal proxy As String = "") As String
Dim proxyObject As System.Net.WebProxy
Dim proxyString As String
On Error GoTo err
'準備讀取資料
Dim MyRequest As System.Net.HttpWebRequest = System.Net.WebRequest.Create(URL)
'讀取registry看看是否需要 proxy
proxyString = proxy
If proxyString <> "" Then
'設定proxy
proxyObject = New System.Net.WebProxy(proxyString, True)
MyRequest.Proxy = proxyObject
End If
'讀取遠端網頁
Dim MyWebResponse As System.Net.WebResponse = MyRequest.GetResponse()
Dim MyStream As System.IO.Stream
MyStream = MyWebResponse.GetResponseStream
'使用預設的編碼方式 --> System.Text.Encoding.Default
Dim StreamReader As New System.IO.StreamReader(MyStream, System.Text.Encoding.Default)
GetWebPage = StreamReader.ReadToEnd()
err:
If Err.Number <> 0 Then GetWebPage = Nothing
MyRequest = Nothing
MyWebResponse = Nothing
MyStream = Nothing
StreamReader = Nothing
proxyObject = Nothing
End Function
Public Function Encrypt(ByVal inputString As String, ByVal encryptKey As String) As String
Dim byKey As Byte() = Nothing
Dim IV As Byte() = {1, 2, 3, 4, 5, 6, 7, 8}
Try
byKey = System.Text.Encoding.UTF8.GetBytes(Right(encryptKey.PadRight(8), 8))
Dim des As DESCryptoServiceProvider = New DESCryptoServiceProvider
Dim inputByteArray As Byte() = System.Text.Encoding.UTF8.GetBytes(inputString)
Dim ms As MemoryStream = New MemoryStream
Dim cs As CryptoStream = New CryptoStream(ms, des.CreateEncryptor(byKey, IV), CryptoStreamMode.Write)
cs.Write(inputByteArray, 0, inputByteArray.Length)
cs.FlushFinalBlock()
Return Convert.ToBase64String(ms.ToArray)
Catch er As System.Exception
Throw New Exception(er.Message)
Return Nothing
End Try
End Function
其他相關事件：
'form close時記得將執行緒取消
Private Sub FrmMain01_FormClosing(ByVal sender As System.Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles MyBase.FormClosing
If BackgroundWorker.IsBusy Then
BackgroundWorker.CancelAsync()
End If
End Sub
Private Sub Button10_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button10.Click
StopPlaySound()
End Sub
'停止撥放音效
Public Sub StopPlaySound()
sp.Stop()
End Sub
沒有留言:
張貼留言