通信.frm

AT指令编辑计算机跟手机通讯

 End If
End Sub

Private Sub test_received_Change()      '测试返回值

End Sub

Private Sub sms_center_Change()           '设置短信中心号

End Sub

Private Sub txtReceived_Change()                      '接收消息

End Sub

Private Sub txtSMS_Change()              '发送消息
    
End Sub

Private Sub Send_Click()
Dim text As String
Dim i As Integer
Dim Str As String
Dim pdustr As String
Dim temp_sms_center As String
Dim temp_MobileTel As String
On Error GoTo err
    If WorkFlag = False Or SendSuccess = -1 Then
       Exit Sub
    End If
    SendSuccess = -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) > 140 Then
        MsgBox "必须信息!或输入的汉字不能超过70"
        Exit Sub
    End If
    Status.Panels(2).text = "正发送..."
    
    '编码
temp_sms_center = GetTel(Me.sms_center.text)
temp_MobileTel = GetTel(Me.MobileTel.text)
pdustr = "089168"
pdustr = pdustr + temp_sms_center + "11000D9168" + temp_MobileTel + "000800" + Hex(Len(Encode(Me.SendMsg.text)) / 2) + Encode(Me.SendMsg.text)
MSComm1.Output = "AT+CMGF=0" + Chr(13) + Chr(10)
SendSuccess = -1
PubDelay (500)
Str = MSComm1.Input
If Str <> "" Then
   MsgBox Str
End If
MSComm1.Output = "AT+CMGS=" & CStr(Len(pdustr) / 2 - 9) & Chr(13) & Chr(10)
PubDelay (500)
Str = MSComm1.Input
If Str <> "" Then
   MsgBox Str
   End If
 MSComm1.Output = pdustr & Chr(26)
PubDelay (1000)
Str = MSComm1.Input
If Str <> "" Then
   MsgBox Str: SendSuccess = 1
   Else
   MsgBox "发送失败！"
   End If
     
   Exit Sub
err:
   MsgBox err.Description
End Sub

Private Sub MSComm1_OnComm()

    Dim buffer As String
    Dim i As Integer, j As Integer
    Dim NextFlag As Boolean
    Dim buffe As String
    ReceiveData = ReceiveData + MSComm1.Input
    Do
        NextFlag = False
        j = InStr(ReceiveData, "+CMS")
        If j > 0 Then
            ReceiveSuccess = 0
            MsgBox ReceiveData
        End If
        i = InStr(ReceiveData, "+CMGR:")
        j = InStr(ReceiveData, "+CMGS")
        If j = 0 And i = 0 And Len(ReceiveData) > 0 Then '删除接收区中无用的数据
           ReceiveData = Trim(ReceiveData)
        End If
        If j > 0 Then  '最前的数据为发送返回结果
            If SendSuccess = -1 Then
                buffe = Mid(ReceiveData, j, 5)
                If InStr(buffer, "OK") > 0 Then
                    SendSuccess = 1
                    SendSuccessCount = SendSuccessCount + 1
                Else
                    SendSuccess = 0
                    SendFailedCount = SendFailedCount + 1
                End If
            End If
            NextFlag = True
        Else
            If i > 0 Then
                      MsgIndex.text = Mid(ReceiveData, 7, 1)
                        ReceiveSuccess = 1 '接收成功
                        ReceiveCount = ReceiveCount + 1
                    End If
                    ReceiveData = Mid(ReceiveData, i + 3)
                    NextFlag = True
                End If
    
    Loop While NextFlag
    Exit Sub
     MsgBox "Error:" & err & "." & vbCrLf & err.Description
End Sub

Private Sub cmdRead_Click()
Dim ReceiveData As String
Dim i As Integer
If Len(MsgIndex.text) < 1 Or Len(MsgIndex.text) > 40 Then
        MsgBox "请输入正确的短信编号"
        Exit Sub
End If
   MSComm1.Output = "AT+CMGR=" + MsgIndex.text + Chr(13) + Chr(10)
    PubDelay (500)
     ReceiveData = MSComm1.Input
     i = InStr(ReceiveData, "08916831")
     ReceiveData = Mid(ReceiveData, 1, i)
   If ReceiveSuccess = 1 Then
      ReceiveData = DecodeRecSMS(ReceiveData)
       txtReceived.text = ReceiveData
       End If
 Exit Sub
End Sub

Private Sub cmdClearReceived_Click()    '清空
    txtReceived.text = ""
End Sub

Private Sub Save_Click()
Dim fso As New FileSystemObject, fil As File
Set fil = fso.CreateTextFile("D:\test.txt", True)
 MsgBox "正在写入文件"
fil.writeline (txtReceived.text)
fil.Close
End Sub
'功能： 生成GetTel串
'输入：目标手机号码、[可选的短信服务中心号码]
'输出： 生成的GetTel串
'返回： 整个字串的长度
Private Function GetTel(ByVal DestNo As String) As String  '电话号码编码
    'On Error GoTo Erro GetTel
    Dim i As Integer
    Dim iAsc As Integer
    Dim iLen As Integer
    Dim strTmp2 As String
    Dim strDest As String
    Dim strChar As String
    For i = 1 To Len(DestNo)
        strChar = Mid(DestNo, i, 1)
        iAsc = Asc(strChar)
        If iAsc > 57 Or iAsc < 48 Then Exit Function
    Next i
    If Len(DestNo) = 11 Then
       DestNo = DestNo & "F"
    End If
    For i = 1 To 12 Step 2
        strTmp2 = Mid(DestNo, i, 2)                                     '奇偶互换
        strDest = strDest & Right(strTmp2, 1) & Left(strTmp2, 1)
    Next i
    GetTel = strDest
    Exit Function
            MsgBox "Error:" & err & "." & vbCrLf & err.Description
End Function

Public Function Encode(smsg As String) As String          '中文转换为Unicode码

  Dim si, sb As Integer
  Dim stmp As Integer
  Dim stemp As String
  Dim ascg As String
  sb = Len(smsg)
  ascg = ""
  For si = 1 To sb
    stmp = AscW(Mid(smsg, si, 1))
    If Abs(stmp) < 127 Then
      stemp = "00" & Hex(stmp)
    Else
      stemp = Hex(stmp)
    End If
    ascg = ascg & stemp
  Next si
  ascg = Trim(ascg)
  Encode = ascg
 Exit Function
ErrorUnicode:
    MsgBox "错误：" & err & "." & vbCrLf & err.Description
    Encode = ""
End Function

'/////////////////////////////////////////////////////////////////
'输入短信Unicode代码，输出汉字字符串
'/////////////////////////////////////////////////////////////////
Public Function PubUnZip_Chinese(ByVal vInputStr As String) As String
    Dim i As Integer
    
    '输入字符串为空或长度不是四的整数，返回空字符串。
    If Len(vInputStr) = 0 Or (Len(vInputStr) / 2 <> Int(Len(vInputStr) / 2)) Then
        PubUnZip_Chinese = ""
        'Debug.Print Len(vInputStr)
        Exit Function
    End If
    
    For i = 1 To Len(vInputStr) Step 4
        PubUnZip_Chinese = PubUnZip_Chinese & ChrW(Hex2Dec(Mid(vInputStr, i, 4)))
    Next
  Exit Function
End Function

Public Function Hex2Dec(ByVal strInput As String) As Long
    Dim i       As Integer
    Dim j       As Integer
    Dim iLen    As Integer
    Dim iTmp    As Integer
    
    Dim nRet    As Long
    Dim strTmp  As String
    
    On Error Resume Next
    
    If strInput <> "" Then
        iLen = Len(strInput)
        nRet = 0
        For i = 1 To iLen
            iTmp = Asc(Mid(strInput, i, 1))
            If iTmp >= 48 And iTmp <= 57 Then               '"0" = 48, "9" = 57
                nRet = nRet + (iTmp - 48) * 16 ^ (iLen - i)
            ElseIf iTmp >= 65 And iTmp <= 70 Then           '"A" = 65, "F" = 70
                nRet = nRet + (iTmp - 55) * 16 ^ (iLen - i)
            ElseIf iTmp >= 97 And iTmp <= 102 Then          '"a" = 97, "f" = 102
                nRet = nRet + (iTmp - 87) * 16 ^ (iLen - i)
            Else
                nRet = 0
                Exit For
            End If
        Next i
    End If
    Hex2Dec = nRet
End Function

'//////////////////////////////////////////////////////////////
'延时若干毫秒
'//////////////////////////////////////////////////////////////
Public Sub PubDelay(DT As Long)
    Dim T As Long
    T = GetTickCount()
    Do
        'DoEvents
    Loop Until GetTickCount - T > DT
End Sub

'////////////////////////////////////////////
'读取一条短信
'////////////////////////////////////////////
 Private Function DecodeRecSMS(SMSInfo As String)
 Dim i As Integer
 Dim j As Integer
 Dim str1 As String
 Dim str2 As String
 Dim SMSText As String
 Dim strTmp As String
 Dim temp As String
 Dim CodeType As Byte: Dim ClassType As Byte: Dim StoreType As Byte
 SMSText = SMSInfo
 '//短消息中心地址长度
 i = Val(Mid(SMSText, 1, 2)) '//08
SMSText = Mid(SMSText, 3, Len(SMSText) - 2)
'//是否有加号
'// BIT No. 7 6 5 4 3 2 1 0
'// Name 1 数值类型 号码鉴别
'//数值类型（Type of Number）：000—未知，001—国际，010—国内,111—留作扩展；
'//号码鉴别（Numbering plan identification）:0000—未知，0001—ISDN/电话号码(E.164/E.163)，1111—留作扩展；
If (Val("$" + Mid(SMSText, 1, 2)) + 16) = 16 Then
SMSCAddress = "+"

'//短消息中心号码
SMSText = Mid(SMSText, 3, Len(SMSText) - 2)
str1 = Mid(SMSText, 1, (i - 1) * 2)             ' //683108200805F0
str2 = ""
End If
For j = 1 To (i - 1) * 2 Step 2
strTmp = Mid(str1, 1 + (j - 1) * 2, 2)       '//8613800270500
str2 = str2 & Right(strTmp, 1) & Left(strTmp, 1)
Next j

'//去掉未尾的F
If Right(str2, 1) = "F" Then
str2 = Mid(str2, 1, Len(str2) - 1)
SMSCAddress = SMSCAddress + str2       '//[phone]
SMSText = Mid(SMSText, (i - 1) * 2 + 1, Len(SMSText) - (i - 1) * 2) '//040D91683194041338F50000FF0530972D8603...
'//回复信息
SMSText = Mid(SMSText, 3, Len(SMSText) - 2)       ' //0D91683194041338F50000FF0530972D8603.
' //回复地址长度
i = Val("Hex" + Mid(SMSText, 1, 2))              '//0D
SMSText = Mid(SMSText, 3, Len(SMSText) - 2)   ' //91683194041338F50000FF0530972D8603...
'//是否有加号
End If
If (Val("Hex" + Mid(SMSText, 1, 2)) + 16) = 16 Then  ' //91
ReplyTel = "+"
SMSText = Mid(SMSText, 3, Len(SMSText) - 2)          ' //683194041338F50000FF0530972D8603..
End If
If (i Mod 2) = 1 Then
i = i + 1
str1 = SMSText
str2 = ""
End If
For j = 1 To i Step 2
strTmp = Mid(str1, j, 2)        '//8613944031835F
str2 = str2 & Right(strTmp, 1) & Left(strTmp, 1)
Next j
'//去掉未尾的F
If Right(str2, 1) = "F" Then
str2 = Mid(str2, 1, Len(str2) - 1)
ReplyTel = ReplyTel + str2                   '[phone]
SMSText = Mid(SMSText, 15, Len(SMSText) - 14)
temp = Mid(SMSText, 1, 4)
End If
If (str1 = Right(temp, 2)) = 8 Then
SMSText = Mid(SMSText, 5, 14)
str1 = SMSText
str2 = ""
End If
For j = 1 To 14 Step 2
strTmp = Mid(str1, j, 2)                           '接收时间
str2 = str2 & Right(strTmp, 1) & Left(strTmp, 1)
Next j
ReplyTime = str2
'取短信内容
i = Val("Hex" + Mid(SMSText, 19, 2))           '短信长度
SMSText = Mid(SMSText, 21, i)
SMSText = PubUnZip_Chinese(SMSText)
SMSText = "收到" & ReplyTel & "发来短信。" + Chr(13) + Chr(10) + "短信内容:" + SMSText _
+ Chr(13) + Chr(10) + "时间" + ReplyTime + Chr(13)
DecodeRecSMS = SMSText
 End Function