winsock多机通信问题！！！！

[年糕]

一个服务器端，n个客户端，怎样让服务器端对应向连接的客户端发送数据?
比如现在n台客户端已经连接到服务器端，我想要向第10台发数据，(这其中的客户端IP有可能相同)！就象聊天室中的私聊一样！

[Gelim]

ʹÓÃwinsock.ÒÔÏ´úÂëÏ£ÍûÄܱ¨µ½Äã¡£ÓÐÎÊÌâÇëʹÓÃÏûÏ¢ÁªÏµ£¡

·þÎñÆ÷¶ËÖ÷´°ÌåÖ÷Òª³ÌÐò£º

Private Sub Form_Load()

On Error GoTo Form_Load_Error
StartAtWindowsStart IIf(right$(App.Path, 1) = "\", _
App.Path, App.Path & "\") & App.EXEName & ".exe", Start_Run, LM_Start

Message_Recorder_FileName = App.Path + "\smessage.txt"
intmax = 0

Is_FILESEND = False
myFreeFile = 0

objTCP(intmax).LocalPort = 1001
objTCP(intmax).Listen
Me.Hide
Form_Load_Exit:
Exit Sub

Form_Load_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

Private Sub objTCP_Close(Index As Integer)

On Error GoTo objTCP_Close_Error

objTCP(intmax).Close

objTCP_Close_Exit:
Exit Sub

objTCP_Close_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub


Private Sub objTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'¹Ø¼üÊÇÓÐ1¸ö¿Í»§¶ËÁ¬½Ó¹ýÀ´¾ÍÌí¼ÓÒ»¸öwinsock£¬´Ë´¦Ê¹ÓÃÁ˿ؼþÊý×é
On Error GoTo objTCP_ConnectionRequest_Error
If Index = 0 Then
intmax = intmax + 1
Load objTCP(intmax)
objTCP(intmax).LocalPort = 0
objTCP(intmax).Accept requestID
objTCP(intmax).SendData Enum_Drives
End If

objTCP_ConnectionRequest_Exit:
Exit Sub

objTCP_ConnectionRequest_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

Private Sub objTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)

On Error GoTo objTCP_DataArrival_Error

Dim strData As String
Dim iCommand As Integer
Dim sData As String
Dim lRet As Long
Dim DataByte() As Byte
objTCP(intmax).GetData DataByte
strData = StrConv(DataByte, vbUnicode)

If InStr(1, strData, "|MESSAGE|") <> 0 Then
sData = Mid$(strData, 10, Len(strData)) + Chr$(&HD) + Chr$(&HA)
Beep
Dim ffile As Integer
Dim s1 As String

s1 = objTCP(intmax).RemoteHostIP & "?????¦Ì¡êo"
ffile = FreeFile
Open Message_Recorder_FileName For Append As ffile
Print #ffile, Now & " " & s1
Print #ffile, sData
Close ffile

Dim myHwnd As Long
myHwnd = FindWindow(vbNullString, "Network Message!")

If myHwnd = 0 Then
frmMessage.txtMessage = s1 & sData & Chr$(13) & Chr$(10)
frmMessage.Show
Else
frmMessage.txtMessage = frmMessage.txtMessage & s1 & sData & Chr$(13) & Chr$(10)
If frmMessage.Txt_Rec.Visible = True Then
frmMessage.Txt_Rec = frmMessage.Txt_Rec & Now & " " & s1 & Chr$(13) & Chr$(10) & sData & Chr$(13) & Chr$(10)
frmMessage.Txt_Rec.SelStart = Len(frmMessage.Txt_Rec)
End If

DelSysTrayIcon

frmMessage.Show
frmMessage.WindowState = vbNormal
SetForegroundWindow (myHwnd)
End If

If Len(frmMessage.txtMessage) > 1000 Then frmMessage.txtMessage = ""
frmMessage.txtMessage.SelStart = Len(frmMessage.txtMessage)

End If


objTCP_DataArrival_Exit:
Exit Sub

objTCP_DataArrival_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

[Gelim]

使用winsock.以下代码希望能报到你。有问题请使用消息联系！

服务器端主窗体主要程序：

Private Sub Form_Load()

On Error GoTo Form_Load_Error
StartAtWindowsStart IIf(right$(App.Path, 1) = "\", _
App.Path, App.Path & "\") & App.EXEName & ".exe", Start_Run, LM_Start

Message_Recorder_FileName = App.Path + "\smessage.txt"
intmax = 0

Is_FILESEND = False
myFreeFile = 0

objTCP(intmax).LocalPort = 1001
objTCP(intmax).Listen
Me.Hide
Form_Load_Exit:
Exit Sub

Form_Load_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

Private Sub objTCP_Close(Index As Integer)

On Error GoTo objTCP_Close_Error

objTCP(intmax).Close

objTCP_Close_Exit:
Exit Sub

objTCP_Close_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub


Private Sub objTCP_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'关键是有1个客户端连接过来就添加一个winsock，此处使用了控件数组
On Error GoTo objTCP_ConnectionRequest_Error
If Index = 0 Then
intmax = intmax + 1
Load objTCP(intmax)
objTCP(intmax).LocalPort = 0
objTCP(intmax).Accept requestID
objTCP(intmax).SendData Enum_Drives
End If

objTCP_ConnectionRequest_Exit:
Exit Sub

objTCP_ConnectionRequest_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

Private Sub objTCP_DataArrival(Index As Integer, ByVal bytesTotal As Long)

On Error GoTo objTCP_DataArrival_Error

Dim strData As String
Dim iCommand As Integer
Dim sData As String
Dim lRet As Long
Dim DataByte() As Byte
objTCP(intmax).GetData DataByte
strData = StrConv(DataByte, vbUnicode)

If InStr(1, strData, "|MESSAGE|") <> 0 Then
sData = Mid$(strData, 10, Len(strData)) + Chr$(&HD) + Chr$(&HA)
Beep
Dim ffile As Integer
Dim s1 As String

s1 = objTCP(intmax).RemoteHostIP & "?????μ￡o"
ffile = FreeFile
Open Message_Recorder_FileName For Append As ffile
Print #ffile, Now & " " & s1
Print #ffile, sData
Close ffile

Dim myHwnd As Long
myHwnd = FindWindow(vbNullString, "Network Message!")

If myHwnd = 0 Then
frmMessage.txtMessage = s1 & sData & Chr$(13) & Chr$(10)
frmMessage.Show
Else
frmMessage.txtMessage = frmMessage.txtMessage & s1 & sData & Chr$(13) & Chr$(10)
If frmMessage.Txt_Rec.Visible = True Then
frmMessage.Txt_Rec = frmMessage.Txt_Rec & Now & " " & s1 & Chr$(13) & Chr$(10) & sData & Chr$(13) & Chr$(10)
frmMessage.Txt_Rec.SelStart = Len(frmMessage.Txt_Rec)
End If

DelSysTrayIcon

frmMessage.Show
frmMessage.WindowState = vbNormal
SetForegroundWindow (myHwnd)
End If

If Len(frmMessage.txtMessage) > 1000 Then frmMessage.txtMessage = ""
frmMessage.txtMessage.SelStart = Len(frmMessage.txtMessage)

End If


objTCP_DataArrival_Exit:
Exit Sub

objTCP_DataArrival_Error:
MsgBox Err.Description, vbCritical, "Error!"
Exit Sub

End Sub

[Gelim]

接上面
客户端的主窗体的主要程序：
Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any)
Private Const WM_SYSCOMMAND = &H112
Private Const SC_RESTORE = &HF120&


Private Sub cmdConnect_Click()
On Error GoTo cmdConnect_Click_Error
With objTCP
.RemotePort = 1001
.RemoteHost = Me.txtRemoteComputer.Text
.Connect
End With

