用VB实现聊天讨论室和点对点会话
出处：论文网
时间：2007-04-12
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空白处从内存中撤出系统。根据同样的原理可以制作电子邮件系统。
