for i=1 to 100
WskServer_c(Index).SendData Buffer
next
只有最后一个客户端才收得到数据，后来
vb出了一个更新程序，mswinsock.ocx 由原来的106K变为124K,不需要DoEvents就可以连续发送数据，你试一试，如果有很多客户端的话,DoEvents是不能解决问题的。
WskServer_c(Index).SendData Buffer
next
只有最后一个客户端才收得到数据，后来
vb出了一个更新程序，mswinsock.ocx 由原来的106K变为124K,不需要DoEvents就可以连续发送数据，你试一试，如果有很多客户端的话,DoEvents是不能解决问题的。
有！
请在所有需要SendData的地方不要直接调用SendData，而是
dim SD as String'全局变量
...
dim after ad double
SD=要发送的数据
TimerSD.Interval=1
TimerSD.enabled=True
after = Now + 5# / 24# / 3600#
do
doevents
if TimerSD.enabled=False then exit do
If Now > after Then
Msgbox "send data 5s overtime!"
Exit Do
End If
loop
...
Private Sub TimerSD_Timer()
On Error GoTo MSerr
tcpServer.SendData SD
TimerSD.enabled=false
Exit Sub
MSerr:
If Err.Number = 40006 Then
TimerSD.enabled=false
Exit Sub
Else
TimerSD.enabled=false
tcpServer_Close
Exit Sub
End If
end Sub
========================================================================
这种方法也会有同样的问题，当接收数据量大时，同样出现崩溃的错误，应该也是内在访问冲突问题。
DoEvents的通病？还是WinSock.ocx不适合写大数据的网络程序？
不要让WskServer_c(Index).SendData 直接发数据，而是先把数据存在一个集合中，待相对应的timer运行时再发送数据。这样，每一个winscok控件需要对应的一个集合，一个对应的timer即可。
把你的程序中的 WskServer_c(Index).SendData Buffer，改为wsSend buffer,index即可但是如果有这样一种情况：你要发送出去的数据为10Mb/秒,但你的带宽只有1Mb/秒,那么，winscok控件缓存区的数据会积越多，最后会占尽你电脑的所有内存而死，这就需要一个合适的调度程序了。
Dim Max0 As Long
Dim Coll() As New Collection '需要一个集合数组来存放发送的数据
Private Sub Form_Load()
Max0 = 30 '最大tcp连接数,winscok数组是多大就设为多大
Timer1(0).Enabled = False '需要一个timer控件数组。
Timer1(0).Interval = 1
ReDim Coll(0 To Max0)
For i = 1 To Max0
Load Timer1(i)
Next
End SubSub wsSend(buff, Index As Integer) '用来代替winscok的senddata过程，index为winscok控件数组索引
Coll(Index).Add buff
Timer1(Index).Enabled = True
End SubPrivate Sub Timer1_Timer(Index As Integer)
On Error GoTo eee
Dim bb
If Coll(Index).Count = 0 Then
Timer1(Index).Enabled = False
Exit Sub
End If
bb = Coll(Index).Item(1)
Coll(Index).Remove 1
WskServer_c(Index).SendData bb '此处才是实际发送数据
Exit Sub
eee:
Do While Coll(Index).Count > 0
Coll(Index).Remove 1
Loop
Timer1(Index).Enabled = False
WS1(Index).Close
End Sub
VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.ocx"
Begin VB.Form Form1
Caption = "vbr"
ClientHeight = 7560
ClientLeft = 9855
ClientTop = 3390
ClientWidth = 9105
LinkTopic = "Form1"
ScaleHeight = 7560
ScaleWidth = 9105
Begin MSWinsockLib.Winsock tcpCAS
Left = 8760
Top = 6720
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const MAXLOGFILESIZE As Long = 20000000
Private Declare Function mss Lib "mss" () As Long
Const IBUFSIZE = 131072
Dim iCAS(IBUFSIZE) As Byte
Dim iCASn As Long
Dim CASok As Boolean
Dim CASclosing As Boolean
Dim CASrpc As Long
Dim CASsending As String
Dim INtcpCAS_DataArrival As Boolean
Dim INtcpCAS_DataArrival_TotalBytes As Long
Private Sub Form_Load()
Dim after As Double
ChDrive "C"
ChDir "C:\tmp\test"
tcpCAS.RemoteHost = "127.0.0.1"
tcpCAS.RemotePort = 25200
If tcpCAS.State <> 0 Then
tcpCAS.Close
after = Now + 5# / 24# / 3600#
Do
DoEvents
If tcpCAS.State = 0 Then Exit Do
If Now > after Then
logtofile "Form_Load() wait tcpCAS.state==0 but " + CStr(tcpCAS.State) + " 5s overtime!"
Exit Do
End If
Loop
End If
logtofile "Connect CAS(" + tcpCAS.RemoteHost + ":" + CStr(tcpCAS.RemotePort) + "..."
iCASn = 0&
CASclosing = False
CASok = True
CASsending = ""
tcpCAS.Connect
after = Now + 5# / 24# / 3600#
Do
DoEvents
If tcpCAS.State = 7 Then Exit Do
If Now > after Then
logtofile "FatalError:Connect CAS failure!"
' MsgBox "FatalError:Connect CAS failure!", vbOKOnly
End 'Form
End If
Loop
If tcpCAS.State = 7 Then
logtofile "Connect CAS ok."
' TimerCAStouch.Enabled = True
Else
CASok = False
End If
Form1.Show
End Sub
Private Sub tcpCAS_DataArrival(ByVal bytesTotal As Long)
Dim i As Long
Dim p As Long
Dim qn As Long
Dim s As Long
Dim e As Long
Dim Total_Length As Long
Dim iBuf() As Byte
Dim lnx As String
Const STX = 2
Const ETX = 3
Const LF = 10
Dim L As Long
Dim XORSUM As Long
Dim BYTESUM As Long
Dim strMsgToProcess As String
Dim c As String
Dim PartyID As String
Dim cP As Integer
Dim n As Integer
Dim bt As Long
If INtcpCAS_DataArrival Then
logtofile "ReEnter tcpCAS_DataArrival bytesTotal=" + CStr(bytesTotal)
INtcpCAS_DataArrival_TotalBytes = bytesTotal
Exit Sub
End If
bt = bytesTotal
INtcpCAS_DataArrival = True
REDATA:
logtofile "IN tcpCAS_DataArrival bt=" + CStr(bt)
If bt > IBUFSIZE - iCASn Then
logtofile "Ignore " + CStr(bt - (IBUFSIZE - iCASn)) + " Bytes!"
bt = IBUFSIZE - iCASn
End If
' On Error Resume Next
' 收当前流
ReDim iBuf(bt - 1)
tcpCAS.GetData iBuf, vbArray + vbByte, bt
' logtofile "bt=" + CStr(bt)
' log每个收到的字节
i = 0
lnx = "cas-->BYTE:" + Right("0000000" + Hex(i), 8) + "-"
For i = 0 To bt - 1
lnx = lnx + " " + Right("0" + Hex(iBuf(i)), 2)
If i Mod 16 = 15 Then
logtofile lnx
lnx = "cas-->BYTE:" + Right("0000000" + Hex(i + 1), 8) + "-"
End If
Next
i = bt - 1
If i Mod 16 <> 15 Then
logtofile lnx
End If' 将本次收到字节放到接收缓冲区末尾
For i = 0 To bt - 1
iCAS(iCASn + i) = iBuf(i)
Next
iCASn = iCASn + bt
' logtofile "iCASn=" + CStr(iCASn)
' 从接收缓冲区中逐个解包
qn = iCASn '剩余要解包字节数
p = 0 '本次解包的首字节 strMsgToProcess = ""
For i = 0 To qn - 1
c = iCAS(p + i)
If c = LF Then c = 124
strMsgToProcess = strMsgToProcess + ChrW(c)
Next
logtofile "pas-->" + strMsgToProcess n = 0
Do
For i = 0 To qn - 1
If LF = iCAS(p + i) Then Exit For
Next
If i >= qn Then
For i = 0 To qn - 1
iCAS(i) = iCAS(p + i)
Next
iCASn = qn
Exit Do '找不到LF
End If
Total_Length = i + 1
L = i - 1
strMsgToProcess = ""
For i = 0 To L
strMsgToProcess = strMsgToProcess + ChrW(iCAS(p + i))
Next
logtofile "cas-->" + strMsgToProcess n = n + 1
If n >= 200 Then
logtofile "Wait..."
Wait
n = 0
End If p = p + Total_Length
qn = qn - Total_Length
If strMsgToProcess = "test9999" Then
logtofile "END"
tcpCAS.Close
End 'From
End If
If qn <= 0 Then
iCASn = 0
Exit Do
End If
Loop
If INtcpCAS_DataArrival_TotalBytes > 0 Then
bt = INtcpCAS_DataArrival_TotalBytes
INtcpCAS_DataArrival_TotalBytes = 0
logtofile "REDATA bt=" + CStr(bt)
GoTo REDATA
End If
INtcpCAS_DataArrival = False
End Sub
Private Sub tcpCAS_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
' On Error Resume Next
logtofile "FatalError:tcpCAS_Error:" + CStr(Number) + "|" + Description + "|" + Hex(Scode) + "|" + Source
CancelDisplay = True
If CASclosing Then Exit Sub
CASclosing = True
CASok = False Unload Me 'End 'Form
' TimerCASreconn.Enabled = True
End Sub
Private Sub logtofile(s As String)
Dim f As Integer
'On Error Resume Next
f = FreeFile()
Open App.Path + "\VBR1.LOG" For Append As #f
Print #f, Format(Now, "YYYY-MM-DD hh:mm:ss") + "." + Right("00" + CStr(mss()), 3) + " " + s
Close #f
If FileLen(App.Path + "\VBR1.LOG") > MAXLOGFILESIZE Then
Kill App.Path + "\VBR2.LOG"
Name App.Path + "\VBR1.LOG" As App.Path + "\VBR2.LOG"
End If
End Sub
Private Sub Wait()
Dim after As Double
after = Now + 1# / 24# / 3600#
Do
DoEvents '此处tcpCAS_DataArrival会重入
If Now > after Then Exit Do
Loop
End Sub
将这个dll放在windows\system32目录下，在VB6中 Private Declare Function mss Lib "mss" () As Long Debug.Print Format(Now, "YYYY-MM-DD hh:mm:ss") + "." + Right("00" + CStr(mss()), 3)
http://download.csdn.net/detail/zhao4zhong1/4659776