form1.frm

GSM的VB实现代码

End Sub



Private Sub Command1_Click()
Dim i As Integer
i = 0
msg = Form1.Text2.text
For i = 0 To flag Step 1

 
 num = phonenum(i, 1)
 If i = flag Then
 Exit For
 End If
 
 If num = "" Then
 MsgBox "请输入电话号码"
 Else
 
 
 Call sendsms
 End If
 
 Next
 
 
 

End Sub

Private Sub Command10_Click()
Dim del As Integer
del = Int(Form1.List1.ListIndex)
If del = -1 Then
a = MsgBox("没有选中删除的对象", 0 + 0 + 16, "错误")
Else

Form1.List1.RemoveItem (del)
End If

End Sub

Private Sub Command11_Click()

Dim sel As Integer
Dim length As Integer
Dim a As String, b As String
flag = 0

a = "0"
b = "0"



Dim str As String

sel = Form1.List1.ListIndex
If sel = -1 Then
a = MsgBox("没有选择对象", 0 + 0 + 16, "错误")
Else
str = Form1.Text1.text

length = Int(LenB(StrConv(str, vbFromUnicode)))
'If length = 0 Then
'length = 0
'End If

Form1.Text1.SelStart = length

Form1.Text1.SelText = Form1.List1.List(sel) & ";"   '号码追加


 Call break(Form1.List1.List(sel), Int(LenB(StrConv(Form1.List1.List(sel), vbFromUnicode))), a, b)

 phonenum(flag, 0) = a
 phonenum(flag, 1) = b

 

 
flag = flag + 1


End If

End Sub

Private Sub Command2_Click()
Dim i As Integer
i = 0
msg = Form1.Text2.text
For i = 1 To flag Step 1
 MsgBox flag
 
 MsgBox phonenum(i, 1)
 
 num = phonenum(i, 1)
 'If i = flag Then
' Exit For
' End If
 
 If num = "" Then
 MsgBox "请输入电话号码"
 Else
 
 
 Call sendsms
 End If
 
 Next
 
End Sub

Private Sub Command3_Click()
Form1.Text2.text = ""

End Sub

Private Sub Command4_Click()
FindFile = "send.txt"
Form4.Show

End Sub

Private Sub Command5_Click()

End Sub

Private Sub Command6_Click()
Text1.text = Right(buff, 11)
End Sub

Private Sub Command7_Click()
Form1.Text3.text = ""

End Sub

Private Sub Command8_Click()
FindFile = "receive.txt"
Form4.Show

End Sub

Private Sub Command9_Click()
Form5.Show

End Sub

Private Sub FileNew_Click()
Form2.Show

End Sub


Private Sub FileOpen_Click()

CommonDialog1.ShowOpen

CommonDialog1.DefaultExt = ".txt"

filename = CommonDialog1.filename

End Sub

Private Sub FileQxit_Click()
Dim a As Integer

a = MsgBox("关闭程序", 256 + 4 + 32, "请确认")

If a = 6 Then

End



End If





End Sub

Private Sub FileSave_Click()
CommonDialog1.ShowSave
CommonDialog1.filename = "save.txt"
CommonDialog1.DefaultExt = ".txt"
End Sub

Private Sub Form_Load()

Dim s As String
Form2.Show
Open "list.txt" For Input As #1
Do While Not EOF(1)
Line Input #1, s

Form1.List1.AddItem (s)
Loop
Close #1


End Sub

Private Sub HelpAbout_Click()
Form3.Show

End Sub

Private Sub Label3_Click()

End Sub

