frmreceive.frm

一个采用VB编写的短信发送和接收管理软件。

    Else
        SendLength = Trim(CStr(Hex(StrLength + Int(StrLength / 7))))
    End If
    
    SIMID = "68" & SIMSendChange(vSIMnumber)
    
    '石家庄地区移动SIM卡
    OutStr = "0891683108301105F031000D91" & SIMID & "000800" & SendLength & Sendstr & Chr(26)
    '北京地区移动SIM卡
    'OutStr = "0891683108100005F011000D91" & SIMID & "000800" & SendLength & SendStr & Chr(26)
    '//石家庄联通
    'OutStr = "0891683110100805f031000D91" & SIMID & "000800" & SendLength & Sendstr & Chr(26)
    Debug.Print OutStr
    G18.Output = OutStr
    
    InputStr_S = ""
    InputStr_L = ""
    Temp_timer = Timer
    j = j + 1
    Do While Timer < Temp_timer + 50
        Call PubDelay(1000)
        InputStr_S = G18.Input
        'Debug.Print InputStr_L
        If Len(InputStr_S) <> 0 Then
            InputStr_L = InputStr_L + InputStr_S
            If (InStr(InputStr_L, "+CMGS:") <> 0) And (InStr(InputStr_L, "OK") <> 0) Then
                '保存到数据库
                Debug.Print InputStr_L
                SMSSendToUser_G18 = True
                '//发送at+cnma保持状态不变
                 'G18.Output = "at+cnmi=0,2,0,1,0" & Chr(13)
                 APIBeep 2000, 500
                 G18.Output = "at+cnma" & Chr(13)
                 Call PubDelay(1000)
                Exit Function
            ElseIf InStr(InputStr_L, "ERROR") <> 0 Then
                PubStatus "收到error"
                Debug.Print InputStr_L & "收到error"
                SMSSendToUser_G18 = False
                 Call PubDelay(1000)
                 If j = 2 Then
                    PubStatus "第二次收到error"
                 End If
                 If j = 3 Then
                    PubStatus "第三次次收到error"
                 End If
                 If j <= 2 Then
                      GoTo aa
                 End If
                
                Exit Function
            End If
        End If
    Loop
    
    '发送失败
    SMSSendToUser_G18 = False
    PubStatus "超时失败"
    If j = 2 Then
       PubStatus "第二次超时失败"
    End If
    If j = 3 Then
      PubStatus "第三次超时失败"
    End If
    If j <= 2 Then
      
      GoTo aa
    End If
    '清空接收和发送缓冲区
    ClrSMSInputOutputBuffer

End Function

'///////////////////////////////////////////////////////////////////////
'验证参数的合法性函数。
'合法返回"真"，不合法返回"假"
'1、不允许发送单个字符。2、手机号必须为数字。3、手机号长度必须为11位。
'///////////////////////////////////////////////////////////////////////
Private Function SMSParameterValidityTest(Sendstr As String, SIMnumber As String) As Boolean
    SMSParameterValidityTest = True
    If Len(Sendstr) <= 1 Then SMSParameterValidityTest = False
    If Not (Len(SIMnumber) = 11 And IsNumeric(SIMnumber)) Then
        SMSParameterValidityTest = False
    End If
End Function

'///////////////////////////////////////////////////////////////////
'MOTOROLA-G18信号强度检测函数。
'返回值：0-XX
'关机情况下，返回 -1
'///////////////////////////////////////////////////////////////////
Private Function GSMStrengthTest_G18() As Integer
    Dim I As Integer
    Dim InputStr_S As String
    Dim InputStr_L As String
    Dim Temp_timer As Long
    
    GSMStrengthTest_G18 = -1
    For I = 1 To 3
        '清空接收/发送缓冲区
        G18.InBufferCount = 0
        G18.OutBufferCount = 0
        
        G18.Output = "AT+CSQ" & Chr(13)
        Temp_timer = Timer
        Do While Timer < Temp_timer + 2
            Call PubDelay(200)
            InputStr_S = G18.Input
            If InputStr_S <> "" Then
                InputStr_L = InputStr_L + InputStr_S
                If (InStr(InputStr_L, "+CSQ") <> 0) And Len(InputStr_L) > 15 Then
                    Debug.Print InStr(InputStr_L, "+CSQ:")
                    Debug.Print Mid(InputStr_L, InStr(InputStr_L, "+CSQ:") + 6, 3)
                    GSMStrengthTest_G18 = Val(Mid(InputStr_L, InStr(InputStr_L, "+CSQ:") + 6, 3))
                    Exit Do
                End If
            End If
        Loop
        
        '没有收到'OK',重复测试三次
        If GSMStrengthTest_G18 <> -1 Then Exit For
    Next
End Function

'////////////////////////////////////////////////
'测试GSM模块是否正常工作函数。
'正常返回"真"，关机返回"假"。
'关机情况下最长返回参数时间：5秒
'////////////////////////////////////////////////
Private Function testGSM() As Boolean
    Dim I As Integer
    Dim InputStr_S As String
    Dim InputStr_L As String
    Dim Temp_timer As Long
    
    testGSM = False
    For I = 1 To 3
        '清空接收/发送缓冲区
        G18.InBufferCount = 0
        G18.OutBufferCount = 0
        
        G18.Output = "AT" & Chr(13)
        Temp_timer = Timer
        Do While Timer < Temp_timer + 2
            Call PubDelay(500)
            InputStr_S = G18.Input
            If InputStr_S <> "" Then
                InputStr_L = InputStr_L + InputStr_S
                If InStr(InputStr_L, "OK") <> 0 Then
                    testGSM = True
                    Exit Do
                End If
            End If
        Loop
        
        '没有收到'OK',重复测试三次
        If testGSM = True Then Exit For
    Next
