97.txt

VB文章集（含API、窗口、数据库、多媒体、系统、文件、等等）

用Visual Basic6.0编写客户服务器程序 

冯  勇

Visual Basic6.0提供了Winsock控件，支持网络上两台计算机之间的通信。利用它，编程人员可以毫不费力地编写出TCP/IP客户/服务器程序。以下是用Visual Basic6.0的Winsock控件编写的网络聊天程序的实例。 

一．客户程序的实现方法： 

1．客户程序设置RemoteHost（远程主机）属性，指定运行服务器的主机名。 

2．通过设置RemotePort属性，指定服务器程序的侦听端口。 

3．客户程序使用Connect方法向服务器发送连接请求。 

4．服务器若空闲，则接受客户的请求，客户程序发生Connect事件，然后可以用SendData方法发送数据。 

5．客户程序收到数据时，产生DataArrival事件，在该事件中可以用GetData方法接收数据。 

6．如果客户收到Close事件，用Close方法关闭连接。 

以下是客户程序的编写过程： 

1．   新建一个工程文件，在窗体中加上一个文本框Name为txtRecive，设置 MultiLine属性为True。设置ScrollBars属性为3-Both。 

2．   加一标签，Caption为“您的大名：”，后面加一文本框Name为ClientName。 

3．   加一标签，Caption为“您的性别：”，后面接一组合框Name为“xingbie“。组合框中加两个OptionButton，分别为Option1,Caption为“男”，Value为True,Option2,Caption为“女”。 

4．   加文本框txtSent,设置MultiLine属性为True。 

5．   加命令按钮cmdSent,Caption为“发送”， 再加一命令按钮cmdConnect，Caption为“连接”。 

6．   加Winsock控件，Name为sckClient。 

下面是客户程序的源代码： 

Dim messIndex As Integer 

Dim firsttime As Boolean 

Dim recNumber As Integer 

Dim strData As String 

  Private Sub cmdConnect_Click() 

    On Error GoTo MyError 

    sckClient.Connect 

    Exit Sub 

MyError: 

    MsgBox "连接服务器出错！", vbOKOnly, "系统提示" 

    Exit Sub 

End Sub 

  

Private Sub cmdSent_Click() 

    Dim name As String 

    If txtSent.Text = "" Then 

        MsgBox "您想要说什么？", vbOKOnly, "系统提示" 

        Exit Sub 

    End If 

    If Option1.Value = True Then 

        name = clientname.Text + "先生: " 

    Else 

        name = clientname.Text + "小姐: " 

    End If 

    sckClient.SendData name + txtSent.Text 

End Sub 

  

Private Sub Form_Load() 

    sckClient.RemoteHost = "fdd"   注释：可以更改为你运行服务器的主机名 

    sckClient.RemotePort = 8888 

    cmdSent.Enabled = False 

    messIndex = -1 

    firsttime = True 

    recNumber = 0 

End Sub 

  

Private Sub sckClient_Close() 

    MsgBox "您使用的名字已经注册或服务器已关闭，请重新连接。" 

    End 

End Sub 

  

Private Sub sckClient_Connect() 

    Dim name As String 

    MsgBox "连接服务器成功！", vbOKOnly, "系统提示" 

    cmdConnect.Enabled = False 

    cmdSent.Enabled = True 

    If firsttime = True Then 

        If Option1.Value = True Then 

            name = clientname.Text + "先生" 

        Else 

            name = clientname.Text + "小姐" 

        End If 

        sckClient.SendData name 

        firsttime = False 

        End If 

    clientname.Enabled = False 

    If Option1.Value = True Then 

        Option2.Enabled = False 

        Option1.Enabled = False 

    Else 

        Option1.Enabled = False 

        Option2.Enabled = False 

    End If 

End Sub 

  

Private Sub sckClient_DataArrival(ByVal bytesTotal As Long) 

    sckClient.GetData strData 

    txtRecive.Text = txtRecive.Text & strData & vbCrLf 

    txtRecive.SelStart = Len(txtRecive.Text) 

End Sub 

  

Private Sub sckClient_Error(ByVal Number As Integer, _ 

    Description As String, ByVal Scode As Long, _ 

    ByVal Source As String, ByVal HelpFile As String, _ 

    ByVal HelpContext As Long, CancelDisplay As Boolean) 

    sckClient.Close 

    cmdConnect.Enabled = True 

    cmdSent.Enabled = False 

End Sub 

  二．服务器程序的实现方法： 

1．   设置LocalPort属性，作为侦听端口。该值是一个整型值，但必须是其他TCP/IP程序没有使用过的值。 

2．   使用Listen方法进入侦听状态，等待客户程序发出连接请求。 

3．   收到客户的连接请求，服务器发生ConnectRequest事件，得到RequestID。 

4．   服务器程序用Accept方法接受客户的连接请求。然后可以用SendData方法发送数据。 

5．   服务器接受到数据时，发生DataArrival事件，在该事件中可以用GetData的方法接收数据。 

6．   如果接收到Close事件，则用Close方法关闭TCP/IP连接。 

以下是服务器程序的编写过程： 

1． 新建一个工程文件，在窗体中加上一个文本框Name为txtRecive，设置  MultiLine属性为True。设置ScrollBars属性为3-Both。 

2． 加一标签，Caption为“连接数”，后面接一个标签，Name为number,Caption为0，设置Appearance为1-3D，BorderStyle为1-Fixed Single。 

3． 加一命令按钮，Name为clearmess,Caption为“清除消息”。 

4． 加三个WinSock控件，Name分别为sckServer,sckBusy,sckListen。 

下面是服务器程序的源代码： 

Private MaxNumber As Integer 

Dim curnumber As Integer 

Dim chatname(50) As String 

Dim firstmess(50) As Boolean 

  

Private Sub clearmess_Click() 

    txtRecive.Text = "" 

End Sub 

  

Private Sub Form_Load() 

    MaxNumber = 50 

    curnumber = 0 

    For l = 0 To MaxNumber 

        firstmess(l) = True 

    Next l 

    For i = 1 To MaxNumber - 1 

        Load sckServer(i) 

    Next i 

    sckListen.LocalPort = 8888 

    sckListen.Listen 

End Sub 

  

Private Sub sckBusy_Close() 

    sckBusy.Close 

End Sub 

  

Private Sub sckBusy_DataArrival(ByVal bytesTotal As Long) 

    sckBusy.SendData "服务器忙，请稍后再连接！" 

    DoEvents 

End Sub 

  

Private Sub sckListen_ConnectionRequest(ByVal requestID As Long) 

    Dim i As Integer 

    For i = 0 To MaxNumber - 1 

    If sckServer(i).State = 0 Then 

        Exit For 

    End If 

    Next i 

    If sckServer(i).State = 0 Then 

        sckServer(i).Accept requestID 

        sckServer(i).SendData "欢迎您参加入网络聊天！" 

        curnumber = curnumber + 1 

        number.Caption = curnumber 

        Exit Sub 

    End If 

    sckBusy.Close 

    sckBusy.Accept requestID 

End Sub 

  

Private Sub sckListen_Error(ByVal number As Integer, _ 

    Description As String, ByVal Scode As Long, _ 

    ByVal Source As String, ByVal HelpFile As String, _ 

    ByVal HelpContext As Long, CancelDisplay As Boolean) 

    sckListen.Close 

    sckListen.LocalPort = 8888 

    sckListen.Listen 

End Sub 

  

Private Sub sckServer_Close(Index As Integer) 

    Dim j As Integer 

    sckServer(Index).Close 

    firstmess(Index) = True 

    For j = 0 To MaxNumber - 1 

        If sckServer(j).State = 7 Then 

            sckServer(j).SendData chatname(Index) + "退出网络聊天" 

            DoEvents 

        End If 

    Next j 

    curnumber = curnumber - 1 

    number.Caption = curnumber 

End Sub 

  

Private Sub sckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long) 

    Dim strData As String 

    Dim i As Integer 

    sckServer(Index).GetData strData 

    If firstmess(Index) = True Then 

        chatname(Index) = strData 

        firstmess(Index) = False 

        For m = 0 To 49 

            If (Index <> m) And (chatname(m) = strData) Then 

                sckServer(Index).Close 

                firstmess(Index) = True 

                curnumber = curnumber - 1 

                number.Caption = curnumber 

                Exit Sub 

            End If 

        Next m 

        strData = strData + "加入网络聊天" 

    End If 

    For i = 0 To MaxNumber - 1 

        If sckServer(i).State = 7 Then 

            sckServer(i).SendData strData 

            DoEvents 

        End If 

    Next i 

    txtRecive.Text = txtRecive.Text & "Index " & Index & " " & strData + vbCrLf 

    txtRecive.SelStart = Len(txtRecive.Text) 

End Sub 

  

Private Sub sckServer_Error(Index As Integer, ByVal number As Integer, _ 

    Description As String, ByVal Scode As Long, ByVal Source As String, _ 

    ByVal HelpFile As String, ByVal HelpContext As Long, _ 

    CancelDisplay As Boolean) 

    sckServer(Index).Close 

End Sub