winsock客户端连接后立即发送信息时,出错的问题

Question

环境是这样的
有30台电脑30个用户,每个用户都会打开"同一个"聊天窗口  这个窗口里有2个 WINSOCK数组1、WinsockServer(32767)  用于接收其他用户发来的信息，这个是稳定的
2、WinsockClient(32767)  用于向其他用户发送信息，现在问题在于第2个发出的稳定性问题
每个用户可以给其他多个用户发送 即时信息, 接收方收到后立即展示现在的问题是在于 当A客户向其他用户发送时,发送事件是放在一个BUTTON里的,所以第1次发送,不管对方有没有在线,经常出错,很不稳定经常 .state 是一直保持在 6 : sckConnecting 状态有时把"等待的循环次数"搞再长点 跟出来时会保持在 8: sckClosing 状态 会了错
说没有这个对象数组有时又很正常
不知道怎么解决这个问题, 思路不知道是否正确 ,希望 更加友好一点....代码如下:欢迎跟贴  (比较 重要的语句在 01-40行,已手工标出)
Private Sub CommandSend_Click()    'On Error GoTo Err1    '意外错误
    Dim i As Integer
    Dim j As Double
    Dim iTryTimes As Double
    
    '开始发送
    Dim ReceiveUserSelected, ReceiveUserSelectedAll As Boolean
    Dim ReceiveUserIp As String
    
    ReceiveUserSelected = False       '是否已选择了用户
    ReceiveUserSelectedAll = True     '是否是选择了全部都发送
   
    ReceiveUserIp = ""
    Dim ReceiveUserList, ReceiveUserListFail, ReceiveUserListOk As String      
    '收件人的组列表 ReceiveUserList
    '发送失败 的收件人列表 ReceiveUserListFail,
    '发送成功 的收件人列表 ReceiveUserListOk 
    
    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i).Checked = True Then
            ReceiveUserSelected = True
            ReceiveUserList = ReceiveUserList & IIf(ReceiveUserList = "", "", ",") & _
                Trim(Left(ListView1.ListItems.Item(i).Text, InStr(ListView1.ListItems.Item(i).Text, "(") - 1))
        Else
            ReceiveUserSelectedAll = False
        End If
    Next i
    If ReceiveUserSelected = False Then
        MsgBox "对不起，您尚未选择信息接收人。", vbCritical, "发送失败"
        Me.ListView1.SetFocus
        Exit Sub
    End If
    
    '进入发送程序！！！！
    
    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems.Item(i).Checked = True Then
            
            
            '进入发送
