Option
Explicit
'定义常量
Const BUSY As
Boolean = False
Const FREE As
Boolean = True
'定义连接状态
Dim ConnectState() As Boolean
Dim RXD_Point As Integer
Dim ZxFlag As Boolean
Private 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
Sub
Private 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
------------------------------------------------
1 通信程序通常都是采用Client/Server形式。这就要求作为服务器的主机可以同时处理多个客户的请求。因此在编写服务器程序时要添加多个Winsock控件。在开始我们先加入两个Winsock控件。其中一个用来侦听网上请求信号，取名为Listener；另外一个为初始的连接口，取名叫Sock（0）。注意，后一个控件要设为动态数组的形式，以后当客户增多时，可在这个控件基础上动态增加。由于受资源限制，我们在本例中设定最多可以同时接纳15个客户。客户机一般只与一个主机相连，因此程序只须一个Winsock进行连接就足够了。这个程序要用到的控件较少，除了Winsock和Form控件外，只须再添加Commmand控件即可。下面是具体程序和详细注释。
2 ******************************
3 '服务器程序
4 ******************************
5 Option Explicit
6 定义常量
7 Const BUSY As Boolean = False
8 Const FREE As Boolean = True
9 定义连接状态
10 Dim ConnectState() As Boolean
11 Private Sub Form_Load()
12 ReDim Preserve ConnectState(0 To 1)
13 On Error Resume Next
14 ConnectState(0) = FREE
15 ConnectState(1) = FREE
16 '指定网络端口号
17 Listener.LocalPort = 1011
18 '开始侦听
19 Listener.Listen
20 End Sub
21 Private Sub Listener_ConnectionRequest(ByVal requestID As Long)
22 Dim SockIndex As Integer
23 Dim SockNum As Integer
24 On Error Resume Next
25 Form1.Print requestID & "连接请求"
26 '查找连接的用户数
27 SockNum = UBound(ConnectState)
28 If SockNum > 14 Then
29 Form1.Print SockIndex & ""
30 Exit Sub
31 End If
32 '查找空闲的sock
33 SockIndex = FindFreeSocket()
34 '如果已有的sock都忙，而且sock数不超过15个，动态添加sock
35 If SockIndex > SockNum Then
36 Load Sock(SockIndex)
37 End If
38 ConnectState(SockIndex) = BUSY
39 Sock(SockIndex).Tag = SockIndex
40 '接受请求
41 Sock(SockIndex).Accept (requestID)
42 Form1.Print SockIndex & "接受请求"
43 End Sub
44
45 '客户断开，关闭相应的sock
46 Private Sub Sock_Close(Index As Integer)
47 If Sock(Index).State <> sckClosed Then
48 Sock(Index).Close
49 End If
50 ConnectState(Index) = FREE
51 Form1.Print Index & "close"
52 End Sub
53
54 '接收数据
55 Private Sub Sock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
56 Dim dx As Double
57 Form1.Print "数据来自" & Index
58 Sock(Index).GetData dx, vbDouble
59 Form1.Print "dx=" & dx
60 End Sub
61
62 '寻找空闲的sock
63 Public Function FindFreeSocket()
64 Dim SockCount, i As Integer
65 SockCount = UBound(ConnectState)
66 For i = 0 To SockCount
67 If ConnectState(i) = FREE Then
68 FindFreeSocket = i
69 Exit Function
70 End Ifs
71 Next i
72 ReDim Preserve ConnectState(0 To SockCount + 1)
73 FindFreeSocket = UBound(ConnectState)
74 End Function
75
76 ***************************
77 '客户程序
78 ’***************************
79 Option Explicit
80 '发送数据
81 Private Sub command1_Click()
82 Dim dx As Double
83 dx = 23.9
84 sock.SendData dx
85 MsgBox ("data sended")
86 End Sub
87
88 Private Sub Form_Load()
89 '远程主机名
90 sock.RemoteHost = "media2"
91 '网络端口
92 sock.RemotePort = 1011
93 '发出连接命令
94 sock.Connect
95 Command1.Enabled = False
96 End Sub
97
98 '服务器关闭
99 Private Sub sock_Close()
100 MsgBox ("socket closed")
101 End Sub
102
103 '连接成功
104 Private Sub sock_Connect()
105 MsgBox ("socket connected")
106 Command1.Enabled = True
107 End Sub
加载中…
喜欢