编写网络寻呼机
作者：岳兵
提起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 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
ErrHandle:
If Err.Number = sckBadState Then `连接不正确
CurUser(I).ClientConnected = False
CurUser(I).ClientIP = ""
Unload tcpServer(I)
Resume Next
End If
End Sub
本程序仅提供了用Visual Basic 编写网络寻呼的思路和主要部分的实现过程，至于主叫方和被叫方建立连接后的通信并未扩展，读者若有兴趣，可在这方面加入具体的实现代码，就可以给本程序增加更多的功能，如实时聊天，语音对话等。如果在服务器程序检索到被叫方时，分别通知两者客户端程序，使主叫方和被叫方直接利用IP地址进行连接，则两者的连接速度将会有大幅度的提高。
用VB制作浏览器
自己做浏览器？有没有搞错？不要说像IE这样的庞然大物，就是小巧的Opera，我们大多数普通人也决计搞不出来。但如果你的机器里装有VB5.0专业版，那么事情就好办多了，想试试吗？那好，Let`s go!
程序的主角是一个ActiveX控件：WebBrowser。当然，缺省状态下VB的工具箱中并没有它，我们得手工加入，方法是：右击工具箱，在出现的快捷菜单中选择“部件...”，确保在弹出的对话框中选中“控件”标签，找到Microsoft Internet Controls，在它前面的小框中打钩，然后确定。此时你会发现工具箱中多了两个小图标，其中，地球图标代表的控件正是我们需要的WebBrowser。
由于许多人对WebBrowser控件不是很熟悉，VB的帮助中也没有有关它的内容（反正我没有找到），因此有必要介绍一下它的属性、方法和事件，限于篇幅，我们只涉及程序中用到的：
属性：LocationURL 返回控件显示WEB页面的URL。
方法：Navigate 转移到指定的URL或打开指定HTML文件。
事件：1．DownloadBegin 下载操作开时触发。
2．DownloadComplete 下载操作完成、终止或失败时触发。
3．ProgressChange WebBrowser控件跟踪下载操作的过程，并定期触发此事件。其语法为：Sub WebBrowser_ProgressChange (ByVal Progress As Long, ByVal ProgressMax As Long)。Progress变元是当前已下载的数据总量，ProgressMax变元是将要下载的数据总量。
4．TitleChange 当前文档标题改变时触发
除了WebBrowser控件外，程序还需要一个Label控件：Label1；一个ComboBox控件：combo1，用来显示URL地址；一个StatusBar控件：StatusBar1；一个ProgressBar控件：ProgressBar1，用来显示下载进度（StatusBar控件和ProgressBar控件是ActiveX控件Microsoft Windows Common Controls5.0的成员，加入工具箱的方法同WebBrowser控件），这些控件的属性值都用缺省值。
以下是程序清单：
Option Explicit
Private Sub Form_Load()
Me.Caption =“My Explorer”
Label1.Caption = “URL”
Combo1.Text = “”
Combo1.Top = Label1.Height
Combo1.Left = 0
WebBrowser1.Top = Combo1.Top ＋ Combo1.Height
WebBrowser1.Left = 0
Form_Resize
StatusBar1.Style = sbrSimple
ProgressBar1.ZOrder
End Sub
Private Sub Form_Resize()
On Error GoTo a
Combo1.Width = Form1.Width － 100
WebBrowser1.Width = Combo1.Width
WebBrowser1.Height = Form1.Height － Combo1.Height － 1000
ProgressBar1.Top = Me.Height － StatusBar1.Height － 330
ProgressBar1.Left = 0.25 ＊ StatusBar1.Width
ProgressBar1.Width = 0.75 ＊ Me.Width － 250
a:
End Sub
Private Sub Combo1_Click()
`转到指定网址
WebBrowser1.Navigate Combo1.Text
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim i As Long
Dim existed As Boolean
If KeyCode = 13 Then
If Left(Combo1.Text, 7) <> “http://”Then
Combo1.Text = “http://”＋ Combo1.Text
End If
WebBrowser1.Navigate Combo1.Text
For i = 0 To Combo1.ListCount － 1
If Combo1.List(I) = Combo1.Text Then
existed = True
Exit For
Else
existed = False
End If
Next
If Not existed Then
Combo1.AddItem (Combo1.Text)
End If
End If
End Sub
Private Sub WebBrowser1_DownloadBegin()
`下载开始时状态栏显示“Now Linking...”
StatusBar1.SimpleText = “Now Linking...”
End Sub
Private Sub WebBrowser1_DownloadComplete()
`下载完成时状态栏显示“Link Finished”
StatusBar1.SimpleText = “Link Finished”
ProgressBar1.Value = 0
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long,
ByVal ProgressMax As Long)
`下载进行时进度条变化
If ProgressMax = 0 Then Exit Sub
ProgressBar1.Max = ProgressMax
If Progress <> －1 And Progress <= ProgressMax Then
ProgressBar1.Value = Progress
End If
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Combo1.Text = WebBrowser1.LocationURL
End Sub
