在一个单位内部或通过广域协议(如X.25)互联的行业内部都有几十或上万台计算机互联,用Intranet虽然可以建立聊天室,但实现点对点实时对话却比较困难。本人用Winsock和VB自制了一套聊天室和对话系统,特拿来供同行们参考。 一·Winsock的主要属性、事件和方法 Winsock是不可见控件,控件文件名是MSWINSCK.OCX,全称为Mcirosoft winsock control,使用时要将此控件调入工具箱。 1·属性:①Protocol=0 //使用TCP协议; ②RemoteHost //准备连接远程机的IP地址 ③RemotePort //连接远程机的IP端口号 (1024—65535之间) ④LocalPort //本地机监听IP端口号必须与呼叫机端口号相同 2·方法:①connect //申请连接远程机 ②listen //设置监听 ③accept //建立实际连接 ④senddata //发送数据 ⑤getdata //接收数据 ⑥close //关闭连接 3·事件:①connectionrequest //一方请求连接时另一方产生 ②connect //一方机接受连接时另一方产生 ③close //一方机关闭连接时另一方产生 ④dataArrival //一方发送数据另一方产生 ⑤error //请求连接失败时产生 二·制作方法 ⑴ 在一工程中添加两个表单form1(模拟客户端)、form2(模拟服务器端)。 form1中装入控件: 控件名
主要属性
用 途 VB.Form form1
caption=”雷萌聊天室” controlbox=0 ‘False
模拟客户机表单 VB.Textbox text1
multiline=-1 ‘True scrollbars=3 ‘Bath
用于输入发往聊天室的信息 VB.Textbox text2
locked=-1 ‘True multiline=-1 ‘True scrollbars=3 ‘Bath
显示从聊天室发来的信息 VB.Combobox combo1
text=”10.84.234.11” ‘任定默认地址
放入常用的地址 VB.Commandbutton comm1
caption=”退出”
最小化form1 VB.Commandbutton comm2
caption=”连接”
请求与输入的地址连接 VB.Commandbutton send
caption=”发送”
发送Text1中的内容 VB.Label label1
caption=“请在此输入发表的信息”
Text1的框标 VB.Label label2
caption=“聊天室或对方的信息”
Text2的框标 VB.Label label3
caption=钡却印?
显示连接状态信息 VB.Label label4
caption=”聊天室或对方地址”
用于指示Combo1 VB.Label label5
caption=”操作:选地址连接,连接成功看到聊天室内容后再输信息发送”
操作说明 VB.Timer timer1
interval=6000; enabled=false
防止连接超时 MSWinsocklib.winsock a 用于数据传输
form2中装入控件: 控件名
主要属性
用 途 VB.Form form2
caption=”接收信息” controlbox=0 ‘False
模拟客户机表单 VB.Commandbutton command1
caption=”返回”
隐含Form2窗口 VB.Commandbutton command2
caption=”对话”
点对点会话时用此直接启动Form1 VB.Textbox text1
locked=-1 ‘True multiline=-1 ‘True scrollbars=3 ‘Bath
存放聊天或对话内容 VB.Label label1
caption=”接收的信息”
Text1的框标 MSWinsocklib.Winsock a 用于监听 MSWinsocklib.Winsock b 用于传送聊天信息
⑵ 在Form1的各控件事件中加入如下代码: Dim flag As Boolean 注释:连接状态变量 Private Sub a_Connect() flag = True End Sub Private Sub a_DataArrival(ByVal bytesTotal As Long) Dim i As String a.GetData i Label3.Caption = "连接成功!" Comm2.MousePointer = 0 Form1.MousePointer = 0 Timer1.Enabled = False If i = Chr(0) Then Text2.Text = "你是今天第一个进入本聊天室的客户。" + Chr(13) + Chr(10) Else Text2.Text = Text2.Text + i End If Text2.SelStart = Len(Text2.Text) Send.MousePointer = 0 Combo1.Enabled = False Comm2.Caption = "断开连接" Text1.SetFocus End Sub Private Sub a_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) flag = False Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 MsgBox "网络连接失败 !" Label3.Caption = "等待连接" Combo1.Enabled = True Combo1.SetFocus a.Close Comm2.Caption = "连接" End Sub Private Sub Comm1_Click() a.Close 注释:关闭连接 Form1.WindowState = 1 End Sub Private Sub Comm2_Click() If Comm2.Caption = "断开连接" Then a.Close Comm2.Caption = "连接" Label3.Caption = "等待连接" Combo1.Enabled = True Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 Else Text2.Text = "" Label3.Caption = "正在连接.." Comm2.MousePointer = 11 Form1.MousePointer = 11 Timer1.Enabled = True flag = False a.Protocol = sckTCPProtocol a.RemoteHost = Combo1.Text a.RemotePort = 3000 a.Connect End If End Sub Private Sub Form_DblClick() If MsgBox("关闭本聊天室! 确认吗?", 36, "退出系统") = 6 Then End Else Form1.WindowState = 1 End If End Sub Private Sub Form_Load() If App.PrevInstance Then MsgBox "本系统已经加载,请看任务拦!", 48, "提示" End End If flag = False Load Form2 ‘读入form2进入监听 End Sub Private Sub Send_Click() Dim S As String On Error GoTo ffff ‘防止链路中断 Send.MousePointer = 11 If Right(Text1.Text, 1) <> Chr(10) Then S = Text1.Text + Chr(13) + Chr(10) Else S = Text1.Text End If If flag Then a.SendData S End If Exit Sub ffff: MsgBox "连接中断!", 48, "提示" a.Close Send.MousePointer = 0 Comm2.Caption = "连接" Label3.Caption = "等待连接" Combo1.Enabled = True Comm2.MousePointer = 0 Form1.MousePointer = 0 Exit Sub End Sub Private Sub Timer1_Timer() flag = False Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 MsgBox "网络连接失败(超时) !" Label3.Caption = "等待连接" Combo1.Enabled = True Combo1.SetFocus a.Close Comm2.Caption = "连接" End Sub ⑶ 在Form2的各控件事件中加入如下代码: Const maxn = 200 ‘最大同时连接本机的客户数 Dim user(maxn) As Boolean Private Sub Command1_Click() Form2.Hide End Sub Private Sub Command2_Click() Load Form1 Form1.Show End Sub Private Sub Form_Load() Dim str1 As String Form2.Caption = "雷萌通信软件" 注释:winsock控件 a 作为服务器程序监听 a.LocalPort = 3000 a.Listen End Sub Private Sub a_ConnectionRequest(ByVal requestID As Long) Dim i As Long For i = 1 To maxn ‘当一客户请求时给启动一Winsock控件标志号 If Not user(i) Then user(i) = True Exit For End If Next i If i > maxn Then Exit Sub End If Load b(i) ‘当一客户请求时启动一Winsock控件 b(i).Accept requestID 注释:实际建立连接 If Text1.Text = "" Then 注释:发送数据 b(i).SendData Chr(0) Else b(i).SendData Text1.Text End If Form2.Show End Sub Private Sub s_Close(Index As Integer) b(Index).Close 注释:关闭连接 Unload b(Index) 注释:卸载 一个WinSock 控件 user(Index) = False End Sub Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim str As String Dim i As Long b(Index).GetData str Text1.Text = Text1.Text + str For i = 1 To maxn If user(i) Then b(i).SendData str End If Next i End Sub 三·运行 本程序在VB6.0中编译通过,运行后最小化到任务栏上,也可以用API的Shell_Notifyicon 函数做入右下角的指示器栏中常驻内存。你可以在网络中用一个固定的机器地址作为聊天讨论室,其他用户都选该机地址连接进入该室聊天或讨论。各用户也可选各自熟悉的地址进行连接对话,双击form1空白处从内存中撤出系统。根据同样的原理可以制作电子邮件系统。
主要属性
用 途 VB.Form form1
caption=”雷萌聊天室” controlbox=0 ‘False
模拟客户机表单 VB.Textbox text1
multiline=-1 ‘True scrollbars=3 ‘Bath
用于输入发往聊天室的信息 VB.Textbox text2
locked=-1 ‘True multiline=-1 ‘True scrollbars=3 ‘Bath
显示从聊天室发来的信息 VB.Combobox combo1
text=”10.84.234.11” ‘任定默认地址
放入常用的地址 VB.Commandbutton comm1
caption=”退出”
最小化form1 VB.Commandbutton comm2
caption=”连接”
请求与输入的地址连接 VB.Commandbutton send
caption=”发送”
发送Text1中的内容 VB.Label label1
caption=“请在此输入发表的信息”
Text1的框标 VB.Label label2
caption=“聊天室或对方的信息”
Text2的框标 VB.Label label3
caption=钡却印?
显示连接状态信息 VB.Label label4
caption=”聊天室或对方地址”
用于指示Combo1 VB.Label label5
caption=”操作:选地址连接,连接成功看到聊天室内容后再输信息发送”
操作说明 VB.Timer timer1
interval=6000; enabled=false
防止连接超时 MSWinsocklib.winsock a 用于数据传输
form2中装入控件: 控件名
主要属性
用 途 VB.Form form2
caption=”接收信息” controlbox=0 ‘False
模拟客户机表单 VB.Commandbutton command1
caption=”返回”
隐含Form2窗口 VB.Commandbutton command2
caption=”对话”
点对点会话时用此直接启动Form1 VB.Textbox text1
locked=-1 ‘True multiline=-1 ‘True scrollbars=3 ‘Bath
存放聊天或对话内容 VB.Label label1
caption=”接收的信息”
Text1的框标 MSWinsocklib.Winsock a 用于监听 MSWinsocklib.Winsock b 用于传送聊天信息
⑵ 在Form1的各控件事件中加入如下代码: Dim flag As Boolean 注释:连接状态变量 Private Sub a_Connect() flag = True End Sub Private Sub a_DataArrival(ByVal bytesTotal As Long) Dim i As String a.GetData i Label3.Caption = "连接成功!" Comm2.MousePointer = 0 Form1.MousePointer = 0 Timer1.Enabled = False If i = Chr(0) Then Text2.Text = "你是今天第一个进入本聊天室的客户。" + Chr(13) + Chr(10) Else Text2.Text = Text2.Text + i End If Text2.SelStart = Len(Text2.Text) Send.MousePointer = 0 Combo1.Enabled = False Comm2.Caption = "断开连接" Text1.SetFocus End Sub Private Sub a_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) flag = False Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 MsgBox "网络连接失败 !" Label3.Caption = "等待连接" Combo1.Enabled = True Combo1.SetFocus a.Close Comm2.Caption = "连接" End Sub Private Sub Comm1_Click() a.Close 注释:关闭连接 Form1.WindowState = 1 End Sub Private Sub Comm2_Click() If Comm2.Caption = "断开连接" Then a.Close Comm2.Caption = "连接" Label3.Caption = "等待连接" Combo1.Enabled = True Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 Else Text2.Text = "" Label3.Caption = "正在连接.." Comm2.MousePointer = 11 Form1.MousePointer = 11 Timer1.Enabled = True flag = False a.Protocol = sckTCPProtocol a.RemoteHost = Combo1.Text a.RemotePort = 3000 a.Connect End If End Sub Private Sub Form_DblClick() If MsgBox("关闭本聊天室! 确认吗?", 36, "退出系统") = 6 Then End Else Form1.WindowState = 1 End If End Sub Private Sub Form_Load() If App.PrevInstance Then MsgBox "本系统已经加载,请看任务拦!", 48, "提示" End End If flag = False Load Form2 ‘读入form2进入监听 End Sub Private Sub Send_Click() Dim S As String On Error GoTo ffff ‘防止链路中断 Send.MousePointer = 11 If Right(Text1.Text, 1) <> Chr(10) Then S = Text1.Text + Chr(13) + Chr(10) Else S = Text1.Text End If If flag Then a.SendData S End If Exit Sub ffff: MsgBox "连接中断!", 48, "提示" a.Close Send.MousePointer = 0 Comm2.Caption = "连接" Label3.Caption = "等待连接" Combo1.Enabled = True Comm2.MousePointer = 0 Form1.MousePointer = 0 Exit Sub End Sub Private Sub Timer1_Timer() flag = False Timer1.Enabled = False Comm2.MousePointer = 0 Form1.MousePointer = 0 MsgBox "网络连接失败(超时) !" Label3.Caption = "等待连接" Combo1.Enabled = True Combo1.SetFocus a.Close Comm2.Caption = "连接" End Sub ⑶ 在Form2的各控件事件中加入如下代码: Const maxn = 200 ‘最大同时连接本机的客户数 Dim user(maxn) As Boolean Private Sub Command1_Click() Form2.Hide End Sub Private Sub Command2_Click() Load Form1 Form1.Show End Sub Private Sub Form_Load() Dim str1 As String Form2.Caption = "雷萌通信软件" 注释:winsock控件 a 作为服务器程序监听 a.LocalPort = 3000 a.Listen End Sub Private Sub a_ConnectionRequest(ByVal requestID As Long) Dim i As Long For i = 1 To maxn ‘当一客户请求时给启动一Winsock控件标志号 If Not user(i) Then user(i) = True Exit For End If Next i If i > maxn Then Exit Sub End If Load b(i) ‘当一客户请求时启动一Winsock控件 b(i).Accept requestID 注释:实际建立连接 If Text1.Text = "" Then 注释:发送数据 b(i).SendData Chr(0) Else b(i).SendData Text1.Text End If Form2.Show End Sub Private Sub s_Close(Index As Integer) b(Index).Close 注释:关闭连接 Unload b(Index) 注释:卸载 一个WinSock 控件 user(Index) = False End Sub Private Sub b_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim str As String Dim i As Long b(Index).GetData str Text1.Text = Text1.Text + str For i = 1 To maxn If user(i) Then b(i).SendData str End If Next i End Sub 三·运行 本程序在VB6.0中编译通过,运行后最小化到任务栏上,也可以用API的Shell_Notifyicon 函数做入右下角的指示器栏中常驻内存。你可以在网络中用一个固定的机器地址作为聊天讨论室,其他用户都选该机地址连接进入该室聊天或讨论。各用户也可选各自熟悉的地址进行连接对话,双击form1空白处从内存中撤出系统。根据同样的原理可以制作电子邮件系统。
由于UDP 协议不需要显式的连接,就需要在两个Winsock控件中间发送数据,关键需要完成以下的三步:
1.将RemoteHost属性设置为另一台计算机的名称。
2.将RemotePort属性设置为第二个控件的LocalPort属性。
3.调用Bind方法,指定使用的LocalPort。
因为两台计算机的地位可以看成“对等的”,这种应用程序也被称为点对点的应用程序。
下面将创建一个聊天应用程序,两个人可以通过它进行实时的交谈。请按照以下步骤制作:
1.创建一个新的 Standard EXE 工程。将缺省的窗体的名称修改为frmPeerA,将窗体的标题修改为“Peer A”。
2.在窗体中放入一个 Winsock 控件,并将其命名为 udpPeerA。在“属性”页上,单击“协议”并将协议修改为 UDPProtocol。
3.在窗体中添加两个 TextBox 控件。将第一个命名为 txtSend,第二个命名为 txtOutput。
4.为窗体添加如下的代码。
Private Sub Form_Load()
′控件的名字为udpPeerA
With udpPeerA
′重点:必须将 RemoteHost 的值修改为对方计算机的名字。
RemoteHost= ″PeerB″
RemotePort = 1001 ′连接的端口号。
Bind 1002 ′绑定到本地的端口。
End With
frmPeerB.Show′显示第二个窗体。
End Sub
Private Sub txtSend_Change()
′在键入文本时,立即将其发送出去。
udpPeerA.SendData txtSend.Text
End Sub
Private Sub udpPeerA_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
udpPeerA.GetData strData
txtOutput.Text = strData
End Sub
要创建第二个 UDP 伙伴,请按照以下步骤执行:
1.在工程中添加一个标准窗体,将窗体的名字修改为 frmPeerB,将窗体的标题修改为“Peer B”。
2.在窗体中放入一个 Winsock 控件,并将其命名为 udpPeerB。
3.在“属性”页上,单击“协议”并将协议修改为“UDPProtocol”。
4.在窗体上添加两个 TextBox 控件。将第一个命名为 txtSend,第二个命名为 txtOutput。
5.在窗体中添加如下代码
Private Sub Form_Load()
′控件的名字为 udpPeerB。
With udpPeerB
′重点:必须将RemoteHost的值改为对方计算机的名字。
RemoteHost= ″PeerA″
RemotePort = 1002 ′要连接的端口。
Bind 1001 ′绑定到本地的端口上。
End With
End Sub
Private Sub txtSend_Change()
′在键入后立即发送文本。
udpPeerB.SendData txtSend.Text
End Sub
Private Sub udpPeerB_DataArrival _
(ByVal bytesTotal As Long)
Dim strData As String
udpPeerB.GetData strData
txtOutput.Text = strData
End Sub
运行工程,然后在两个窗体的txtSend TextBox中分别键入一些文本。键入的文字将出现在另一个窗体的 txtOutput TextBox中。