-.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數(shù)不超過32個，動態(tài)添加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輸入要發(fā)送的信息，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()'調(diào)用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)<>"