📄 frmmain.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form SeverFrm
BorderStyle = 1 'Fixed Single
Caption = "短消息发送器 V1.0"
ClientHeight = 7455
ClientLeft = 45
ClientTop = 630
ClientWidth = 12000
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7455
ScaleWidth = 12000
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton CmdCancel
Cancel = -1 'True
Caption = "退出"
Height = 495
Left = 10080
TabIndex = 11
Top = 3240
Width = 1335
End
Begin MSWinsockLib.Winsock SockToCln
Index = 0
Left = 10680
Top = 1920
_ExtentX = 741
_ExtentY = 741
_Version = 393216
End
Begin VB.Frame FrameInfo
Caption = "发送信息"
Height = 2655
Left = 2280
TabIndex = 1
Top = 4080
Width = 8895
Begin VB.CommandButton cmdRead
Caption = "读取"
Height = 285
Left = 4320
TabIndex = 10
Top = 840
Width = 615
End
Begin VB.TextBox txtCenterNumber
Appearance = 0 'Flat
Height = 285
Left = 1800
TabIndex = 5
Top = 840
Width = 2415
End
Begin VB.TextBox txtMsg
Appearance = 0 'Flat
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1995
Left = 6360
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 480
Width = 3795
End
Begin VB.CommandButton cmdSend
Caption = "发送"
Height = 375
Left = 5280
TabIndex = 3
Top = 1080
Width = 975
End
Begin VB.TextBox txtPhoneNumber
Appearance = 0 'Flat
Height = 285
Left = 1800
TabIndex = 2
Top = 480
Width = 2415
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "手机号码:"
Height = 180
Index = 4
Left = 975
TabIndex = 9
Top = 480
Width = 810
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "短消息内容: "
Height = 180
Index = 1
Left = 5355
TabIndex = 8
Top = 480
Width = 1080
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "信息中心号码: "
Height = 180
Index = 5
Left = 615
TabIndex = 7
Top = 840
Width = 1260
End
Begin VB.Label LabText
AutoSize = -1 'True
Caption = "字数:0/70"
Height = 180
Left = 5400
TabIndex = 6
Top = 720
Width = 810
End
End
Begin MSComctlLib.StatusBar StatusMsg
Align = 2 'Align Bottom
Height = 495
Left = 0
TabIndex = 0
Top = 6960
Width = 12000
_ExtentX = 21167
_ExtentY = 873
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 3
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
Alignment = 1
AutoSize = 2
TextSave = "2007-6-1"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
AutoSize = 2
TextSave = "8:18"
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Alignment = 2
AutoSize = 1
Object.Width = 15981
EndProperty
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin MSCommLib.MSComm MSComm1
Left = 10320
Top = 360
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin MSComctlLib.ListView LvCnn
Height = 2535
Left = 1920
TabIndex = 12
Top = 720
Width = 7455
_ExtentX = 13150
_ExtentY = 4471
View = 3
Arrange = 2
Sorted = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 4
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "管理员ID"
Object.Width = 2893
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "连接状态"
Object.Width = 2540
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "时间"
Object.Width = 4304
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 3
Text = "通道号"
Object.Width = 2117
EndProperty
End
Begin VB.Menu conn
Caption = "连接"
End
Begin VB.Menu mnuScore
Caption = "成绩信息"
Begin VB.Menu mnuSend
Caption = "发送成绩信息"
End
End
End
Attribute VB_Name = "SeverFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const prex = "0891"
Const midx = "11000D91"
Const sufx = "0008FF"
Private Sub fresh_Click()
' LstState.AddItem "完成..."
End Sub
'Private Sub chkDebug_Click()
' picDebug.Visible = chkDebug.Value
'End Sub
Private Sub cmdSend_Click()
If txtPhoneNumber.Text = "" Then
MsgBox "请输入手机号码!", vbExclamation, "提示"
Exit Sub
End If
If txtCenterNumber.Text = "" Then
MsgBox "请输入信息中心号码!", vbExclamation, "提示"
Exit Sub
End If
Dim what As Boolean
Dim s As String
what = sendIt("AT+CMGF=0", "OK", "ERROR")
If what = True Then
s = txtPhoneNumber.Text
setStatus "发送消息到用户 " & s
what = SendSMS(txtCenterNumber.Text, s, txtMsg.Text)
If what = False Then GoTo p
setStatus "发送..."
DoEvents
End If
setStatus "发送消息成功!"
Exit Sub
p:
setStatus "发送消息失败!"
MsgBox "发送消息失败...", vbExclamation, "提示"
End Sub
Private Sub conn_Click()
conFrm.Visible = True
End Sub
Private Function SendSMS(csca As String, phnum As String, Msg As String) As Boolean
Dim what As Boolean
Dim pduText As String, pSmsc As String, pNum As String, pMsg As String
Dim nTime As Date
Dim i As Integer, nLength As Integer
Dim commandLength As Integer
Dim dd As String
Dim strPdu As String, OneWord As String
Dim Temp1 As String, Temp2 As String
strPdu = ""
nLength = Len(Msg) '所要转换的所有字符长度
For i = 1 To nLength
OneWord = Mid(Msg, i, 1) '取其中一个字符
dd = Hex(AscW(OneWord)) '转换成Unicode码
If Len(dd) = 4 Then '长度不够时补足4位，即2个八位组
strPdu = strPdu + dd
Else
If Len(dd) = 2 Then
strPdu = strPdu + "00" + dd
Else
strPdu = strPdu + "000" + dd
End If
End If
Next i 'strPdu中的内容就是要传递的信息PDU码
Temp1 = Hex(Len(strPdu) / 2) 'strPdu中的内容就是要传递的信息PDU码
If Len(Temp1) = 1 Then
Temp2 = "0" + Temp1
Else
Temp2 = Temp1
End If 'temp2为数据PDU长度
commandLength = (Len(strPdu)) / 2 + 15 '发送PDU总长度．用于AT+CMGS
pSmsc = Trim(telc(csca))
pNum = Trim(telc(phnum))
pduText = prex & pSmsc & midx & pNum & sufx & Temp2 & strPdu '全部的PDU数据
what = sendIt("AT+CMGS=" + CStr(commandLength) + vbCrLf, ">", "ERROR")
Delay (3)
If what = True Then
what = sendIt(Trim(pduText) & Chr(26), "OK", "ERROR")
End If
SendSMS = what
End Function
Private Sub cmdRead_Click()
Dim what As Boolean
Dim nPos As Integer
txtOut = ""
what = sendIt("AT+CSCA?", "OK", "ERROR")
If what = True Then
txtCenterNumber.Text = getScsa(txtOut)
End If
End Sub
Private Sub mnuSend_Click()
Dim rs As Recordset
Set rs = DBCnn.Execute("Update pu_pr set pp_time='" & strTime & "' where s_id='ap0306601'")
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -