form1.frm

用AT指令短信收发软件－将收发短信的手机通过手机数据线接到电脑的串口

End Sub
Private Function SmsInit(Port As Integer, setstr As String) As Boolean
    SmsInit = False
    If SmsOpen(Port, setstr) = False Then Exit Function
    WorkFlag = True
    SendSuccessCount = 0
    SendFailedCount = 0
    ReceiveCount = 0
    ReceiveData = ""
    SendSuccess = 0
    ReceiveSuccess = 0
    SmsInit = True
End Function
Private Function SmsSend(MoblieID As String, TxtMessage As String) As Boolean    '被timer1_timer调用
    Dim TxtMsg As String

    SmsSend = False
    If WorkFlag = False Or SendSuccess = -1 Then Exit Function
    '编码
    TxtMsg = Encode(TxtMessage)
    If MSComm1.PortOpen Then
        MSComm1.Output = "AT+CMGS=" + Chr(34) + MoblieID + Chr(34) + Chr(13)  '送出短信目的号码
        MSComm1.Output = TxtMsg + Chr(26)   '送出已编码后的短信内容
        SendSuccess = -1
        SmsSend = True
    End If
End Function

Function SmsOpen(Port As Integer, Setings As String) As Integer     '被opensms_click 调用

On Error GoTo ErrHandle
    SmsOpen = False
    If MSComm1.PortOpen Then MSComm1.PortOpen = False
    MSComm1.CommPort = Port
    MSComm1.Settings = Setings
    MSComm1.PortOpen = True
    
    If MSComm1.PortOpen Then
        SmsOpen = True
        MSComm1.Output = "ATE0" + Chr(13) + Chr(10)
        MSComm1.RThreshold = 1
        MSComm1.Output = "AT+CMGF=1" + Chr(13) + Chr(10)
        MSComm1.Output = "AT+CSMP=4,167,0,8" + Chr(13) + Chr(10)
'上边两行语句作为联机是初始化用的命令
    End If
    
Exit Function
ErrHandle:
   MsgBox "错误：  " + Str(Err.Number) + Chr(13) + Chr(10) + Err.Description, _
          vbOKOnly + vbCritical, App.Title
End Function

Private Sub MSComm1_OnComm()

    Dim buffer As String
    Dim i As Integer, j As Integer
    Dim NextFlag As Boolean

    ReceiveData = ReceiveData + MSComm1.Input
    Do
        NextFlag = False
        j = InStr(ReceiveData, "+CMS")
        If j > 0 Then
            ReceiveSuccess = 0
        End If
        i = InStr(ReceiveData, "+CMGR:")
        j = InStr(ReceiveData, "+CMGS")
        If j = 0 And i = 0 And Len(ReceiveData) > 8 Then '删除接收区中无用的数据
            ReceiveData = Mid(ReceiveData, Len(ReceiveData) - 7)
        End If
        If j > 0 And j < i And 14 >= Len(ReceiveData) - j Then '最前的数据为发送返回结果
            If SendSuccess = -1 Then
                buffer = Mid(ReceiveData, j, 14)
                If InStr(buffer, "OK") > 0 Then
                    SendSuccess = 1
                    SendSuccessCount = SendSuccessCount + 1
                Else
                    SendSuccess = 0
                    SendFailedCount = SendFailedCount + 1
                End If
            End If
            ReceiveData = Mid(ReceiveData, j + 14)
            NextFlag = True
        Else
            If i > 0 Then
                j = InStr(ReceiveData, Chr(13) + Chr(10) + "OK")
                If j > 0 Then
                    buffer = Mid(ReceiveData, i, j - i)
                    ReceiveSuccess = 0
                    If Analyze(buffer) Then
                        ReceiveSuccess = 1 '接收成功
                        ReceiveCount = ReceiveCount + 1
                    End If
                    ReceiveData = Mid(ReceiveData, j + 3)
                    NextFlag = True
                End If
            End If
        End If
    Loop While NextFlag

End Sub
Function Analyze(RecMsg As String) As Boolean
 Dim tel As String, msg As String, time As String
    Analyze = AnalyzeRecMsg(buffer, tel, msg, time)
    If Analyze = True Then
    '用户处理
        MobileTel.Text = tel
        SendMsg.Text = msg
       ' Label1.Caption = time
    End If
End Function
Private Sub Send_Click()
    Success = -1
    If Len(MobileTel.Text) < 11 Or Len(MobileTel.Text) > 12 Then
        MsgBox "请输入正确的手机号"
        Exit Sub
    End If
    If Len(SendMsg.Text) < 1 Or Len(SendMsg.Text) > 80 Then
        MsgBox "必须信息或输入的信息不能超过80"
        Exit Sub
    End If
    Status.Panels(2).Text = "正发送..."
    SmsSend MobileTel.Text, SendMsg.Text
End Sub
Private Function Encode(TxtMessage As String) As String
    Dim High As String, Low As String, OneWord As String
    Dim i As Integer
    For i = 1 To Len(TxtMessage)        '将短信息转化为编码
        OneWord = Mid(TxtMessage, i, 1)
        Low = Hex(AscB(MidB(OneWord, 1, 1)))
        High = Hex(AscB(MidB(OneWord, 2, 1)))
        If Len(High) = 1 Then High = "0" + High
        If Len(Low) = 1 Then Low = "0" + Low
        Encode = Encode + High + Low     '得到的编码
    Next i
End Function
Private Function Decode(EncodeMessage As String) As String
    Dim Word(2) As Byte
    Dim ascii As String
    Dim Temp As String
    Dim j As Integer, Pos As Integer
    Pos = 1
    j = 1
    Do
        If j >= Len(EncodeMessage) Then
            Exit Function
        End If
        ascii = Mid(EncodeMessage, j, 2)
        j = j + 2
        
        Word(Pos) = Val("&H" + ascii)
        Pos = Pos - 1
        If Pos < 0 Then
            Temp = Word
            Decode = Decode + Left(Temp, 1)
            Pos = 1
        End If
    Loop
End Function
Private Function GetBPNumber(RecDecodeMsg As String) As String
    Dim i As Integer
    Dim Start As Boolean
    Dim OneWord As String
    GetBPNumber = ""
    Start = False
    For i = 1 To Len(RecDecodeMsg)
        OneWord = Mid(RecDecodeMsg, i, 1)
        If OneWord >= "0" And OneWord <= "9" Then
            Start = True
            GetBPNumber = GetBPNumber + OneWord
        Else
            If Start = False Then
                If OneWord <> " " Then Exit Function
            Else
                If OneWord = " " Then
                   Do
                    i = i + 1
                    OneWord = Mid(RecDecodeMsg, i, 1)
                   Loop While OneWord = " " And i < Len(RecDecodeMsg)
                End If
                RecDecodeMsg = Mid(RecDecodeMsg, i)
                Exit Function
            End If
        End If
    Next i
End Function
Private Function AnalyzeRecMsg(ByVal RecMsg As String, ByRef MobileNumber As String, ByRef msg As String, ByRef MsgTime As String) As Boolean
    Dim i As Integer, j As Integer
    Dim AnalyzeMsg As String
    Dim Length As Integer
    AnalyzeRecMsg = False
    i = InStr(RecMsg, "+CMGR:")
    If i < 1 Then Exit Function
    AnalyzeMsg = Mid(RecMsg, i + 6)
    i = InStr(AnalyzeMsg, Chr(34) + "+86")
    If i < 1 Then Exit Function
    j = InStr(i + 1, AnalyzeMsg, Chr(34))
    If j < i Then Exit Function
    MobileNumber = Mid(AnalyzeMsg, i + 4, j - i - 4)
    AnalyzeMsg = Mid(AnalyzeMsg, j)
    i = InStr(AnalyzeMsg, ",")
    If i < 1 Then Exit Function
    i = InStr(i, AnalyzeMsg, ",")
    If i < 1 Then Exit Function
    i = InStr(i, AnalyzeMsg, Chr(34))
    If i < 1 Then Exit Function
    j = InStr(i + 1, AnalyzeMsg, Chr(34))
    If j < i Then Exit Function
    MsgTime = Mid(AnalyzeMsg, i + 1, j - i - 4)
    AnalyzeMsg = Mid(AnalyzeMsg, j)
    i = InStr(AnalyzeMsg, Chr(13) + Chr(10))
    If i < 1 Then Exit Function
    j = InStrRev(AnalyzeMsg, ",", i)
    If j < 1 Then Exit Function
    Length = Val(Mid(AnalyzeMsg, j + 1, i - j - 1))
    
    j = InStr(i + 2, AnalyzeMsg, Chr(13) + Chr(10))
    If j < 1 Then Exit Function
    msg = Mid(AnalyzeMsg, i + 2, j - i - 2)
    If Len(msg) > Length Then
        msg = Decode(msg)
    End If
    AnalyzeRecMsg = True
End Function
Private Function RequestRecMsg(MsgIndex As String) As Boolean
    RequestRecMsg = False
    If ReceiveSuccess = -1 Then Exit Function
    ReceiveSuccess = -1
    RequestRecMsg = True
    MSComm1.Output = "AT+CSDH=1" + Chr(13) + Chr(10)
    MSComm1.Output = "AT+CMGR=" + MsgIndex + Chr(13) + Chr(10)
End Function
Private Function RequestDelMsg(MsgIndex As String)
    MSComm1.Output = "AT+CMGD=" + MsgIndex + Chr(13) + Chr(10)
End Function