Private Sub MSComm1_OnComm()
Dim buffer As Variant
Dim Enter As String
Dim msg1 As String
Dim msg2 As String
Dim msg3 As String
Dim msg4 As String
Dim iii As String
Enter = Chr$(13) + Chr$(10)
msg1 = "您有新的短消息!"
msg2 = "消息存放在SIM卡的第 "
msg3 = " 条存储位置上!"
msg4 = "请选择""阅读""回复""删除"
Select Case MSComm1.CommEvent
Case comEvReceive
MSComm1.InputLen = 0
MSComm1.InputMode = comInputModeText '接收内容的格式
buffer = MSComm1.Input
Call delay(1)
iii = Len(buffer)
If iii = 17 Then
buffer = Right(buffer, 3)
buffer = Val(buffer)
Else
buffer = Right(buffer, 4)
buffer = Val(buffer)
End If
MsgBox msg1 & Enter & msg2 & buffer & msg3 & Enter & msg4
Form1.Text3.text = buffer
Case Else
End Select
MSComm1.InBufferCount = 0 '清空接收缓冲区
End Sub

Private Sub Text2_Change()

End Sub

Private Sub Text3_Change()

End Sub

Private Sub Timer1_Timer()
Dim renum As String

Dim number As Integer
Dim indata As String
Dim LoopNum As Integer

For LoopNum = 1 To 25 Step 1

renum = LoopNum


number = Val(renum)
MSComm1.RThreshold = 0 '不触发OnComm事件!
MSComm1.Output = "AT+CMGR=" & number & vbCr
Call delay(1)
indata = MSComm1.Input
Call delay(1)
If InStr(indata, "ERROR") Then
MsgBox "此位置无消息!", vbInformation, "系统消息"
Exit Sub
End If
Dim i, j, k, n As Integer
Dim cal, tim, text As String
Dim aa, bb As String
Dim a1, a2 As String
'"回复号码处理过程"
j = InStr(indata, "F") '第一个F的位置
j = j + 8 '第一个F后的第八个位置为回复号码的开始位置
cal = Mid(indata, j, 14)
aa = ""
bb = ""
a1 = ""
a2 = ""
For k = 1 To 14 Step 2
aa = Mid(cal, k, 2)

a1 = Left(aa, 1)
a2 = Right(aa, 1)
bb = bb & a2 & a1
Next
cal = "+" & Mid(bb, 1, 13)
'"回复日期处理过程"
j = InStr(j + 1, indata, "F")
j = j + 6 '第二个F后的第六个位置为回复日期的开始位置
tim = Mid(indata, j, 14)
aa = ""
bb = ""
a1 = ""
a2 = ""
For k = 1 To 14 Step 2
aa = Mid(tim, k, 2)
a1 = Left(aa, 1)
a2 = Right(aa, 1)
If k = 3 Or k = 5 Then bb = bb & "-"
If k = 7 Then bb = bb & " , "
If k = 9 Or k = 11 Then bb = bb & ":"
If k = 13 Then bb = bb & "+"
bb = bb & a2 & a1
Next
tim = bb
'"回复内容处理过程"
aa = ""
bb = ""
a1 = ""
j = j + 14 '日期开始向后的第十四位是数据长度
a1 = Mid(indata, j, 2)
n = Val("&h" & a1) '变成十进制
n = n * 2
j = j + 2 '长度位后开始为数据
text = Mid(indata, j, n)
i = n / 2
For k = 1 To i

aa = Mid(text, (k - 1) * 4 + 1, 4)
bb = bb & ChrW(Val("&h" & aa))
Next
text = bb
Call delay(2)
Dim msg5 As String
Dim msg6 As String
Dim msg7 As String
Dim Enter As String
msg5 = "时间: "
msg6 = "号码: "
msg7 = "内容: "
Enter = Chr$(13) + Chr$(10)

List2.AddItem = msg5 & tim & Enter & msg6 & cal & Enter & msg7 & text
Open "receive.txt" For Append As #1
Print #1, msg5 & tim & Enter & msg6 & cal & Enter & msg7 & text
Close #1
buff = cal
MSComm1.InBufferCount = 0 '清空接收缓冲区
Call delay(1)
MSComm1.RThreshold = 18 '触发OnComm事件!

Next
End Sub