📄 frm_join.frm
字号:
VERSION 5.00
Object = "{2B12169D-6738-11D2-BF5B-00A024982E5B}#31.8#0"; "CoolButton.OCX"
Begin VB.Form frm_join
BorderStyle = 1 'Fixed Single
Caption = "GPRS用电管理系统"
ClientHeight = 2610
ClientLeft = 45
ClientTop = 330
ClientWidth = 7395
Icon = "frm_join.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2610
ScaleWidth = 7395
StartUpPosition = 1 '所有者中心
Begin TButton.axButton xpcmdbutton3
Height = 300
Left = 5400
TabIndex = 17
Top = 2040
Width = 1095
_ExtentX = 1931
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "退 出"
MaskColor = -2147483633
End
Begin TButton.axButton xpcmdbutton1
Height = 300
Left = 3720
TabIndex = 16
Top = 2040
Width = 1095
_ExtentX = 1931
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "接 通"
MaskColor = -2147483633
End
Begin TButton.axButton xpcmdbutton2
Height = 300
Left = 6000
TabIndex = 15
Top = 360
Width = 735
_ExtentX = 1296
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "查 询"
MaskColor = -2147483633
End
Begin VB.TextBox txt_ip
Appearance = 0 'Flat
Height = 300
Left = 1320
TabIndex = 13
Top = 2040
Width = 1935
End
Begin VB.TextBox txt_qurry
Appearance = 0 'Flat
Height = 300
Left = 4440
MaxLength = 12
TabIndex = 6
Top = 360
Width = 1455
End
Begin VB.TextBox txt_biaohao
Appearance = 0 'Flat
Enabled = 0 'False
Height = 300
Left = 4680
TabIndex = 5
Top = 1440
Width = 1935
End
Begin VB.TextBox txt_sim
Appearance = 0 'Flat
Enabled = 0 'False
Height = 300
Left = 1320
TabIndex = 4
Top = 1440
Width = 1935
End
Begin VB.TextBox txt_name
Appearance = 0 'Flat
Enabled = 0 'False
Height = 300
Left = 4680
TabIndex = 3
Top = 960
Width = 1935
End
Begin VB.TextBox txt_id
Appearance = 0 'Flat
Enabled = 0 'False
Height = 300
Left = 1320
TabIndex = 2
Top = 960
Width = 1935
End
Begin VB.OptionButton Option2
Appearance = 0 'Flat
Caption = "SIM卡号"
ForeColor = &H80000008&
Height = 255
Left = 3360
TabIndex = 1
Top = 420
Width = 975
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "客户编号"
ForeColor = &H80000008&
Height = 255
Left = 2400
TabIndex = 0
Top = 420
Width = 1095
End
Begin VB.Label Label27
BackStyle = 0 'Transparent
Caption = "终端ＩＰ："
Height = 255
Left = 240
TabIndex = 14
Top = 2085
Width = 975
End
Begin VB.Label Label25
BackStyle = 0 'Transparent
Caption = "请输入要接通的客户信息："
Height = 255
Left = 240
TabIndex = 12
Top = 480
Width = 2175
End
Begin VB.Label Label23
BackStyle = 0 'Transparent
Caption = "用户姓名："
Height = 255
Left = 3600
TabIndex = 11
Top = 1080
Width = 975
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "电能表编号："
Height = 255
Left = 3600
TabIndex = 10
Top = 1560
Width = 1095
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "用户SIM号："
Height = 255
Left = 240
TabIndex = 9
Top = 1560
Width = 1095
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户编号："
Height = 255
Left = 240
TabIndex = 8
Top = 1080
Width = 975
End
Begin VB.Label Label26
BackStyle = 0 'Transparent
Caption = "接通终端负荷"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 7
Top = 120
Width = 1455
End
End
Attribute VB_Name = "frm_join"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub xpcmdbutton1_Click()
Dim i As Integer
Dim senddata() As Byte
Dim num As Long
Dim str1 As String
Dim str2 As String
Dim strsql As String
Dim pw As String
Dim sum As Long
If Trim(txt_ip.Text) = "" Then
MsgBox ("终端ＩＰ：不能为空！"), vbOKOnly + vbInformation, "提示"
Exit Sub
End If
If Trim(txt_id.Text) = "" Then
MsgBox ("请您先查询！"), vbOKOnly + vbInformation, "提示"
Exit Sub
End If
strsql = "select user_dtupw from userbasic where user_id='" & txt_id.Text & "'"
openrs strsql
pw = rs.Fields("user_dtupw").Value
clors
ReDim senddata(23) As Byte '//采集数据包长度24
'//处理SIM卡号
For i = 0 To 4
num = Mid(Trim(txt_sim.Text), 2 * (i - 0) + 1, 2)
senddata(i) = num
Next i
num = Mid(Trim(txt_sim.Text), 11, 1)
senddata(5) = num
'//处理表号（６）txt_biaohao.Text
For i = 6 To 11 Step 1
num = Mid(Trim(txt_biaohao.Text), 2 * (i - 6) + 1, 2)
senddata(i) = num
Next i
'//处理用户密码（６）pw
For i = 12 To 17 Step 1
num = Mid(pw, 2 * (i - 12) + 1, 2)
senddata(i) = num
Next i
'//密码取反（６）（12-17字节取反）
For i = 18 To 23
senddata(i) = Not senddata(i - 6)
Next i
'//累加和（１）
For i = 0 To 23 Step 1
num = senddata(i)
sum = sum + num
sum = sum Mod 256
Next i
senddata(23) = sum
Dim strregdata1 As String
Dim regdata1() As Byte
Dim regdata2() As Byte
Dim regdata() As Byte
Dim numregdata As Integer
Dim dtuip As String
Dim dtuport As String
dtuip = Trim(txt_ip.Text)
dtuport = "80"
If frm_main.ActiveBar21.Bands("statusbar").Tools("s1").Caption = "现在状态GSM " Then
strregdata1 = "ATJSS" & txt_sim.Text & "FDGJ000000:"
Else
strregdata1 = "ATJAU" & dtuip & "PORT:" & dtuport
End If
regdata1 = StrConv(strregdata1, vbFromUnicode)
regdata2 = join_pctodtu(senddata)
numregdata = UBound(regdata1) + UBound(regdata2) + 2
ReDim regdata(numregdata - 1) As Byte
For i = 0 To UBound(regdata1) Step 1
regdata(i) = regdata1(i)
Next i
For i = UBound(regdata1) + 1 To numregdata - 1
regdata(i) = regdata2(i - UBound(regdata1) - 1)
Next i
comsenddata regdata '发送数据
'//清空缓冲区
ReDim bybuff(0) As Byte
bybuff(0) = 0
End Sub
Private Sub xpcmdbutton2_Click()
Dim strsql
If Option1.Value = False And Option2.Value = False Then
MsgBox ("您没有选择查询条件！"), vbOKOnly + vbInformation, "提示"
Exit Sub
End If
If Trim(txt_qurry.Text) = "" Then
MsgBox ("查询值不能为空！"), vbOKOnly + vbInformation, "提示"
Exit Sub
End If
If Option1.Value = True Then
strsql = "select * from userbasic where user_id='" & Trim(txt_qurry.Text) & "'"
openrs strsql
If rs.EOF Then
MsgBox ("该用户还没有开户！"), vbOKOnly + vbInformation, "提示"
clors
Exit Sub
End If
End If
If Option2.Value = True Then
strsql = "select * from userbasic where user_sim='" & Trim(txt_qurry.Text) & "'"
openrs strsql
If rs.EOF Then
MsgBox ("该用户还没有开户！"), vbOKOnly + vbInformation, "提示"
clors
Exit Sub
End If
End If
txt_id.Text = rs.Fields("user_id").Value
txt_name.Text = rs.Fields("user_name").Value
txt_sim.Text = rs.Fields("user_sim").Value
txt_biaohao.Text = rs.Fields("user_biaohao").Value
clors
End Sub
Private Sub xpcmdbutton3_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -