Option Explicit
'定义常量
Const BUSY As Boolean = False
Const FREE As Boolean = True
'定义连接状态
Dim ConnectState() As Boolean
Dim RXD_Point As Integer
Dim ZxFlag As BooleanPrivate Sub Form_Load()
ReDim Preserve ConnectState(0 To 1)
On Error Resume Next
ConnectState(0) = FREE
ConnectState(1) = FREE
'指定网络端口号
Listener.LocalPort = 1000
'‘开始侦听
Listener.Listen
Call SendMessage(RecList.hwnd, LB_SETHORIZONTALEXTENT, _
8000, ByVal 0&)
Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, _
8000, ByVal 0&)
End SubPrivate Sub Listener_ConnectionRequest(ByVal requestID As Long)
Dim SockIndex As Integer
Dim SockNum As Integer
On Error Resume Next
List1.AddItem "[ID=" & requestID & "]" & "请求连接,已接受！"
'查找连接的用户数
SockNum = UBound(ConnectState)
If SockNum > 14 Then
' Form1.Print SockIndex & ""
Exit Sub
End If
'查找空闲的sock
SockIndex = FindFreeSocket()
'如果已有的sock都忙，而且sock数不超过15个，动态添加sock
If SockIndex > SockNum Then
Load Sock(SockIndex)
End If
ConnectState(SockIndex) = BUSY
Sock(SockIndex).Tag = SockIndex
'接受请求
Sock(SockIndex).Accept (requestID)
End Sub'客户断开，关闭相应的sock
Private Sub Sock_Close(Index As Integer)
If Sock(Index).State <> sckClosed Then
Sock(Index).Close
End If
ConnectState(Index) = FREE
Form1.Print Index & "close"
End Sub'接收数据
Private Sub Sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim tubf() As Byte '接收的数据数组
Dim Nowstr As String '暂存所有的接受数据
Dim data_length As Integer '接收的数据字节数组下标长度
Dim i As Integer
Dim ii As Integer
Dim temp As String '暂存提取的终端地址
Dim getAdder As String '获取正常的终端地址
'获取数据
Sock(Index).GetData tubf, vbArray + vbByte
'显示数据
data_length = UBound(tubf)
For i = 0 To UBound(tubf)
Nowstr = Nowstr & Right("0" & Hex(tubf(i)), 2) & " "
Next
RecList.AddItem "[#" & Index & "]" & "发送 " & Nowstr
Nowstr = ""
'取地址：
For ii = 1 To 3 '假设终端的地址是一个6位长度，例如：000001
temp = temp + Right("0" & Hex(tubf(ii)), 2) '从报文中提取前几位设备的地址
Next ii
'把地址改成正常的阅读模式
getAdder = Right(temp, 2) '
temp = Left(temp, Len(temp) - 2)
getAdder = getAdder + Right(temp, 2)
temp = Left(temp, Len(temp) - 2)
getAdder = getAdder + Right(temp, 2)
'以下是判断地址是否在数据库中
SQL = "select*from ceshi where Adder='" & getAdder & "'"
Call CnOpen
RsOpen (SQL)
If Rs.EOF = True Then
Exit Sub
Else
'判断是否是初始请求，是则显示在线
If tubf(0) = &H68 And tubf(7) = &H68 And tubf(data_length) = &H16 Then
Dim FunCode As String
FunCode = tubf(8) ' = &HE
If FunCode = &HE Then
List1.AddItem "[终端-" & getAdder & "]" & "在线"
End If
'回付连接确认帧
Dim sendbuf(7) As Byte
Dim TempStr As Byte
Dim Code As Long
sendbuf(0) = &H68
Code = Code + sendbuf(0)
TempStr = Val(Right(temp, 2))
sendbuf(1) = DEC_TO_BCD(TempStr)
Code = Code + sendbuf(1)
temp = Left(temp, Len(temp) - 2)
TempStr = Val(Right(temp, 2))
sendbuf(2) = DEC_TO_BCD(TempStr)
Code = Code + sendbuf(2)
TempStr = Val(Right(temp, 2))
sendbuf(3) = DEC_TO_BCD(TempStr)
Code = Code + sendbuf(3)
sendbuf(4) = &H68
Code = Code + sendbuf(4)
sendbuf(5) = &HE
Code = Code + sendbuf(5)
sendbuf(6) = Code Mod 256
sendbuf(7) = &H16
Sock(Index).SendData sendbuf
data_length = UBound(sendbuf)
For i = 0 To UBound(sendbuf)
Nowstr = Nowstr & Right("0" & Hex(sendbuf(i)), 2) & " "
Next
RecList.AddItem "[#" & Index & "]" & "发送 " & Nowstr
End If
ZxFlag = True
Timer1.Enabled = True
End If
Rs.Close
CN.Close
End Sub'寻找空闲的sock
Public Function FindFreeSocket()
Dim SockCount, i As Integer
SockCount = UBound(ConnectState)
For i = 0 To SockCount
If ConnectState(i) = FREE Then
FindFreeSocket = i
Exit Function
End If
Next i
ReDim Preserve ConnectState(0 To SockCount + 1)
FindFreeSocket = UBound(ConnectState)
End Function
Private Sub Timer1_Timer()
Dim sendbuf(1) As Byte
Dim Nowstr As String
Dim data_length As Long
sendbuf(0) = &H68
sendbuf(1) = &H16
Sock(Index).SendData sendbuf'''''''''就是这个地方的index不知道怎么填了，哪位能帮帮我？？？？哪个客户端连接，就回哪个的信息
data_length = UBound(sendbuf)
For i = 0 To UBound(sendbuf)
Nowstr = Nowstr & Right("0" & Hex(sendbuf(i)), 2) & " "
Next
RecList.AddItem "[#" & Index & "]" & "发送 " & Nowstr
End Sub
如果用这个架构，要把index设置为全局变量，谁开启的timer，在开启之前给它赋值，对应于相应的连接。
Index这个在time中不能用，没有定义，那如何通过Sock(Index).发送数据呢？？