?? gsm.frm
字號:
Do
i = InStr(data, Chr$(8))
If i Then
If i = 1 Then
Term.SelStart = TermSize - 1
Term.SelLength = 1
data = Mid$(data, i + 1)
Else
data = Left$(data, i - 2) & Mid$(data, i + 1)
End If
End If
Loop While i
' 除去換行符。
Do
i = InStr(data, Chr$(10))
If i Then
data = Left$(data, i - 1) & Mid$(data, i + 1)
End If
Loop While i
' 確定所有的回車都包含換行符。
i = 0
Do
i = InStr(i + 1, data, Chr$(13))
If i Then
data = Left$(data, i) & Chr$(10) & Mid$(data, i + 1)
End If
Loop While i
' 添加過濾的數據到 SelText 屬性。
Term.SelText = data
' Label1.Caption = Data
End Sub
Public Function show_f1(data As String) As String
Dim datasize, i, j, k As Integer
Dim data_l, data_m, data_r As String
datasize = Len(data)
' 過濾/處理退格符。
Do
i = InStr(data, Chr$(8))
If i Then
If i = 1 Then
data = "-" & Mid$(data, i + 1)
Else
data = Left$(data, i - 1) & Mid$(data, i + 1)
End If
End If
Loop While i
' 確定所有的回車都包含換行符。
i = 1
j = 0
k = 0
Do
i = InStr(i, data, Chr$(13))
j = InStr(i + 1, data, Chr$(13))
If j - i = 1 Then
data_l = Left(data, i - 1)
data = Mid(data, j + 1)
End If
If i Then data = Left$(data, i - 1) & Mid$(data, i + 1)
Loop While i
' 除去換行符。
Do
i = InStr(data, Chr$(10))
If i Then
data = Left$(data, i - 1) & Mid$(data, i + 1)
End If
Loop While i
If data_l <> "" Then
k = InStr(data, "OK")
If k Then
data_m = Left(data, k - 1)
data_r = Mid(data, k)
End If
End If
MsgBox "data_l=>" & data_l
MsgBox "data_m=>" & data_m
MsgBox "data_r=>" & data_r
'MsgBox "data=>" & data
End Function
Private Sub optFlow_Click(Index As Integer)
iFlow = Index
End Sub
Private Sub Text2_Change() '處理命令
Dim key As String
Dim key1 As Integer
key = Right(Text2.text, 1)
If MSComm1.PortOpen Then
If key <> "" Then
key1 = AscW(key)
Select Case key1
Case 8
SendKeys "{BACKSPACE}"
Case 47
out = out & Chr$(47)
MSComm1.Output = out
Timer1.Enabled = True
out = Null
Text2.text = ""
Set allflag = form1.Text1
Case Else
out = Text2.text
End Select
End If
End If
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) '命令中的回車及CTRL＿Z
If MSComm1.PortOpen Then
If KeyAscii = 13 Then
out = out & vbCr
MSComm1.Output = out
Timer1.Enabled = True
out = Null
Text2.text = ""
Set allflag = form1.Text1
End If
If KeyAscii = 26 Then
out = out & Chr$(26)
MSComm1.Output = out
Timer1.Enabled = True
out = Null
Text2.text = ""
Set allflag = form1.Text1
End If
End If
'KeyAscii = 0
End Sub
Private Sub Timer1_Timer() '用于等待MODEM回應的延時
Dim buffer As Variant
Dim lenbuffer As Integer
disp = ""
Timer1.Enabled = False
buffer = MSComm1.Input
lenbuffer = Len(buffer)
'disp = show_f1(CStr(buffer
If lenbuffer <> 0 Then
Call show_s(allflag, CStr(buffer))
Call receive(CStr(buffer))
End If
End Sub
Private Sub Timer2_Timer()
Timer2.Enabled = False
Dim buffer As Variant
buffer = MSComm1.Input
Call receive(CStr(buffer))
End Sub
Public Sub receive(indata As String) '接收短信子程序
Dim receive_ok As String
Dim i, j As Integer
If indata = "" Then Exit Sub
j = Len(indata)
'Call show_s(allflag, CStr(indata))
i = InStr(indata, "+CMT:")
If i Then
receive_ok = Right(indata, j - i + 4)
Dim i1, i2, i3, i4 As Integer
Dim cal, tim, text As String
Dim ii As Integer
Dim aa, bb, cc, c1, c2 As String
Dim jj As String
Dim kk As Integer
i1 = InStr(receive_ok, Chr$(34))
If i1 Then
i2 = InStr(i1 + 1, receive_ok, Chr$(34))
i3 = InStr(i2 + 1, receive_ok, Chr$(34))
i4 = InStr(i3 + 1, receive_ok, Chr$(34))
cal = Mid(receive_ok, i1 + 1, i2 - i1 - 1)
tim = Mid(receive_ok, i3 + 1, i4 - i3 - 1)
text = Mid(receive_ok, i4 + 3)
MsgBox "主叫號碼-> " & cal & vbCr & "接收時間-> " & tim & vbCr & "信息內容-> " & text
Else
i2 = InStr(receive_ok, "F") '處理主叫號碼
aa = Mid(receive_ok, i2 + 4, 2)
If aa = "0D" Then
cal = Mid(receive_ok, i2 + 8, 14)
For ii = 1 To 14 Step 2
bb = Mid(cal, ii, 2)
c1 = Left(bb, 1)
c2 = Right(bb, 1)
cc = cc & c2 & c1
Next
cal = "+" & Mid(cc, 1, 13)
End If
If aa = "OB" Then
cal = Mid(receive_ok, i2 + 8, 12)
For ii = 1 To 12 Step 2
bb = Mid(cal, ii, 2)
c1 = Left(bb, 1)
c2 = Right(bb, 1)
cc = cc & c2 & c1
Next
cal = Mid(cc, 1, 11)
End If
cc = ""
i2 = InStr(i2 + 1, receive_ok, "F") '處理接收時間
tim = Mid(receive_ok, i2 + 6, 14)
For ii = 1 To 14 Step 2
bb = Mid(tim, ii, 2)
c1 = Left(bb, 1)
c2 = Right(bb, 1)
If ii = 3 Or ii = 5 Then cc = cc & "/"
If ii = 7 Then cc = cc & ","
If ii = 9 Or ii = 11 Then cc = cc & ":"
If ii = 13 Then cc = cc & "+"
cc = cc & c2 & c1
Next
tim = cc
cc = ""
aa = Mid(receive_ok, i2 + 4, 2) '處理信息內容
text = Mid(receive_ok, i2 + 22)
If aa = "08" Then '收到中中文短信
jj = Mid(receive_ok, i2 + 20, 2) '字符個數
kk = Val("&h" & jj) '變成十進制
For ii = 1 To (kk / 2)
bb = Mid(text, (ii - 1) * 4 + 1, 4)
cc = cc & ChrW(Val("&h" & bb))
Next
text = cc
End If
If aa = "00" Then '收到手機發來的7比特西文短信
jj = Mid(receive_ok, i2 + 20, 2) '字符個數
kk = Val("&h" & jj) '變成十進制
jj = InStr(text, vbCr)
text = Left(text, jj - 1) '去掉內容后面的回車符
jj = Len(text)
For ii = (jj / 2) To 1 Step -1
bb = Mid(text, ii * 2 - 1, 2)
cc = cc & bb
Next
text = cc
cc = ""
For ii = 1 To jj
bb = Mid(text, i, 1)
Select Case bb
Case "0"
cc = cc & "0000"
Case "1"
cc = cc & "0001"
Case "2"
cc = cc & "0010"
Case "3"
cc = cc & "0011"
Case "4"
cc = cc & "0100"
Case "5"
cc = cc & "0101"
Case "6"
cc = cc & "0110"
Case "7"
cc = cc & "0111"
Case "8"
cc = cc & "1000"
Case "9"
cc = cc & "1001"
Case "A"
cc = cc & "1010"
Case "B"
cc = cc & "1011"
Case "C"
cc = cc & "1100"
Case "D"
cc = cc & "1101"
Case "E"
cc = cc & "1110"
Case "F"
cc = cc & "1111"
End Select
Next
text = cc
cc = ""
For ii = kk To 1 Step -1
bb = "0" & Mid(text, ii * 7 - 7, 7)
cc = cc & Str(Val("&b" & bb))
Next
text = cc
End If
MsgBox "主叫號碼-> " & cal & vbCr & "接收時間-> " & tim & vbCr & "信息內容-> " & text
End If
End If
i = 0
i = InStr(indata, "+CMGS:")
If i Then Call show_s(allflag, "發送短信成功")
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -