PrivateType SockServerInfo
Enabled AsBoolean EndType Dim Server ( ) As SockServerInfo
PrivateSub Form_Load ( )
CreateServer EndSub
PrivateSub Winsock1_ConnectionRequest ( _
Index As Integer, _ ByVal requestID AsLong ) If Winsock1 ( Index ) .State <> 0Then Winsock1 ( Index ) .Close
Winsock1 ( Index ) .Accept requestID
CreateServer EndSub
PrivateSub Winsock1_DataArrival ( Index As Integer, ByVal bytesTotal AsLong )
Dim NetWorkString AsString
Winsock1 ( Index ) .GetData NetWorkString, vbString, bytesTotal
Print "Index " & Index & " 收到数据:" & NetWorkString
Winsock1 ( Index ) .SendData "转发回去的数据" EndSub
PrivateSub Winsock1_Error ( Index As Integer, _ ByVal Number As Integer, _
Description As String, _ ByVal Scode As Long, _ ByVal Source As String, _ ByVal HelpFile As String, _ ByVal HelpContext As Long, _
CancelDisplay AsBoolean )
CancelDisplay = True
Winsock1_Close Index EndSub
PrivateSub Winsock1_Close ( Index AsInteger )
StopServer Index EndSub
PrivateSub CreateServer ( ) Dim ServerMaxCount AsLong Dim X AsLong Dim IsHaveFalse AsLong OnErrorResumeNext
ServerMaxCount = UBound ( Server ) If Err.Number <> 0Then
ServerMaxCount = 0 ReDim Server ( ServerMaxCount ) Else
IsHaveFalse = 0 For X = 0To ServerMaxCount If Server ( X ) .Enabled = FalseThen
ServerMaxCount = X
IsHaveFalse = 1 ExitFor EndIf Next X If IsHaveFalse = 0Then
ServerMaxCount = ServerMaxCount + 1 ReDim Preserve Server ( ServerMaxCount ) EndIf
Load Winsock1 ( ServerMaxCount ) EndIf
Winsock1 ( ServerMaxCount ) .LocalPort = 60000
Winsock1 ( ServerMaxCount ) .Listen
Server ( ServerMaxCount ) .Enabled = True EndSub
PrivateSub StopServer ( Index AsInteger ) Dim ServerMaxCount AsLong If Winsock1 ( Index ) .State <> 0Then Winsock1 ( Index ) .Close OnErrorResumeNext
ServerMaxCount = UBound ( Server ) If Index = ServerMaxCount Then If Index = 0Then Erase Server Else
Unload Winsock1 ( Index ) ReDim Preserve Server ( ServerMaxCount - 1 ) EndIf Else
Unload Winsock1 ( Index )
Server ( Index ) .Enabled = False EndIf EndSub