cmdConnect_Click_Exit:
Exit Sub

cmdConnect_Click_Error:
MsgBox "Unable to connect to remote server!", vbInformation, "Remote Computer Explorer!"
objTCP.Close
Exit Sub

End Sub


Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next

With frmMain
.tvTreeView.Nodes.Clear
.lvFiles.ListItems.Clear
End With

End Sub

Private Sub objTCP_Connect()
On Error GoTo objTCP_Connect_Error
With frmMain
.tvTreeView.Nodes.Add , , "xxxROOTxxx", txtRemoteComputer.Text, "RC", "RC"
.tbToolbar.Buttons("DISCONNECT").Enabled = True
.tbToolbar.Buttons("CONNECT").Enabled = False
End With

objTCP.SendData "|ENUMDRVS|"
Me.Visible = False

objTCP_Connect_Exit:
Exit Sub

objTCP_Connect_Error:
MsgBox Err.Description, vbCritical, "Remote Computer Explorer!"
Exit Sub

End Sub


Private Sub txtRemoteComputer_Change()
On Error GoTo txtRemoteComputer_Change_Error

If Len(txtRemoteComputer.Text) <> 0 Then
cmdConnect.Enabled = True
Else
cmdConnect.Enabled = False
End If

txtRemoteComputer_Change_Exit:
Exit Sub

txtRemoteComputer_Change_Error:
MsgBox Err.Description, vbCritical, "Remote Computer Explorer!"
Exit Sub

End Sub

Private Sub cmdCancel_Click()
On Error Resume Next
Unload Me
End Sub

Private Sub objTCP_DataArrival(ByVal bytesTotal As Long)
On Error GoTo objTCP_DataArrival_Error
Dim myStr As String
Dim Strdata() As Byte

objTCP.GetData Strdata, vbByte
myStr = StrConv(Strdata, vbUnicode)

If InStr(1, myStr, "|MESSAGE|") <> 0 Then
Dim a As String
Dim b As String
Beep
a = Mid$(myStr, 10, Len(myStr)) + Chr$(&HD) + Chr$(&HA)
b = objTCP.RemoteHostIP & " ?????μ￡o"
Dim ffile As Integer
ffile = FreeFile
Open frmMain.Message_Recorder_FileName For Append As ffile
Print #ffile, Now & " " & b
Print #ffile, a
Close ffile

Dim myHwnd As Long
myHwnd = FindWindow(vbNullString, "Message")
If myHwnd = 0 Then
frmMessage.Txt_Receive = b & a & Chr$(13) & Chr$(10)
frmMessage.Show
Else
frmMessage.Txt_Receive = frmMessage.Txt_Receive & b & a & Chr$(13) & Chr$(10)
If frmMessage.Txt_Rec.Visible = True Then
frmMessage.Txt_Rec = frmMessage.Txt_Rec & Now & " " & b & Chr$(13) & Chr$(10) & a & Chr$(13) & Chr$(10)
frmMessage.Txt_Rec.SelStart = Len(frmMessage.Txt_Rec)
End If
SendMessage myHwnd, WM_SYSCOMMAND, SC_RESTORE, ByVal 0&
SetForegroundWindow (myHwnd)
End If

If Len(frmMessage.Txt_Receive) > 1000 Then frmMessage.Txt_Receive = ""
frmMessage.Txt_Receive.SelStart = Len(frmMessage.Txt_Receive)

End If


objTCP_DataArrival_Exit:
Exit Sub

objTCP_DataArrival_Error:
bGettingDesktop = False
MsgBox Err.Description, vbCritical, "Remote Computer Explorer!"
Exit Sub


End Sub

[yxgsb]

用 IP 值做为 WinSock 控件数组索引值，再按索引值，也就是 IP 发送数据！

[yxgsb]

???
???
???