📄 frmmain.frm
字号:
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Frame Frame3
BackColor = &H00FFC0FF&
Height = 495
Left = 120
TabIndex = 22
Top = 3440
Width = 2055
Begin VB.CommandButton CmdClearR
BackColor = &H00C0FFFF&
Caption = "清空接收区"
Height = 240
Left = 360
MaskColor = &H00FF0000&
TabIndex = 23
Top = 180
UseMaskColor = -1 'True
Width = 1335
End
End
Begin VB.Frame Frame4
BackColor = &H00FFC0C0&
BorderStyle = 0 'None
Height = 5655
Left = 2280
TabIndex = 4
Top = 0
Width = 6375
Begin VB.CheckBox CheckSend
BackColor = &H00C0FFC0&
Caption = "十六进制发送"
ForeColor = &H000000FF&
Height = 195
Left = 4320
TabIndex = 32
Top = 4000
Width = 1935
End
Begin VB.TextBox TxtSend
Height = 1455
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 19
Top = 4200
Width = 6375
End
Begin VB.TextBox TxtRecv
BackColor = &H00FFFFFF&
ForeColor = &H00C00000&
Height = 3540
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 18
Top = 360
Width = 6375
End
Begin VB.CommandButton CmdKW
Caption = "Kaiwei"
Height = 255
Left = 3600
TabIndex = 6
Top = 3960
Visible = 0 'False
Width = 735
End
Begin VB.CheckBox CheckRecv
BackColor = &H00C0FFFF&
Caption = "十六进制显示"
ForeColor = &H00FF0000&
Height = 195
Left = 4320
TabIndex = 31
Top = 160
Width = 1935
End
Begin VB.Label LabelS
Alignment = 2 'Center
BackColor = &H00C0FFC0&
BorderStyle = 1 'Fixed Single
Caption = "数据发送区 "
ForeColor = &H000000FF&
Height = 255
Left = 0
TabIndex = 21
Top = 3960
Width = 6375
End
Begin VB.Label LabelR
Alignment = 2 'Center
BackColor = &H00C0FFFF&
BorderStyle = 1 'Fixed Single
Caption = "数据接收区 "
ForeColor = &H00FF0000&
Height = 255
Left = 0
TabIndex = 20
Top = 120
Width = 6375
End
End
Begin VB.Menu file
Caption = "文件(&F)"
Begin VB.Menu exit
Caption = "退出(&X)"
End
End
Begin VB.Menu tool
Caption = "工具(&T)"
Begin VB.Menu config
Caption = "设置N-COM(&C)"
Enabled = 0 'False
End
Begin VB.Menu sending
Caption = "发送文件(&S)"
End
Begin VB.Menu repeatSend
Caption = "循环发送(&R)"
Begin VB.Menu strData
Caption = "字符串"
End
Begin VB.Menu fileData
Caption = "文件"
End
End
End
Begin VB.Menu CodeMode
Caption = "编码方式"
Begin VB.Menu GBCode
Caption = "GB"
Checked = -1 'True
End
Begin VB.Menu Unicode
Caption = "Unicode"
End
End
Begin VB.Menu about
Caption = "关于(&A)"
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim txtSendLen As Long '记录发送区的字符数
'初始化IP控件中的内容
Public Sub InitPara()
ipHost.Text = "192.168.1.24"
ipHost.Enabled = True
ComboPort.Enabled = True
ComboPortLocal.Enabled = False
End Sub
'重置socket
Private Sub WinsockReset()
If Winsock1.State <> 7 Then
If OptionTCPC.Value = True Then
StatusBar1.Panels(1).Text = "网络已断开 " & "请重新连接"
CmdOpenPort.Caption = "连接网络"
End If
If OptionTCPS.Value = True Then
StatusBar1.Panels(1).Text = "客户端已断开 " & "请重新监听"
CmdOpenPort.Caption = "开始监听"
End If
If OptionUDP.Value = True Then
StatusBar1.Panels(1).Text = "UDP已停止 " & "请重新开启"
CmdOpenPort.Caption = "开启UDP"
End If
PicState.Picture = ImageList1.ListImages(1).Picture
Timer2.Enabled = False
repeatSend.Enabled = False
sending.Enabled = False
OptionTCPS.Enabled = True
OptionTCPC.Enabled = True
OptionUDP.Enabled = True
Winsock1.Close
End If
End Sub
'根据编码方式，发送数据
Public Function WinsockSend(sendData As String) As Integer
Dim sLen As Integer
Dim sendByte() As Byte
If CheckSend.Value Then '十六进制方式显示
sendByte = StrToBytes(sendData, sLen)
Winsock1.sendData sendByte
Else
sLen = ByteLen(TxtSend.Text)
Select Case codeM
Case codeGB 'GB编码方式
Winsock1.sendData sendData
Case codeUnicode 'Unicode编码方式
sendByte = sendData
Winsock1.sendData sendByte
End Select
End If
WinsockSend = sLen
End Function
'根据编码方式，接收数据
Public Function WinsockRecv(ByVal bytesTotal As Long) As String
Dim recvByte() As Byte
Dim recvData As String
Dim hexData As String
Dim i
If CheckRecv.Value Then '十六进制方式显示
Winsock1.GetData recvByte
For i = 0 To bytesTotal - 1 Step 1
hexData = hexData & DeciToHex(recvByte(i)) & " "
Next i
recvData = recvData & hexData & " (" & bytesTotal & ")" & Chr(13) & Chr(10)
Else '文本方式显示
Select Case codeM
Case codeGB 'GB编码方式
Winsock1.GetData recvData
Case codeUnicode 'Unicode编码方式
Winsock1.GetData recvByte
recvData = recvByte
End Select
End If
WinsockRecv = recvData
End Function
Public Sub OpenNetwork()
On Error GoTo ErrLine '处理意外错误
'TCP Client方式
If OptionTCPC.Value = True Then
'如果网络已经连接，则先断开网络
If Winsock1.State <> 0 And Winsock1.State <> 8 Then
Winsock1.Close
PicState.Picture = ImageList1.ListImages(1).Picture
StatusBar1.Panels(1).Text = " 网络已断开 "
Timer2.Enabled = False
repeatSend.Enabled = False
sending.Enabled = False
CmdOpenPort.Caption = "连接网络"
OptionTCPS.Enabled = True
OptionTCPC.Enabled = True
OptionUDP.Enabled = True
Else
Winsock1.Close
Winsock1.RemoteHost = ipHost.Text 'ipHost.zone0Value & "." & ipHost.zone1Value & "." & ipHost.zone2Value & "." & ipHost.zone3Value
Winsock1.RemotePort = ComboPort.Text
Winsock1.Connect
StatusBar1.Panels(1).Text = "正在连接到 " & Winsock1.RemoteHost & "：" & Winsock1.RemotePort
CmdOpenPort.Caption = "断开网络"
OptionTCPS.Enabled = False
'OptionTCPC.Enabled = False
OptionUDP.Enabled = False
End If
End If
'TCP Server方式
If OptionTCPS.Value = True Then
'如果网络已经在监听，则先停止监听
If Winsock1.State <> 0 And Winsock1.State <> 8 Then
Winsock1.Close
PicState.Picture = ImageList1.ListImages(1).Picture
StatusBar1.Panels(1).Text = " 网络已断开 "
Timer2.Enabled = False
repeatSend.Enabled = False
sending.Enabled = False
CmdOpenPort.Caption = "开始监听"
OptionTCPS.Enabled = True
OptionTCPC.Enabled = True
OptionUDP.Enabled = True
Else
Winsock1.Close
Winsock1.RemoteHost = ipHost.Text
Winsock1.Bind ComboPortLocal.Text
Winsock1.Listen
StatusBar1.Panels(1).Text = "正在监听 " & Winsock1.LocalIP & "：" & Winsock1.LocalPort
CmdOpenPort.Caption = "停止监听"
'OptionTCPS.Enabled = False
OptionTCPC.Enabled = False
OptionUDP.Enabled = False
End If
End If
'UDP方式
If OptionUDP.Value = True Then
'如果网络已经在监听，则先停止监听
If Winsock1.State <> 0 And Winsock1.State <> 8 Then
Winsock1.Close
PicState.Picture = ImageList1.ListImages(1).Picture
StatusBar1.Panels(1).Text = " UDP通信停止 "
Timer2.Enabled = False
repeatSend.Enabled = False
sending.Enabled = False
CmdOpenPort.Caption = "开启UDP"
OptionTCPS.Enabled = True
OptionTCPC.Enabled = True
OptionUDP.Enabled = True
udpEnabled = False
Else
With Winsock1
.Close
.RemoteHost = ipHost.Text
.RemotePort = ComboPort.Text
.Bind ComboPortLocal.Text
End With
StatusBar1.Panels(1).Text = "UDP通信 " & Winsock1.RemoteHost & "：" & Winsock1.RemotePort
CmdOpenPort.Caption = "关闭UDP"
OptionTCPS.Enabled = False
OptionTCPC.Enabled = False
'OptionUDP.Enabled = False
udpEnabled = True
repeatSend.Enabled = True
PicState.Picture = ImageList1.ListImages(2).Picture
sending.Enabled = True
Timer2.Enabled = False
End If
End If
Exit Sub
ErrLine:
If OptionTCPC.Value = True Then
StatusBar1.Panels(1).Text = " 网络连接失败！ "
MsgBox "请检查网络是否通畅，参数是否设置正确"
End If
If OptionTCPC.Value = True Then
StatusBar1.Panels(1).Text = " 监听失败！ "
MsgBox "请检查网络是否故障，参数是否设置正确"
End If
If OptionTCPC.Value = True Then
StatusBar1.Panels(1).Text = " UDP开启失败！ "
MsgBox "请检查网络是否故障，参数是否设置正确"
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -