利用Winsock控件創(chuàng)建的局域網(wǎng)聊天程序(共7頁)

1、精選優(yōu)質文檔-傾情為你奉上1.服務器端往服務器窗體（命名為frmServer）添加三個控件，分別為LIST1（存放在線好友名單），text1（留言內(nèi)容）和text2（聊天記錄），程序如下：Option ExplicitConst Busy As Boolean = FalseConst Free As Boolean = TrueDim ConnectState() As BooleanDim SIndexDim Usrs(0 To 32) '在線人名Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Intege

2、r) EndEnd SubPrivate Sub Form_Load() If App.PrevInstance = True Then MsgBox "程序已在運行", vbCritical End End If ReDim Preserve ConnectState(0) On Error Resume Next ConnectState(0) = Free Listener.LocalPort = 1001 '端口號 Listener.Listen '開始偵聽End SubPrivate Sub Listener_ConnectionRequest(B

3、yVal requestID As Long) Dim SockIndex As Integer Dim SockNum As Integer On Error Resume Next SockNum = UBound(ConnectState) If SockNum > 32 Then Exit Sub '查找空閑的SckServer SockIndex = FindFreeSocket '如果已有的sock都忙，而且sock數(shù)不超過32個，動態(tài)添加sock If SockIndex > SockNum Then Load SckServer(SockIndex)

4、 ConnectState(SockIndex) = Busy SckServer(SockIndex).Tag = SockIndex '接受請求 SckServer(SockIndex).Accept (requestID)End SubPrivate Sub SckServer_DataArrival(Index As Integer, ByVal bytesTotal As Long) Dim dx As String SIndex = Index SckServer(Index).GetData dx, vbString If Len(Text2.Text) >= 51

5、2 Then Text2.Text = "" If Right(dx, 2) = "|" Then List1.AddItem Replace(dx, "|", "") Usrs(SIndex) = Replace(dx, "|", "") Timer1.Enabled = True Text2.Text = Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index)

6、& "”上線。" & vbCrLf & Text2.Text Open App.Path & "record.txt" For Append As #1 Write #1, Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index) & "”上線。" Close #1 Else Text1.Text = Left(dx, InStr(dx, "|") & For

7、mat(Now(), "YY-MM-DD hh:mm:ss") & vbCrLf & Usrs(Index) & "說：" & Right(dx, Len(dx) - InStr(dx, "|") Text2.Text = Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index) & "”對“" & Replace(dx, "|", &qu

8、ot;”說：" & vbCrLf) & vbCrLf & Text2.Text Open App.Path & "record.txt" For Append As #1 Write #1, Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index) & "”對“" & Replace(dx, "|", "”說：" & vbCrLf) Clos

9、e #1 End IfEnd SubPrivate Sub SckServer_Close(Index As Integer) Dim i% On Error Resume Next If SckServer(Index).State <> sckClosed Then SckServer(Index).Close ConnectState(Index) = Free Text2.Text = Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index) & "

10、;”下線。" & vbCrLf & Text2.Text Open App.Path & "record.txt" For Append As #1 Write #1, Format(Now(), "YY-MM-DD hh:mm:ss") & " “" & Usrs(Index) & "”下線。" Close #1 For i = 0 To List1.ListCount If List1.List(i) = Usrs(Index) Then List1.R

11、emoveItem (i) Usrs(Index) = "" Timer1.Enabled = True Exit For End If NextEnd SubPublic Function FindFreeSocket() Dim SockCount, i As Integer SockCount = UBound(ConnectState) For i = 0 To SockCount If ConnectState(i) = Free Then FindFreeSocket = i Exit Function End If Next i ReDim Preserve

12、ConnectState(0 To SockCount + 1) FindFreeSocket = UBound(ConnectState)End FunctionPrivate Sub Text1_Change() Dim Ar, i On Error GoTo L1 Ar = Split(Text1.Text, "|") For i = 0 To UBound(Usrs) If Usrs(i) = Ar(0) And Ar(0) <> "" Then Exit For Next SckServer(i).SendData Text1.Te

13、xtL1:End SubPrivate Sub Timer1_Timer() Dim i%, j%, Str$ For j = 0 To List1.ListCount Str = Str & List1.List(j) & "|" Next On Error Resume Next For i = 0 To UBound(ConnectState) SckServer(i).SendData Str NextL1: Str = "" Timer1.Enabled = FalseEnd Sub2.客戶端客戶端工程里添加兩個窗體（Login

14、和frmClient），分別如圖所示，把登陸窗體存放用戶名的文本框命名為USRN。程序代碼如下（示范，沒什么實際意義）：Private Sub Form_Load() If App.PrevInstance = True Then MsgBox "程序已在運行", vbCritical End End If Usrn.Text = UCase(Environ("UserName")End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) EndEnd Sub

15、Private Sub Command1_Click() Me.Hide frmClient.ShowEnd SubPrivate Sub Command2_Click() Usrn.Text = "" Text2.Text = ""End SubPrivate Sub Command3_Click() EndEnd Sub在對話窗體（frmClient）中添加三個對象，List1用于存放在線好友名單，單擊選中要交談的好友，Txtsend輸入要發(fā)送的信息，txtOutput顯示收到的信息。Connect按鈕用于重新連接服務器。程序如下：Const Com

16、puterName = "你的計算機名字或IP地址"Private Sub Form_Load() 'Winsock 控件的名字為SckClient。注意：要指定遠程主機，可以使用 ' IP 地址（例如："121.111.1.1"），也可以使用計算機的“好聽的名字”。 SckClient.RemoteHost = ComputerName SckClient.RemotePort = 1001 SckClient.Connect cmdConnect.Enabled = SckClient.State = sckClosed Me.Cap

17、tion = Me.Caption & "-" & Login.Usrn.TextEnd SubPrivate Sub cmdConnect_Click() '調(diào)用Connect 方法，初始化連接。 If SckClient.State <> sckClosed Then SckClient.Close SckClient.Connect cmdConnect.Enabled = SckClient.State = sckClosedEnd SubPrivate Sub Form_QueryUnload(Cancel As Integer

18、, UnloadMode As Integer) EndEnd SubPrivate Sub Command1_Click()' MsgBox List1.Text On Error GoTo L1 If List1.Text = "" Then Exit Sub SckClient.SendData List1.Text & "|" & txtSend.Text txtOutput.Text = Format(Now(), "YY-MM-DD hh:mm:ss") & vbCrLf & &qu

19、ot;對" & List1.Text & "說：" & txtSend.Text & vbCrLf & vbCrLf & txtOutput.Text txtSend.Text = "" Exit SubL1: MsgBox "通信失敗" cmdConnect.Enabled = TrueEnd SubPrivate Sub List1_Click() If List1.Text <> Login.Usrn.Text Then Speakto.Caption = "對" & List1.Text & "說：" Else MsgBox "你選擇了自己。" End IfEnd SubPrivate Sub