用VB編寫網絡尋呼 

河南省南陽市 岳兵

　　提起ICQ的大名，愛好電腦的朋友一定不會感到陌生的吧？ICQ就是互聯網上的尋呼機，無論什么時候，只要你的朋友在線，你只需在ICQ中輸入他的ID號碼，你就可以在互聯網上呼到他。ICQ由于其方便、快捷，且擁有眾多的注冊用戶而一舉成為互聯網上最流行的網絡尋呼機，它幾乎成為每一個上網用戶的必備之物。當你在使用ICQ的時候，是否會想過自己動手編寫一個網絡尋呼機呢？這其實在VB中就可以實現。
　　網絡尋呼的原理就是當客戶端程序連接服務器時，通過服務器搜索所要呼叫的ID號碼，如果檢測到此用戶且該用戶正處于聯網狀態，則服務器通知此用戶的客戶端程序響應主叫方客戶端程序，然后在主叫方和被叫方建立連接后，雙方就可以聊天或進行其它的通信。
　　在VB中編寫網絡尋呼機需要建立兩個程序，一個為客戶端程序Client，一個為服務器端程序Server。

　　一、在Client工程中建立一個窗體，加載WinSock控件，稱為tcpClient，協議選擇TCP。再加入四個文本框，用以輸入服務器的IP地址、服務器端口號，被呼叫的網絡尋呼ID號以及用戶登錄ID號。然后再在窗體中加入三個按鈕，分別命名為“連接”、“斷開”和“退出”，點擊“連接”按鈕，并進行如下初始化連接，代碼如下：

　Private Sub Command1_Click()
　　If Len(Text1.Text) = 0 And Len(Text2.Text) = 0 Then
　　　MsgBox ("請輸入主機名或主機IP地址。")
　　　Exit Sub
　　ElseIf Len(Text1.Text) > 0 Then
　　　tcpClient.RemoteHost = Text1.Text
　　　tcpClient.RemotePort = Text2.Text
　　End If
　　tcpClient.Connect
　　Timer1.Enabled = True
　End Sub

　Private Sub Command2_Click()
　　tcpClient.Close　　　'斷開連接
　End Sub

　Private Sub Command3_Click()
　　End
　End Sub

　Private Sub Form_Load()
　　Text2.Text = "1001"
　End Sub 

　Private Sub tcpClient_Connect()
　　tcpClient.SendData (Text3.Text&"@"&Text4.Text)
　End Sub

　Private Sub tcpClient_DataArrival(ByVal bytesTotal As Long)
　　Dim strData As String
　　tcpClient.GetData strData
　　strData = strData + "呼叫"
　　'在收到呼叫消息后彈出一對話框并顯示主叫方ID號碼
　　MsgBox (strData)
　End Sub

　　二、在服務器端Server工程中也建立一個窗體，加載WinSock控件，稱為tcpServer，協議選擇TCP，設置其Index值為0，并在工程中添加模塊。

　　內容如下：

　Private Type ActiveUser
　　ClientIP As String '記錄客戶的IP地址
　　ClientPort As Integer '記錄當前會話的端口
　　ClientID As Long '記錄客戶的ID號碼
　　ClientConnected As Boolean '客戶連接狀態，True表示已連接，False表示沒有連接
　End Type
　Dim CurUser() As ActiveUser
　Dim tcpIndex As Integer '跟蹤當前建立連接數

　　在Form_Load事件中加入如下代碼：

　Private Sub Form_Load()
　　tcpServer(0).Protocol = sckTCPProtocol
　　tcpServer(0).LocalPort = 1001 '將 LocalPort 屬性設置為一個整數。
　　tcpServer(0).Listen '然后調用 Listen 方法。
　　tcpIndex = 1
　End Sub

　　準備應答客戶端程序的請求連接，使用ConnectionRequest事件來應答戶端程序的請求，代碼如下：


　Private Sub tcpServer_ConnectionRequest (Index As Integer, ByVal requestID As Long)
　　Dim i As Integer
　　On Error GoTo ErrHandle
　　For i = 1 To tcpIndex '選擇一個空閑端口
　　　If CurUser(i).ClientConnected = False And i <> tcpIndex Then
　　　　Load tcpServer(i)
　　　　tcpServer(i).LocalPort = CurUser(i).ClientPort - 1
　　　　tcpServer(i).Accept requestID
　　　　Exit For
　　　ElseIf CurUser(i).ClientConnected = False Then
　　　　Load tcpServer(i)
　　　　tcpServer(i).LocalPort = Port
　　　　If tcpServer(i).State <> sckClosed Then
　　　　　tcpServer(i).Close
　　　　End If
　　　　tcpServer(i).Accept requestID
　　　　Exit For
　　　End If
　　　Next DoEvents
　　　'測試連接是否成功
　　　If tcpServer(i).State = sckConnected Then
　　　　If i = tcpIndex Then
　　　　'已經沒有可用端口,記錄客戶的IP地址和端口號
　　　　tcpIndex = tcpIndex + 1
　　　　Port = Port + 1
　　　　ReDim Preserve CurUser(tcpIndex)
　　　　CurUser(i).ClientIP = tcpServer(i).RemoteHostIP
　　　　CurUser(i).ClientConnected = True
　　　　CurUser(i).ClientPort = Port
　　　　CurUser(tcpIndex).ClientConnected = False
　　　Else
　　　　CurUser(i).ClientIP = tcpServer(i).RemoteHostIP
　　　　CurUser(i).ClientPort = Port
　　　　CurUser(i).ClientConnected = True
　　　End If
　　End If
　　Exit Sub
　ErrHandle:
　　Resume Next
　　'檢查控件的 State 屬性,如未關閉，在接受新的連接之前關閉此連接。
　　If tcpServer(0).State <> sckClosed Then
　　　tcpServer(0).Close
　　　tcpServer(0).Accept requestID '接受具有 requestID 參數的,連接。
　　End If
　End Sub

　Private Sub tcpServer_DataArrival(Index As Integer, ByVal bytesTotal As Long)
　　Dim i As Integer
　　Dim s As String
　　Dim RequID As Long '主叫方ID號碼 
　　Dim SearchID As Long '被叫方ID號碼
　　On Error GoTo ErrHandle
　　tcpServer(Index).GetData s, vbString '接收數據并存入s　
　　If Mid(s, i, 1) = "@" Then
　　'分離s中的主叫方和被叫方ID號碼
　　　SearhID = Left(s, i - 1) '把號存入mKey
　　　RequID = Right(s, Len(s) - i) 'ID存入RequID
　　End If
　　'如果是請求尋呼某一ID號碼,則檢索當前此ID用戶是否登錄（即CurUser數組中是否存在此用戶）,然后發送信息，通知此用戶響應呼叫并顯示主叫用戶ID號碼。
　　For i = 1 To tcpIndex
　　　If RequID = CurUser(i).ClientID And CurUser(i) .ClientConnected = True Then
　　　　tcpServer(i).SendData (SearhID)
　　　End If
　　Next
　　Exit Sub
　Sub ErrHandle:
　　If Err.Number = sckBadState Then '連接不正確
　　　CurUser(i).ClientConnected = False
　　　CurUser(i).ClientIP = ""
　　　Unload tcpServer(i)
　　　Resume Next
　　End If
End Sub