OptionExplicit Private m_iCurrent AsInteger PrivateConst c_iMaxConnect AsInteger=2 PrivateSub StartListen() If sckProductServer(0).State = sckClosed Then Me.check1.Caption ="停止偵聽" Me.check1.Value =1 sckProductServer(0).Listen MsgBox ("{Server}開始偵聽") EndIf End Sub PrivateSub StopListen() If sckProductServer(0).State = sckListening Then Me.check1.Caption ="開始偵聽" Me.check1.Value =0 sckProductServer(0).Close MsgBox ("{Server}停止偵聽") EndIf End Sub PrivateSub StopAllConnect() Dim i AsInteger For i =1To sckProductServer.UBound Unload sckProductServer(i) m_iCurrent = m_iCurrent -1 Call StartListen MsgBox ("{Server}關閉Socket["& i &"]") Next i End Sub PrivateSub Check1_Click() If Me.check1.Value =1Then Call StartListen Else Call StopListen EndIf End Sub PrivateSub Command1_Click() Call StopAllConnect End Sub PrivateSub Command2_Click() Dim frmNewClient AsNew frmClient frmNewClient.Show End Sub PrivateSub Form_Load() m_iCurrent =0 sckProductServer(0).Protocol = sckTCPProtocol sckProductServer(0).LocalPort =7777 End Sub PrivateSub sckProductServer_Close(Index AsInteger) sckProductServer(Index).Close Unload sckProductServer(Index) m_iCurrent = m_iCurrent -1 Call StartListen End Sub PrivateSub sckProductServer_ConnectionRequest(Index AsInteger, ByVal requestID AsLong) Dim i AsInteger For i =1To m_iCurrent If Me.sckProductServer(i).State =0ThenExitFor Next i If i > m_iCurrent Then If i <= c_iMaxConnect Then m_iCurrent = m_iCurrent +1 Load Me.sckProductServer(m_iCurrent) Me.sckProductServer(m_iCurrent).Accept (requestID) MsgBox ("{Server}Socket["& m_iCurrent &"] 開始連接") If (i = c_iMaxConnect) Then Me.sckProductServer(0).Close Call StopListen EndIf Else Me.sckProductServer(0).Close Call StopListen EndIf Else Me.sckProductServer(i).Accept (requestID) MsgBox ("{Server}Socket["& i &"] 開始連接") EndIf End Sub PrivateSub sckProductServer_DataArrival(Index AsInteger, ByVal bytesTotal AsLong) Dim strData AsString Me.sckProductServer(Index).GetData strData MsgBox ("{Server}Socket["& Index &"]接收數據"& strData) sckProductServer(Index).SendData ("OK") MsgBox ("{Server}Socket["& Index &"]回送OK") End Sub PrivateSub sckProductServer_Error(Index AsInteger, ByVal Number AsInteger, Description AsString, ByVal Scode AsLong, ByVal Source AsString, ByVal HelpFile AsString, ByVal HelpContext AsLong, CancelDisplay AsBoolean) If Index >0Then 'sckProductServer(Index).Close Unload sckProductServer(Index) m_iCurrent = m_iCurrent -1 Call StartListen EndIf End Sub
Part 2 Client Form
OptionExplicit Private m_bConnected AsBoolean PrivateSub Command1_Click() OnErrorGoTo ErrorHandle If m_bConnected =TrueThen Me.sckClient.SendData Me.Text1.Text MsgBox ("{Client}發送數據"& Me.Text1.Text) Else MsgBox ("{Client}連接已斷開") EndIf ExitSub ErrorHandle: MsgBox ("連接已斷開") End Sub PrivateSub Form_Load() 'On Error Resume Next If Me.sckClient.State <>0Then Me.sckClient.Close Me.sckClient.Protocol = sckTCPProtocol Me.sckClient.RemoteHost ="localhost"'網站服務器IP地址 Me.sckClient.RemotePort =7777'網站服務器監聽端口 Me.sckClient.Connect End Sub PrivateSub Form_Unload(Cancel AsInteger) If Me.sckClient.State <>0Then Me.sckClient.Close End Sub '函數中調用socket.close,否則事件一直發生 PrivateSub sckClient_Close() MsgBox ("{Client}關閉Socket") m_bConnected =False Me.sckClient.Close End Sub PrivateSub sckClient_Connect() MsgBox ("{Client}建立連接成功") m_bConnected =True End Sub PrivateSub sckClient_DataArrival(ByVal bytesTotal AsLong) Dim strData AsString Me.sckClient.GetData strData MsgBox ("{Client}接到數據:"& strData) End Sub PrivateSub sckClient_Error(ByVal Number AsInteger, Description AsString, ByVal Scode AsLong, ByVal Source AsString, ByVal HelpFile AsString, ByVal HelpContext AsLong, CancelDisplay AsBoolean) If Me.sckClient.State <>0Then Me.sckClient.Close End Sub