📄 frmstart.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmStart
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 = "frmStart.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7455
ScaleWidth = 12000
StartUpPosition = 2 'CenterScreen
Begin VB.Frame FrameInfo
Caption = "发送信息"
Height = 2775
Left = 600
TabIndex = 1
Top = 4080
Width = 10455
Begin VB.CommandButton cmdRead
Caption = "读取"
Enabled = 0 'False
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 = "发送"
Enabled = 0 'False
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-5-27"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
Alignment = 1
AutoSize = 2
TextSave = "17:39"
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 VB.Menu conn
Caption = "连接"
End
End
Attribute VB_Name = "frmStart"
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 txtCenterNumber_KeyPress(KeyAscii As Integer)
If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
KeyAscii = 0 '取消本次按键事件。
Beep '提示输入错误
End If
End Sub
Private Sub txtMsg_Change()
txtMsg.MaxLength = 70
LabText.Caption = "字数:" & Len(txtMsg.Text) & "/70"
End Sub
' Const LB_SETHORIZONTALEXTENT = &H194
' Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
' (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
' lParam As Any) As Long
'List1 为 ListBox 的名称
'Call SendMessage(List1.hwnd, LB_SETHORIZONTALEXTENT, _
' 水平卷动轴的宽度, ByVal 0&)' 特别注意：以上的水平卷动轴宽度的单位是 pixel(像素)。
Private Sub txtPhoneNumber_KeyPress(KeyAscii As Integer)
If (Chr(KeyAscii) > "9" Or Chr(KeyAscii) < "0") And KeyAscii <> 8 Then
KeyAscii = 0 '取消本次按键事件。
Beep '提示输入错误
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -