gsm.frm

vb编写控制GSM模块短信PC程序实例源代码

    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