End Function

'////////////////////////////////////////////////
'删除已读过的短信。执行一次删除全部已读短信。
'////////////////////////////////////////////////
Private Sub DelAllReadSMS_G18()
    Dim I As Integer
    Dim InputStrS As String
    Dim InputStrL As String
    Dim tempInputStr As String
    Dim Weither As Boolean
    Dim Position As Integer
    
    '判断模块是否正常工作
    If Not testGSM Then Exit Sub
    
    G18.Output = "AT+CMGL=1" & Chr(13)
    Weither = False
    For I = 1 To 10
        PubDelay (1000)
        InputStrS = G18.Input
        InputStrL = InputStrL + InputStrS
        If InStr(InputStrL, "OK" & Chr(13) & Chr(10)) <> 0 Then
            Weither = True
            tempInputStr = InputStrL
            Exit For
        ElseIf InStr(InputStrL, "ERROR") <> 0 Then
            Weither = False
            Exit Sub
        Else
            Weither = False
        End If
    Next
    Do While Weither
        Position = InStr(tempInputStr, "+CMGL:")
        If Position > 0 Then
            Position = Position + 6
            tempInputStr = Mid(tempInputStr, Position)
            If Mid(tempInputStr, 8, 1) = "1" Then
                Debug.Print "正在删除第：" & Mid(tempInputStr, 2, 3) & "条短信 ..."
                G18.Output = "AT+CMGD=" & Mid(tempInputStr, 2, 3) & Chr(13)
                InputStrS = ""
                InputStrL = ""
                For I = 1 To 5
                    PubDelay (1000)
                    InputStrS = G18.Input
                    InputStrL = InputStrL + InputStrS
                    If InStr(InputStrL, "OK" & Chr(13) & Chr(10)) <> 0 Then
                        Exit For
                    End If
                Next
            End If
        Else
            Exit Do
        End If
    Loop
End Sub

'////////////////////////////////////////////////////////////////////////////////////
'发出AT+CMGL=4命令，延时20秒，等待"OK"。如出现"OK"则检测是否有新短消息并处理。
'/////////////////////////////////////////////////////////////////////////////////////
Private Sub SMSReceive_G18()
    Dim Weither As Boolean
    Dim BufferL As String
    Dim BufferS As String
    Dim Temp As Long
    Weither = False
    
    '清空接收和发送缓冲区
    ClrSMSInputOutputBuffer
    
    G18.Output = "AT+CMGL=4" & Chr(13)
    Call PubDelay(200)
    Temp = Timer
    Do While Timer < Temp + 30
        Call PubDelay(1000)
        BufferS = G18.Input
        If Len(BufferS) <> 0 Then
            BufferL = BufferL + BufferS
        End If
        Debug.Print BufferL
        If InStr(BufferL, "OK" & Chr(13) & Chr(10)) <> 0 Then
            '判断是否有短信。
            If InStr(BufferL, "+CMGL:") <> 0 And InStr(BufferL, "08916831") <> 0 Then
                '读取第一条短信处理,并删除
                SplitSMS BufferL
                'Debug.Print "BufferL:" & BufferL
            End If
            Weither = True
            Exit Do
        ElseIf InStr(BufferL, "ERROR") <> 0 Then
            PubStatus "接收短信时出现ERROR。"
            Weither = True
            Exit Do
        End If
    Loop
    
    If Weither = False Then
        PubStatus "接收短信时GSM回复过慢！"
    End If
    
    '清空接收和发送缓冲区
    ClrSMSInputOutputBuffer

End Sub

'////////////////////////////////////////////
'读取第一条短信处理并删除
'////////////////////////////////////////////
Private Sub SplitSMS(ByVal vInputStr As String)
    Dim StrArray() As String
    Dim StartPosition As Integer
    Dim SMSContentLen As Integer
    Dim SMSContent As String
    Dim PubSimNumber As String
    Dim SMSStr As String
    Dim UnZipStr As String
    Dim DelNum As Integer
    Dim I As Integer
    Dim rdsmsreceive As New ADODB.Recordset
    Dim tmpStr As String
    
    DelNum = -1
    
    If Len(vInputStr) = 0 Then
        Exit Sub
    End If
    
    StrArray = Split(vInputStr, "+CMGL:")
    I = 1
    For I = LBound(StrArray) To UBound(StrArray)
        If InStr(StrArray(I), "08916831") <> 0 Then
            StartPosition = InStr(StrArray(I), "08916831")
            If StartPosition - 4 > 0 Then
                '<Gjr030824Added>
                'There's no '86' before the source SIM no in the SMS from NanJing,need add '68' into the SMS before deal with it.
                Dim intP As Integer
                intP = 0
                If Mid(StrArray(I), StartPosition + 24, 2) <> "68" Then
                    intP = 1
                    If intP = 1 Then
                     PubStatus "该短信未包含86内容:" & StrArray(I)
                    End If
                    StrArray(I) = Mid(StrArray(I), 1, StartPosition + 23) & "68" & Mid(StrArray(I), StartPosition + 24)
                End If
                '</Gjr030824Added>
                PubSimNumber = SIMReceiveChange(Mid(StrArray(I), StartPosition + 26, 12))
                If Mid(StrArray(I), StartPosition + 40, 2) = "00" Then
                    '短信按英文方式处理 注:SMSContentLen是整条短信的长度。
                    '<Gjr030824Modi>
                    'SMSContentLen = Val(Mid(StrArray(i), StartPosition - 4, 2)) - 20
                    SMSContentLen = Val(Mid(StrArray(I), StartPosition - 4, 2)) - 20 + intP