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

-.z1.效劳器端往效劳器窗体〔命名为frmServer〕添加三个控件，分别为LIST1〔存放在线好友〕，te*t1〔留言容〕和te*t2〔聊天记录〕，程序如下：OptionE*plicitConstBusyAsBoolean=FalseConstFreeAsBoolean=TrueDimConnectState()AsBooleanDimSInde*DimUsrs(0To32)'在线人名PrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)EndEndSubPrivateSubForm_Load()IfApp.PrevInstance=TrueThenMsgBo*"程序已在运行",vbCriticalEndEndIfReDimPreserveConnectState(0)OnErrorResumeNe*tConnectState(0)=FreeListener.LocalPort=1001'端口号Listener.Listen'开场侦听EndSubPrivateSubListener_ConnectionRequest(ByValrequestIDAsLong)DimSockInde*AsIntegerDimSockNumAsIntegerOnErrorResumeNe*tSockNum=UBound(ConnectState)IfSockNum>32ThenE*itSub'查找空闲的SckServerSockInde*=FindFreeSocket'如果已有的sock都忙，而且sock数不超过32个，动态添加sockIfSockInde*>SockNumThenLoadSckServer(SockInde*)ConnectState(SockInde*)=BusySckServer(SockInde*).Tag=SockInde*'承受请求SckServer(SockInde*).Accept(requestID)EndSubPrivateSubSckServer_DataArrival(Inde*AsInteger,ByValbytesTotalAsLong)Dimd*AsStringSInde*=Inde*SckServer(Inde*).GetDatad*,vbStringIfLen(Te*t2.Te*t)>=512ThenTe*t2.Te*t="IfRight(d*,2)="||"ThenList1.AddItemReplace(d*,"|",")Usrs(SInde*)=Replace(d*,"|",")Timer1.Enabled=TrueTe*t2.Te*t=Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞上线。"&vbCrLf&Te*t2.Te*tOpenApp.Path&"\record.t*t"ForAppendAs*1Write*1,Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞上线。"Close*1ElseTe*t1.Te*t=Left(d*,InStr(d*,"|"))&Format(Now(),"YY-MM-DDhh:mm:ss")&vbCrLf&Usrs(Inde*)&"说："&Right(d*,Len(d*)-InStr(d*,"|"))Te*t2.Te*t=Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞对“"&Replace(d*,"|","〞说："&vbCrLf)&vbCrLf&Te*t2.Te*tOpenApp.Path&"\record.t*t"ForAppendAs*1Write*1,Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞对“"&Replace(d*,"|","〞说："&vbCrLf)Close*1EndIfEndSubPrivateSubSckServer_Close(Inde*AsInteger)Dimi%OnErrorResumeNe*tIfSckServer(Inde*).State<>sckClosedThenSckServer(Inde*).CloseConnectState(Inde*)=FreeTe*t2.Te*t=Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞下线。"&vbCrLf&Te*t2.Te*tOpenApp.Path&"\record.t*t"ForAppendAs*1Write*1,Format(Now(),"YY-MM-DDhh:mm:ss")&"“"&Usrs(Inde*)&"〞下线。"Close*1Fori=0ToList1.ListCountIfList1.List(i)=Usrs(Inde*)ThenList1.RemoveItem(i)Usrs(Inde*)="Timer1.Enabled=TrueE*itForEndIfNe*tEndSubPublicFunctionFindFreeSocket()DimSockCount,iAsIntegerSockCount=UBound(ConnectState)Fori=0ToSockCountIfConnectState(i)=FreeThenFindFreeSocket=iE*itFunctionEndIfNe*tiReDimPreserveConnectState(0ToSockCount+1)FindFreeSocket=UBound(ConnectState)EndFunctionPrivateSubTe*t1_Change()DimAr,iOnErrorGoToL1Ar=Split(Te*t1.Te*t,"|")Fori=0ToUBound(Usrs)IfUsrs(i)=Ar(0)AndAr(0)<>"ThenE*itForNe*tSckServer(i).SendDataTe*t1.Te*tL1:EndSubPrivateSubTimer1_Timer()Dimi%,j%,Str$Forj=0ToList1.ListCountStr=Str&List1.List(j)&"||"Ne*tOnErrorResumeNe*tFori=0ToUBound(ConnectState)SckServer(i).SendDataStrNe*tL1:Str="Timer1.Enabled=FalseEndSub2.客户端客户端工程里添加两个窗体〔Login和frmClient〕，分别如下列图，把登陆窗体存放用户名的文本框命名为USRN。程序代码如下〔示，没什么实际意义〕：PrivateSubForm_Load()IfApp.PrevInstance=TrueThenMsgBo*"程序已在运行",vbCriticalEndEndIfUsrn.Te*t=UCase(Environ("UserName"))EndSubPrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)EndEndSubPrivateSubCommand1_Click()Me.HidefrmClient.ShowEndSubPrivateSubCommand2_Click()Usrn.Te*t="Te*t2.Te*t="EndSubPrivateSubCommand3_Click()EndEndSub在对话窗体〔frmClient〕中添加三个对象，List1用于存放在线好友，单击选中要交谈的好友，T*tsend输入要发送的信息，t*tOutput显示收到的信息。Connect按钮用于重新连接效劳器。程序如下：ConstComputerName="你的计算机名字或IP地址"PrivateSubForm_Load()'Winsock控件的名字为SckClient。注意：要指定远程主机，可以使用'IP地址〔例如："121.111.1.1"〕，也可以使用计算机的“好听的名字〞。SckClient.RemoteHost=ComputerNameSckClient.RemotePort=1001SckClient.ConnectcmdConnect.Enabled=SckClient.State=sckClosedtEndSubPrivateSubcmdConnect_Click()'调用Connect方法，初始化连接。IfSckClient.State<>sckClosedThenSckClient.CloseSckClient.ConnectcmdConnect.Enabled=SckClient.State=sckClosedEndSubPrivateSubForm_QueryUnload(CancelAsInteger,UnloadModeAsInteger)EndEndSubPrivateSubCommand1_Click()'MsgBo*List1.Te*tOnErrorGoToL1IfList1.Te*t="ThenE*itSubSckClient.SendDataList1.Te*t&"|"&t*tSend.Te*tt*tOutput.Te*t=Format(Now(),"YY-MM-DDhh:mm:ss")&vbCrLf&"对"&List1.Te*t&"说："&t*tSend.Te*t&vbCrLf&vbCrLf&t*tOutput.Te*tt*tSend.Te*t="E*itSubL1:MsgBo*"通信失败"cmdConnect.Enabled=TrueEndSubPrivateSubList1_Click()IfList1.Te*t<>Login.Usrn.Te*tThenSpeakto.Caption="对"&List1.Te*t&"说："ElseMsgBo*"你选择了自己。"EndIfEndSubPrivateSubSckClient_DataArrival(ByValbytesTotalAsLong)DimstrDataAsString,ar,i%SckClient.GetDatastrData,vbStringIfLen(t*tOutput.Te*t)>512Thent*tOutput.Te*t="IfRight(strData,2)="||"ThenList1.Clearar=Split(strData,"||")Fori=0ToUBound(ar)Ifar(i)<>"