📄 soj1.frm
字号:
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3825
ClientLeft = 165
ClientTop = 870
ClientWidth = 7740
LinkTopic = "Form1"
ScaleHeight = 3825
ScaleWidth = 7740
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 2000
Left = 480
Top = 2880
End
Begin VB.CommandButton Command2
Caption = "发送消息"
Height = 495
Left = 5160
TabIndex = 4
Top = 3120
Width = 1215
End
Begin VB.TextBox Text2
Height = 495
Left = 2280
TabIndex = 1
Text = "13913009767"
Top = 3120
Width = 2055
End
Begin VB.TextBox Text1
Height = 1935
Left = 1080
TabIndex = 0
Text = "ok1"
Top = 840
Width = 5340
End
Begin MSCommLib.MSComm MSComm1
Left = 6600
Top = 1560
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
CommPort = 2
DTREnable = -1 'True
End
Begin VB.Label Label3
Caption = "手机类型:"
Height = 375
Left = 120
TabIndex = 5
Top = 120
Width = 7335
End
Begin VB.Label Label2
Caption = "发送手机号码"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 360
TabIndex = 3
Top = 3240
Width = 1575
End
Begin VB.Label Label1
Caption = "发送短信内容"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1815
Left = 480
TabIndex = 2
Top = 720
Width = 495
End
Begin VB.Menu search
Caption = "查询手机(&S)"
End
Begin VB.Menu savereceive
Caption = "保存接受消息(&R)"
End
Begin VB.Menu savesend
Caption = "保存发送消息(&S)"
End
Begin VB.Menu about
Caption = "关于(&A)"
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'相比于手机短信的发送而言,手机短信的接收主要的工作正好与之相反。手机短信的发送需要将待发送的短信内容转换为Unicode码,而短信的接收则需要将接收到的Unicode码转换成中文字符。下面的函数将实现解码功能。同手机短信发送的编码函数一样,这里也应用了一个VB内置的函数AscW()函数来将Unicode码转换为中文:
Dim commonport As Integer
Dim delayflag As Boolean
Public Function ascg(smsg As String) As String
Dim si, sb As Integer
Dim stmp As Integer
Dim stemp As String
sb = Len(smsg)
ascg = ""
For si = 1 To sb
stmp = AscW(Mid(smsg, si, 1))
If Abs(stmp) < 127 Then
stemp = "00" & Hex(stmp)
Else
stemp = Hex(stmp)
End If
ascg = ascg & stemp
Next si
ascg = Trim(ascg)
End Function
Public Function chg(rmsg As String) As String
Dim tep As String
Dim temp As String
Dim i As Integer
Dim b As Integer
tep = rmsg
i = Len(tep)
b = i / 4
If i = b * 4 Then
b = b
tep = Left(tep, b * 4)
Else
tep = Left(tep, b * 4)
End If
chg = ""
For i = 1 To b
temp = "&H" & Mid(tep, (i - 1) * 4 + 1, 4)
chg = chg & ChrW(CInt(Val(temp)))
Next i
End Function
Function Searchrecord(source As String, set1 As String, ByRef t() As String, num As Integer) As Integer
Dim j As String
Dim i As Integer
Dim cur As Integer
Dim cur_end As Integer
i = 1
cur = 1
ReDim t(100)
Do
cur = InStr(cur, source, set1)
If cur = 0 Then
Exit Do
Else
cur_end = InStr(cur, source, ",")
cur = cur + Len(set1)
j = Mid(source, cur, cur_end - cur)
t(i) = j
i = i + 1
End If
Loop While cur + Len(set1) < Len(source)
Searchrecord = i
ReDim Preserve t(i - 1)
End Function
Function Searchrecord2(source As String, set1 As String, ByRef t() As String, num As Integer) As Integer
Dim j As String
Dim i As Integer
Dim cur As Integer
Dim cur_end As Integer
i = 1
cur = 1
ReDim t(100)
Do
cur = InStr(cur, source, set1)
If cur = 0 Then
Exit Do
Else
cur_end = InStr(cur, source, Chr$(13))
cur = cur + Len(set1)
j = Mid(source, cur, cur_end - cur)
t(i) = j
i = i + 1
End If
Loop While cur + Len(set1) < Len(source)
Searchrecord2 = i
ReDim Preserve t(i - 1)
End Function
Private Sub about_Click()
MsgBox "版本: " & App.Major & "." & App.Minor & "." & App.Revision & Chr$(13) & "作者: 何成军 " & Chr$(13) & "Email: hcj2002@sohu.com" & Chr$(13) & "copyright:南京航空航天大学飞控所" & Chr$(13) & " QQ : 121994363"
End Sub
Private Sub Command2_Click()
Dim k As Integer
Dim obj1 As String
Dim aa() As String
' 保存输入子串的缓冲区
' Dim buffer As String
' 使用 COM1。
MSComm1.CommPort = commonport
' 9600 波特,无奇偶校验,8 位数据,一个停止位。
MSComm1.Settings = "9600,N,8,1"
' 当输入占用时,
' 告诉控件读入整个缓冲区。
'MSComm1.InputLen = 0
' 打开端口。
MSComm1.PortOpen = True
' 将 attention 命令送到调制解调器。
MSComm1.Output = "ATE0" & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
MSComm1.Output = "AT+CMGF=1" & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
' 关闭串行端口。
MSComm1.Output = "AT+CPMS=" & Chr(34) & "OM" + Chr(34) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
MSComm1.Output = "AT+CSCS=" & Chr(34) & "GSM" + Chr(34) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
MSComm1.Output = "AT+CSCS=" & Chr(34) & "UCS2" + Chr(34) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
' 关闭串行端口。
Dim SENDSMS As String
Dim send_1 As String
Dim temp As String
SENDSMS = ascg(Text1.Text)
sendsms1 = ascg(Text2.Text)
send_1 = "AT+CMGW=" & Chr(34) & Text2.Text & Chr(34) & Chr$(13)
MSComm1.Output = send_1
send_1 = SENDSMS & Chr$(&H1A) & Chr$(13) ' 确保
MSComm1.Output = send_1
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
Dim M As Integer
M = Searchrecord2(buffer, "+CMGW: ", aa(), 4)
For i = 1 To M - 1
MSComm1.Output = "AT+CMSS=" & aa(i) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer = buffer & MSComm1.Input
Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
' 从串行端口读 "OK" 响应。
'MSComm1.Output = "AT+CMSS=" & aa(i) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
'buffer = ""
' Do
' DoEvents
'buffer = buffer & MSComm1.Input
' Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
MSComm1.Output = "AT+CMGD=" & aa(i) & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer = buffer & MSComm1.Input
Loop Until InStr(buffer, "OK" & vbCrLf) Or InStr(buffer, "ERROR" & vbCrLf)
MSComm1.PortOpen = False
If InStr(buffer, "OK" & vbCrLf) Then
MsgBox "已经发送"
Else
MsgBox "发送失败"
End If
' MsgBox "已经发送..."
'Else
'MsgBox "发送失败..."
'End If
Next
End Sub
Private Sub Form_Deactivate()
MSComm1.PortOpen = False
End Sub
Private Sub savereceive_Click()
Dim k As Integer
Dim obj1 As String
' 保存输入子串的缓冲区
' Dim buffer As String
' 使用 COM1。
MSComm1.CommPort = commonport
' 9600 波特,无奇偶校验,8 位数据,一个停止位。
MSComm1.Settings = "9600,N,8,1"
' 当输入占用时,
' 告诉控件读入整个缓冲区。
'MSComm1.InputLen = 0
' 打开端口。
MSComm1.PortOpen = True
' 将 attention 命令送到调制解调器。
MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
'buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
' 关闭串行端口。
MSComm1.Output = "ATV1Q0" & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
'buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
Loop Until InStr(buffer$, "OK" & vbCrLf)
' 从串行端口读 "OK" 响应。
MSComm1.Output = "ATE0" & Chr$(13) ' 确保
' 调制解调器以"OK"响应。
' 等待数据返回到串行端口。
buffer = ""
Do
DoEvents
buffer$ = buffer$ & MSComm1.Input
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -