📄 form1.frm
字号:
Begin VB.Menu miFile
Caption = "文件(&F)"
NegotiatePosition= 1 'Left
Begin VB.Menu miQuit
Caption = "退出(&Q)"
End
End
Begin VB.Menu miSet
Caption = "设置(&S)"
Begin VB.Menu miSetting
Caption = "设置(&S)"
End
End
Begin VB.Menu miControl
Caption = "控制(&C)"
Begin VB.Menu miStartServer
Caption = "启动服务(&S)"
Shortcut = ^S
End
Begin VB.Menu miStopServer
Caption = "停止服务(&T)"
Enabled = 0 'False
Shortcut = ^T
End
Begin VB.Menu miOffLine
Caption = "分离终端(&O)"
Enabled = 0 'False
End
Begin VB.Menu miSendData
Caption = "发送数据(&D)"
Enabled = 0 'False
End
Begin VB.Menu miSendK
Caption = "发送对话框(&K)"
Enabled = 0 'False
End
Begin VB.Menu miClear
Caption = "清空(&R)"
End
Begin VB.Menu miS1
Caption = "-"
End
Begin VB.Menu miStartNoProService
Caption = "启动无协议服务"
End
Begin VB.Menu miStopNoProService
Caption = "停止无协议服务"
Enabled = 0 'False
End
Begin VB.Menu miS4
Caption = "-"
End
Begin VB.Menu miNoProBack
Caption = "无协议应答"
Enabled = 0 'False
End
Begin VB.Menu miS3
Caption = "-"
End
Begin VB.Menu menu_AddOneUser
Caption = "增加用户"
End
End
Begin VB.Menu miShowView
Caption = "显示(&V)"
Begin VB.Menu miViewData
Caption = "显示数据(&D)"
Checked = -1 'True
End
Begin VB.Menu miHEXShow
Caption = "HEX显示(&H)"
End
Begin VB.Menu miAnswer
Caption = "应答(&A)"
End
Begin VB.Menu miCount
Caption = "计数(&C)"
Checked = -1 'True
End
End
Begin VB.Menu miHelp
Caption = "帮助(&H)"
Begin VB.Menu miHelpContent
Caption = "帮助(&H)"
End
Begin VB.Menu miAbout
Caption = "关于(&A)"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub Form_Load()
srvport = 5002
waittime = 120
Timer2.Enabled = True
LineCount = 0
SysAutoM = 0
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MsgBox("确定要退出吗？", vbYesNo, "确认") = vbNo Then
Cancel = 1
Exit Sub
End If
If Form1.Toolbar1.Buttons.Item(2).Enabled = True Then
miStopServer_Click
End If
End Sub
Private Sub Form_Resize()
If Form1.Height < 5685 Or Form1.Width < 7860 Then Exit Sub
Form1.ListView1.Width = Form1.Width - 130
Form1.Text3.Width = Form1.Width - 150
Form1.Text3.Height = Form1.Height - 4220
'Form1.Command2.Top = Form1.Height - 1395
'Form1.Command2.Left = Form1.Width - 1380
'Form1.Command1.Top = Form1.Height - 1395
'Form1.Command1.Left = Form1.Width - 560
Form1.Text1.Top = Form1.Height - 1365
Me.ckHex.Top = Form1.Text1.Top
'Form1.Text1.Width = Form1.Width - 2070
Form1.Text2.Top = Form1.Height - 1365
Form1.Text4.Width = Form1.Width - 4100
redcolor = 255
greencolor = 30
bluecolor = 30
colorflag = 1
End Sub
Private Sub Form_Unload(Cancel As Integer)
Timer2.Enabled = False
End Sub
Private Sub ListView1_Click()
If ListView1.ListItems.Count > 0 Then
Text2.Text = ListView1.SelectedItem.Text
End If
End Sub
Private Sub ListView1_DblClick()
miSendK_Click
End Sub
Private Sub menu_AddOneUser_Click()
Dim us As user_info
Dim i As Long
Dim sTim As String
For i = 1 To 11
us.m_userid(i) = Asc(Mid("13900000000", i, 1))
Next i
us.m_sin_addr(4) = 192
us.m_sin_addr(3) = 168
us.m_sin_addr(2) = 0
us.m_sin_addr(1) = 243
us.m_sin_port = 5002
us.m_local_addr(4) = 192
us.m_local_addr(3) = 168
us.m_local_addr(2) = 0
us.m_local_addr(1) = 243
us.m_local_port = 5001
sTim = Format(Now, "YYYY-MM-DD HH:mm:SS")
For i = 1 To 19
us.m_logon_date(i) = Asc(Mid(sTim, i, 1))
us.m_update_date(i) = Asc(Mid(sTim, i, 1))
Next i
us.m_status = 1
'为了统一接口风格，AddOneUser使用add_one_user替代
'AddOneUser us
add_one_user us
pollusertable
End Sub
Private Sub miAbout_Click()
FAbout.Show 1
End Sub
Private Sub miAnswer_Click()
miAnswer.Checked = Not miAnswer.Checked
End Sub
Private Sub miClear_Click()
Text3.Text = ""
End Sub
Private Sub miCount_Click()
miCount.Checked = Not miCount.Checked
End Sub
Private Sub miHelpContent_Click()
FHelp.Show 1
End Sub
Private Sub miHEXShow_Click()
miHEXShow.Checked = Not miHEXShow.Checked
End Sub
Private Sub miNoProBack_Click()
Form1.miNoProBack.Checked = Not Form1.miNoProBack.Checked
End Sub
Private Sub miOffLine_Click()
Dim i As Long
Dim closeoneid(1 To 12) As Byte
Dim closeonemess(1 To 1024) As Byte
If Len(Text2.Text) <> 11 Then Exit Sub
For i = 1 To 11
closeoneid(i) = Asc(Mid(Form1.Text2.Text, i, 1))
Next
closeoneid(12) = 0
i = do_close_one_user(closeoneid(1), closeonemess(1))
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End Sub
Private Sub miQuit_Click()
If MsgBox("确定要退出吗？", vbYesNo, "确认") = vbYes Then
If Form1.Toolbar1.Buttons.Item(2).Enabled = True Then
miStopServer_Click
End If
End
End If
End Sub
Public Sub miSendData_Click()
Dim i As Long
Dim sendresult As Long
Dim sendsrc(1 To 1024) As Byte
Dim sendsrclen As Long
Dim sendmess(1 To 1024) As Byte
Dim senduserid(1 To 12) As Byte
If Len(Text2.Text) <> 11 Then
Exit Sub
End If
For i = 1 To 11
senduserid(i) = Asc(Mid(Text2.Text, i, 1))
Next
senduserid(12) = 0
sendsrclen = Len(Text1.Text)
If Me.ckHex.Value = 1 Then '十六进制发送
sendsrclen = Len(Text1.Text) / 2
For i = 1 To sendsrclen
sendsrc(i) = Val("&H" & Mid(Text1.Text, (i - 1) * 2 + 1, 2))
Next
Else
For i = 1 To sendsrclen
sendsrc(i) = Asc(Mid(Text1.Text, i, 1))
Next
End If
'sendsrc(1) = 255
'sendsrc(2) = 255
'sendsrc(3) = 105
'sendsrc(4) = 3
'sendsrc(5) = 3
'sendsrc(6) = 105
sendresult = do_send_user_data(senduserid(1), sendsrc(1), sendsrclen, sendmess(1))
'sendresult = do_send_user_data(senduserid(1), sendsrc(1), 6, sendmess(1))
If sendresult = 0 Then
Form1.addtext ("向 " & Form1.Text2.Text & " 发送数据：" & Form1.Text1.Text)
Else
Form1.addtext ("发送失败：" & StrConv(sendmess, vbUnicode))
End If
End Sub
Private Sub miSendK_Click()
If Len(Form1.Text2.Text) = 11 Then
FSend.Text2.Text = Form1.Text2.Text
FSend.Show 1
End If
End Sub
Private Sub miSetting_Click()
FSetting.Show 1
End Sub
Private Sub miStartNoProService_Click()
Winsock1.Bind srvport
Form1.miStartNoProService.Enabled = False
Form1.miStopNoProService.Enabled = True
Form1.miNoProBack.Enabled = True
Form1.addtext "无协议服务启动"
End Sub
Private Sub miStartServer_Click()
Dim mess(1 To 1024) As Byte
Dim result As Integer
result = SetWorkMode(2) '兼容以前模式
If result = 0 Then
Form1.addtext ("阻塞模式")
ElseIf result = 1 Then
Form1.addtext ("非阻塞模式") 'use this mode on VB
Timer3.Enabled = True
Else
Form1.addtext ("非阻塞模式:消息机制")
End If
'result = start_gprs_server(Form1.hwnd, WM_USER + 103, srvport, mess(1))
result = start_net_service(Form1.hwnd, WM_USER + 103, srvport, mess(1))
If result = 0 Then
Form1.addtext (StrConv(mess, vbUnicode))
Else
Form1.addtext ("服务器启动失败" & StrConv(mess, vbUnicode))
End If
Hook (Form1.hwnd)
If SysAutoM = 1 Then
Timer1.Enabled = True
End If
Form1.StatusBar1.Panels.Item(2).Text = "启动"
Form1.Toolbar1.Buttons.Item(1).Enabled = False
Form1.Toolbar1.Buttons.Item(2).Enabled = True
Form1.Toolbar1.Buttons.Item(3).Enabled = True
Form1.Toolbar1.Buttons.Item(4).Enabled = True
Form1.miStartServer.Enabled = False
Form1.miStopServer.Enabled = True
Form1.miOffLine.Enabled = True
Form1.miSendData.Enabled = True
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -