利用Winsock控件创建的局域网聊天程序

1.服务器端

往服务器窗体（命名为frmServer）添加三个控件，分别为LIST1（存放在线好友名单），text1（留言内容）和text2（聊天记录），程序如下：

Option Explicit

Const Busy As Boolean = False

Const Free As Boolean = True

Dim ConnectState() As Boolean

Dim SIndex

Dim Usrs(0 To 32) '在线人名

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

End

End Sub

Private 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 Sub

Private Sub Listener_ConnectionRequest(ByValrequestID As Long)

Dim SockIndexAs Integer

Dim SockNumAs Integer

On Error Resume Next

SockNum = UBound(ConnectState)

If SockNum> 32 ThenExit Sub

'查找空闲的SckServer

SockIndex = FindFreeSocket

'如果已有的sock都忙，而且sock数不超过32个，动态添加sock

If SockIndex>SockNum Then Load SckServer(SockIndex)

ConnectState(SockIndex) = Busy

SckServer(SockIndex).Tag = SockIndex

'接受请求

SckServer(SockIndex).Accept (requestID)

End Sub

Private Sub SckServer_DataArrival(Index As Integer, ByValbytesTotal As Long)

Dim dx As String

SIndex = Index

SckServer(Index).GetData dx, vbString

If Len(Text2.Text) >= 512 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) & "”上线。" &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, "|")) & Format(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, "|", "”说：" &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)

Close #1

End If

End Sub

Private 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) & "”下线。" &vbCrLf& Text2.Text