01            ReceiveUserIp = Mid(ListView1.ListItems.Item(i).Text, InStr(ListView1.ListItems.Item(i).Text, "(") + 1, _
02              InStr(ListView1.ListItems.Item(i).Text, ")") - InStr(ListView1.ListItems.Item(i).Text, "(") - 1)
03            '取得 接收方的计算机名 ListView1 的显示规则是 : 姓名 (计算机名)
04        
05            '.Key 是ListView是在添加时用 : "A"&用户的ID  取得的, 用于区分已链接的 winsock 省得重连接
06                        
07            If VarType(Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))) = 9 Then
08                Load Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))
09                DoEvents
10            End If
11            
12            With Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))
13                If .State <> 7 Then     '该专用端口仍然是打开着的状态
14                    If .State = 8 Then
15                        Unload Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))
16                        Load Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))
17                    End If
18                    
19                    .RemoteHost = ReceiveUserIp
20                    .RemotePort = 2316
21                    .Connect
22                    j = 0
23                    iTryTimes = 50000      '这个类似等待的循环次数
24
25                    Do
26                        DoEvents
27
28                        j = j + 1
29                        If .State = sckConnected Then
30                            Exit Do               '如果连上就退出
31                        End If
32                      If .State <> 6 And j Mod 16 = 0 Then    '关键是这部分的语句
33                                DoEvents
34                        End If
35
36                        If j > iTryTimes Then Exit Do
37                    Loop
38                End If
39                
40                If .State = sckConnected Then
                    
                    .SendData SYS_USER_NAME & " " & Format(SYS_SERVER_TIME, "MM-DD HH:MM:SS") & "(TO:" & IIf(ReceiveUserSelectedAll, "所有同仁", ReceiveUserList) & ")" & _
                    "正式内容从这里开始滴呵呵：" & Me.TextSend.Text
                    
                    ReceiveUserListOk = ReceiveUserListOk & IIf(ReceiveUserListOk = "", "", ",") & _
                            Trim(Left(ListView1.ListItems.Item(i).Text, InStr(ListView1.ListItems.Item(i).Text, "(") - 1))
                            
                    DoEvents
                    '.Close
                Else
                    ReceiveUserListFail = ReceiveUserListFail & IIf(ReceiveUserListFail = "", "", ",") & _
                            Trim(Left(ListView1.ListItems.Item(i).Text, InStr(ListView1.ListItems.Item(i).Text, "(") - 1))
                    
                            
                    Shell "net send " & ReceiveUserIp & " ~~~~" & SYS_USER_NAME & "~~~~" & vbCrLf & "内容：" & Me.TextSend.Text & vbCrLf & vbCrLf & "　　请您及时登录综合系统。", vbHide
                    
                    Unload Me.WinsockClient(Val(Mid(Me.ListView1.ListItems.Item(i).Key, 2)))
                    DoEvents
                End If
                
                
            End With
            
        End If
    Next i    '以下为 richtextbox 的 设置显示的问题 和连接无关!!!!!
        
    With Me.TextReceive
    
        .SelStart = Len(.Text) + 1
        .SelColor = vbBlue
        .SelFontName = "宋体"
        .SelFontSize = 9
        .SelBold = False
        .SelItalic = False
        .SelUnderline = False
        .SelStrikeThru = False
        
        
        .SelText = vbCrLf & SYS_USER_NAME & " " & Format(SYS_SERVER_TIME, "MM-DD HH:MM:SS") & " "
        .SelLength = Len(vbCrLf & SYS_USER_NAME & " " & Format(SYS_SERVER_TIME, "MM-DD HH:MM:SS") & " ")
        
        .SelIndent = 100
        
        If ReceiveUserListOk <> "" Then
            .SelText = " (TO:" & ReceiveUserListOk & ")"
        End If
        If ReceiveUserListFail <> "" Then
            .SelStart = Len(.Text) + 1
            .SelColor = vbRed
            .SelText = " 用户:" & ReceiveUserListFail & " 接收失败[已发送信使]！"
        End If
        
        SelTextAdd 350, Me.TextSend.Text, Me.CommonDialogFont.FontSize, Me.CommonDialogFont.FontName, Me.CommonDialogFont.FontBold, _
         Me.CommonDialogFont.FontItalic, Me.CommonDialogFont.Color, Me.CommonDialogFont.FontUnderline, Me.CommonDialogFont.FontStrikethru
        
    End With
    
    Me.TextSend.Text = ""
    Me.TextSend.SetFocus
    DoEvents
    
    Exit Sub
Err1:
    MsgBox "意外错误，请重试！", vbCritical, "信息"
    
End Sub

Answer 1

将 22-37 行更改为
        While .State = sckConnecting
            DoEvents
        Wend

Answer 2

感谢Tiger的回答但是这样的话，如果用户一直没有登录连不上的话， 会进入死循环吧

Answer 3

支持1楼。
 While .State = sckConnecting
  Delay 2     '如果加上延时，当sock多的时候就会很长时间了       
  DoEvents
 Wend

Answer 4

如果连接不上，会变成 sckError，不会一直循环的。

Answer 5

测试了,如果发送的 接收方 在线的话
好象 会判断不到
跳到 .State = sckConnected  ELSE 的部分了

Answer 6

跳出 插入的  DOEVENTS 时 .STATE=6 即 sckConnecting

Answer 7

你的 If .State = sckConnected Then 部分做了 SendData 操作，只执行了一个 DoEvents，就去循环下一个 WinsockClient 控件了。
这样前后多个 winsock 的并发可能导致程序线程来不及响应，导致状态不正确。你应该在 SendData 后加入等待
bIsSending = true
while bIsSending
    DoEvents
wend'模块变量 bIsSending 在事件 SendComplete、Error 中置为 False 

Answer 8

bIsSending = true
while bIsSending
    DoEvents
wend这个会不会造成死循环呀测试了 好象会死在那的

Answer 9

最大的不行在于 在DOEVENTS 客户端再点了一下全部发送 就出错了

Answer 10

先设置按钮的 Enabled = Fasle，全部发送后再恢复。

Answer 11

                    Do
26                        DoEvents
27
28                        j = j + 1
29                        If .State = sckConnected Then
30                            Exit Do               '如果连上就退出
31                        End If
32                      If .State <> 6 And j Mod 16 = 0 Then    '关键是这部分的语句
33                                DoEvents
34                        End If
35
36                        If j > iTryTimes Then Exit Do
37                    Loop替换为
Do
    DoEvents
Loop Until .State <> sckConnecting