smspdufrm.frm

通用GSM模块汉字发送VB程序：具有自动汉字PDU码生成及转换的功能

             MSComm1.Output = SMSCTR$
           ''  MessageOut = 4
             'delay 2 seconds
             SMSCTR$ = strSMS & Chr$(26)
             MSComm1.Output = strSMS & Chr$(26)
             MessageOut = 3         '7
            ClearMessage = 0
            End If
End Sub

Private Sub mnuSetVersion_Click()
'Load frmAbout
'frmAbout.Show
End Sub
Private Sub MSComm1_OnComm()
    Dim Buffer, dat1, dat2, PDULen As Variant
    Dim dat(1024) As Variant     '2560
    '.
     Select Case MSComm1.CommEvent
        ' Event messages.
        Case comEvReceive
          Buffer = MSComm1.Input
              For i = 1 To LenB(Buffer)
               dat(i) = AscB(MidB(Buffer, i, 1))
               dat1 = Hex(Int(dat(i) / 16))
               dat2 = Hex(dat(i) Mod 16)
             Next i
       '
          Text2.Text = Text2.Text & StrConv(Buffer, vbUnicode)
           Recbu1$ = StrConv(Buffer, vbUnicode)
           Recbu = Recbu & Recbu1$
           Ll% = Len(Recbu)
           '
           Aa1% = InStr(Recbu, Chr$(13) & Chr$(13) & Chr$(10))
           Aa2% = InStr(Aa1% + 3, Recbu, Chr$(13) & Chr$(10)) '& Chr$(13) & Chr$(10) & "OK" & Chr$(13) & Chr$(10))
           Aa3% = InStr(Aa1% + 3, Recbu, Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "OK" & Chr$(13) & Chr$(10))
           Aa4% = InStr(Recbu, Chr$(13) & Chr$(10))
           Aa5% = InStr(Recbu, Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10) & "OK" & Chr$(13) & Chr$(10))
           Aa6% = InStr(Recbu, Chr$(13) & Chr$(10) & "+CMTI:")
           Aa7% = InStr(Recbu, Chr$(13) & Chr$(10) & "+CMGS:")
'
     Select Case MessageOut
          Case 1
            ClearHead = InStr(Recbu, Chr$(13) & Chr$(10) & "+CMGR:")
            ClearOver = InStr(Recbu, Chr$(13) & Chr$(10) & "OK" & Chr$(13) & Chr$(10))
            ClearError = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
            If Aa1 > 0 And Aa2 > Aa1 + 3 And Aa5% = Aa3% And Aa5% > 0 Then 'receive message
             ''  Text2.Text = ""
               Chedabu = Mid$(Recbu, Aa2% + 2, Aa5% - Aa2% - 2)
'
                smsrec$ = "AT+CMGD=" & Indexb & Chr$(13)
                MSComm1.Output = smsrec$
                Recbu = ""
                MessageOut = 2
             ElseIf ClearError > 1 Then
                Clearstate = 0             'All Message Has Been Delecte
                ClearMessage = 1
                Recbu = ""
             End If
         Case 2
             ClearHead = InStr(Recbu, "+CMGD")
             ClearOver = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))
             If ClearHead > 1 And ClearOver > 1 Then  ' receive OK only
               Recbu = ""
                ClearMessage = 1           'Clear Next Message
              End If
         Case 3
             ClearHead = InStr(Recbu, "+CMGS:")
             ClearOver = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))
             ClearError = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
             MessageNew = InStr(Recbu, "+CMTI: " & Chr$(34) & "SM" & Chr$(34))
             NewMesOver = InStr(MessageNew + 1, Recbu, Chr$(13) & Chr$(10))
             If ClearHead < ClearOver And ClearHead > 1 Then  ' receive OK only
               Recbu = ""
               Text2.Text = "发送成功！"
             ElseIf MessageNew > 1 And NewMesOver > 1 Then
               Text2.Text = ""
               smsrec$ = "AT+CMGR=" & Mid$(Recbu, MessageNew + 12, NewMesOver - MessageNew - 12) & Chr$(13)
               Indexb = Mid$(Recbu, MessageNew + 12, NewMesOver - MessageNew - 12)
               MSComm1.Output = smsrec$
                            
               Recbu = ""
               MessageOut = 4
               ' CheckMessage = 1           'Pass1
             ElseIf ClearError > 0 Then
               Recbu = ""
               Text2.Text = Text2.Text & "发送失败！"
              End If
          Case 4    'Text & PDU_message Reading
            ClearHead = InStr(10, Recbu, "STO UNSENT")   '& "+CMGR:" & OK
            ClearOver = InStr(Recbu, Chr$(44) & Chr$(44))   'PDU
            ClearError = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
            If Aa1 > 0 And Aa2 > Aa1 + 3 And Aa5% = Aa3% And Aa5% > 0 And ClearOver = 0 Then 'receive message
               Text2.Text = ""
             Chedabu = Mid$(Recbu, ClearHead + 28, 14)  'ClearHead + 30
           '    Chebu$ = Mid$(Recbu, 1, Aa1% - 1)
           '    Aa = InStr(Checdata, Chebu$)
                '' smsrec$ = "AT+CMGD=" & Indexb & Chr$(13)  'Modified at 20/2
                ''MSComm1.Output = smsrec$
                Recbu = ""
               '' MessageOut = 5
             ElseIf Aa1 > 1 And Aa5% > 1 And ClearOver > 0 And ClearHead > 0 Then 'Read PDU_message
              '''  Chedabu = Mid$(Recbu, ClearOver + 30, ClearHead - ClearOver - 32)    'Read the Rec_PDU
              Chedabu = "68" & Mid$(Recbu, ClearOver + 18, ClearHead - ClearOver - 26) 'Read the STO_PDU
               PDULen = Val(Mid$(Recbu, ClearOver + 2, 3))
               'smsrec$ = Mid(Recbu, ClearOver + 18, ClearHead - ClearOver - 10)
              ''  MsgBox "PDU_Lenth:" & PDULen, 0, " GSM短信系统"
           ''    Call SendHZ(Chedabu, smsrec$)
            ''   flgPDU = False
            ElseIf ClearError > 1 Then
                CheckMessage = 1
                Recbu = ""
             End If '
           Case 5
             ClearHead = InStr(Recbu, "+CMGD")
             ClearOver = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))  ''
             If ClearHead > 1 And ClearOver > 1 Then  ' receive OK only
              Recbu = ""
              ' If funcount > 1 Then
               MessageOut = 0
             '  End If
              ' ClearMessage = 1           'Clear Next Message
              End If
           Case 6
             Callhang = InStr(Recbu, "NO CARRIER")
             Callok = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))   ''
             Callerr = InStr(Recbu, "ERROR")
             If Callok > 0 Then  ' receive OK only
               Recbu = ""
              ' If funcount > 1 Then
               MessageOut = 6
             ElseIf Callhang > 0 Or Callerr > 0 Then
               smsrec$ = "ATH" & Chr$(13)
               MSComm1.Output = smsrec$
               MessageOut = 7
               Recbu = ""
             End If
            Case 7
               Callh = InStr(Recbu, "ATH")
               CallA = InStr(Recbu, "ATA")
               StateReport = InStr(Recbu, "AT+CNMI")
               Callok = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))
               If (Callh > 0 Or CallA > 0 Or StateReport > 0) And Callok > 0 Then   ' receive OK only
              '
               Recbu = ""
              ' If funcount > 1 Then
               MessageOut = 0
               
               End If
          Case 8
               ClearHead = InStr(Recbu, "+CLIP:")   'Incoming TEL's symbale
               Text2.Text = ""
               SetCent = InStr(Recbu, "OK" & Chr$(13) & Chr$(10))   ''
               SetCenterr = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
         ''      If SetCent > 0 And ClearHead > 0 Then ' receive OK only
               If ClearHead > 0 Then  ' receive OK only
               smsrec$ = Mid$(Recbu, ClearHead + 8, 11)
                   Recbu = ""
                   Text2.Text = Tsext2.Text & smsrec$
                   MessageOut = 0
                   Text2.Text = "设置成功！"
               ElseIf SetCenterr > 0 Then
                   Recbu = ""
                   MessageOut = 0
                   Text2.Text = "设置失败！"
               End If
           Case 9
               Select Case OverFinger
                  Case 0
                     Statedat(0) = InStr(Recbu, "+CPIN:")
                     StateOve = InStr(Statedat(0) + 1, Recbu, Chr$(13) & Chr$(10))
                     StateErr = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
                     If Statedat(0) > 0 And StateOve > 0 Then
                        CheckMessage = 1
                        Recbu = ""
                     Else
                        'CheckMessage = 1
                        Statedat(0) = 0
                     End If
                     
                  Case 1
                     Statedat(1) = InStr(Recbu, "+CSQ:")
                     StateOve = InStr(Statedat(1) + 1, Recbu, "OK" & Chr$(13) & Chr$(10))
                     StateErr = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
                     StateSpe = InStr(Statedat(1) + 1, Recbu, ",")
                     If Statedat(1) > 0 And StateOve > 0 Then
                        Statedat(1) = Mid$(Recbu, Statedat(1) + 6, StateSpe - Statedat(1) - 6)
                        CheckMessage = 1
                        Recbu = ""
                     Else
                        'CheckMessage = 1
                        Statedat(1) = 0
                     End If
                  Case 2
                     Statedat(2) = InStr(Recbu, "+CREG: 0,1")
                     StateOve = InStr(Statedat(2) + 1, Recbu, "OK" & Chr$(13) & Chr$(10))
                     StateErr = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
                     StateSpe = InStr(Statedat(2) + 1, Recbu, ",")
                     If Statedat(2) > 0 And StateOve > 0 Then
                        Statedat(2) = 1   'Mid$(Recbu, Statedat(1) + 6, StateSpe - Statedat(1) - 6)
                        CheckMessage = 1
                        Recbu = ""
                     Else
                        'CheckMessage = 1
                        Statedat(2) = 0
                     End If
                  Case 3
                     Statedat(3) = InStr(Recbu, "+CPMS")
                     StateOve = InStr(Statedat(3) + 1, Recbu, "OK" & Chr$(13) & Chr$(10))
                     StateErr = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
                     StateSpe1 = InStr(Statedat(3) + 1, Recbu, Chr$(34) & "SM" & Chr$(34) & ",")
                     StateSpe2 = InStr(StateSpe1 + 5, Recbu, ",")
                     If Statedat(3) > 0 And StateOve > 0 Then
                        Statedat(3) = 1   'Mid$(Recbu, Statedat(1) + 6, StateSpe - Statedat(1) - 6)
                        CheckMessage = 1
                        MemoryState = Mid$(Recbu, StateSpe1 + 5, StateSpe2 - StateSpe1 - 5)
                        Recbu = ""
                     Else
                        'CheckMessage = 1
                        Statedat(3) = 0
                     End If
                     
                  End Select
         Case 10
            ClearHead = InStr(Recbu, Chr$(13) & Chr$(10) & "+CMGR:")
            ClearOver = InStr(Recbu, Chr$(13) & Chr$(10) & "OK" & Chr$(13) & Chr$(10))
            ClearError = InStr(Recbu, "ERROR" & Chr$(13) & Chr$(10))
            If Aa1 > 0 And Aa2 > Aa1 + 3 And Aa5% = Aa3% And Aa5% > 0 Then 'receive message
          '
               Text2.Text = ""
               Chedabu = Mid$(Recbu, Aa2% + 2, Aa5% - Aa2% - 2)
           '    Chebu$ = Mid$(Recbu, 1, Aa1% - 1)
           '    Aa = InStr(Checdata, Chebu$)
              Text2.Text = Chedabu$
               '
                Recbu = ""
                MessageOut = 0
             ElseIf ClearError > 1 Then
                Indexb = 1
                Recbu = ""
             End If
         Case Else
             MessageNewO = InStr(Recbu, "+CMTI: " & Chr$(34) & "SM" & Chr$(34))
             NewMesOverO = InStr(MessageNewO + 1, Recbu, Chr$(13) & Chr$(10))
             Incall = InStr(Recbu, "RING" & Chr$(13) & Chr$(10))
             IncallVoice = InStr(Recbu, "+CRING:VOICE" & Chr$(13) & Chr$(10))
             IncallASYNC = InStr(Recbu, "+CRING:ASYNC" & Chr$(13) & Chr$(10))
             IncallRELAS = InStr(Recbu, "+CRING:RELASYNC" & Chr$(34) & "SM" & Chr$(34))
             ''IncallFax = InStr(Recbu, "+CRING:FAX" & Chr$(34) & "SM" & Chr$(34))
             If MessageNewO > 1 And NewMesOverO > 1 Then
          '
               Text2.Text = ""
               smsrec$ = "AT+CMGR=" & Mid$(Recbu, MessageNewO + 12, NewMesOverO - MessageNewO - 12) & Chr$(13)
               Indexb = Mid$(Recbu, MessageNewO + 12, NewMesOverO - MessageNewO - 12)
               MSComm1.Output = smsrec$
               Recbu = ""
               MessageOut = 4
              ElseIf Incall > 0 And Aa4% > 0 Then
               MSComm1.Output = "AT+CLIP?" & Chr$(13)   '发看来电命令
               MessageOut = 8
            DoEvents
            ''ATA = 1
              End If
               Recbu = ""
       End Select
    '' Case comEvSend
        'Case comEvCTS
        '    EVMsg$ = "Change in CTS Detected"
        'Case comEvDSR
        '    EVMsg$ = "Change in DSR Detected"
      ''  Case comEvCD
       ''     EVMsg$ = "Change in CD Detected"
        'Case comEvRing
        '    EVMsg$ = "The Phone is Ringing"
        'Case comEvEOF
        '    EVMsg$ = "End of File Detected"

        ' Error messages.
        'Case comBreak
        '    ERMsg$ = "Break Received"
        'Case comCDTO
        '    ERMsg$ = "Carrier Detect Timeout"
        'Case comCTSTO
        '    ERMsg$ = "CTS Timeout"
        'Case comDCB
        '    ERMsg$ = "Error retrieving DCB"
        'Case comDSRTO
        '    ERMsg$ = "DSR Timeout"
        'Case comFrame
        '    ERMsg$ = "Framing Error"
        'Case comOverrun
        '    ERMsg$ = "Overrun Error"
        'Case comRxOver
        '    ERMsg$ = "Receive Buffer Overflow"
        'Case comRxParity
        '    ERMsg$ = "Parity Error"
        'Case comTxFull
        '    ERMsg$ = "Transmit Buffer Full"
        'Case Else
          '  ERMsg$ = "Unknown error or event"
    End Select
    '
End Sub
Sub HanziSend(ByVal PDUSendTel As Variant, ByVal PDUHanziData As String)
Dim strChangH, strChangL As Variant
Dim strDataTel, SumChange As Variant
Dim strUcode, strDataLen, SumLen As String
Dim strSendData
'Getting the PDU_Mobile numbers
strDataTel = Mid(PDUSendTel, 3, 14)     'Mid(PDUSendTel, 3, 14) for 13 lengths Mobile_No
'
'Hanzi_codes exchange
strSendData = PDUHanziData
For i = 1 To LenB(strSendData)
    SumChange = AscB(MidB(strSendData, i, 1))
    strChangH = Hex(Int(SumChange / 16))
    strChangL = Hex(SumChange Mod 16)
    strUcode = strUcode & strChangH & strChangL
Next i
strDataLen = Hex(Len(strUcode) / 2)
If Len(strDataLen) = 1 Then strDataLen = "0" & strDataLen
 strSendData = vbNullString
For i = 1 To Len(strUcode) / 2
    strChangH = Mid(strUcode, 1, 2)
    strChangL = Mid(strUcode, 3, 2)
    strUcode = Mid(strUcode, 5)
    strSendData = strSendData & strChangL & strChangH
Next i
'strDataLen = "00" & strDataLen     'NEWYLY ADDED FOR BENQ's
strDataTel = "86" & strDataTel & "0008"  '"0004"
''strDataTel = "86" & strDataTel & "0018"     'With the fREE
strSendData = strDataLen & strSendData
SumLen = Trim(Len(strDataTel & strSendData) / 2 + 2)  'The total length of SMS_PDU's ;OLD=Len(strDataTel & strSendData) / 2 + 2
MSComm1.Output = "AT+CMGS=" & SumLen & Chr$(13)
             Tmptime = Timer + 1  '2
              Do While Tmptime > Timer      'CheckMessage = 0 And
                  DoEvents
             Loop
strUcode = "0011000D91" & strDataTel & strSendData & Chr$(26)  'OLD=001100
MSComm1.Output = strUcode
Recbu = ""
End Sub

Private Sub Text5_Change()
'Indexb = Mid(Trim(Text5.Text), 1, 1)
If IsNumeric(Text5.Text) And Len(Text5.Text) = 11 And Indexb >= 1 Then
'
 Call Text5_LostFocus
ElseIf IsNumeric(Text5.Text) And Len(Text5.Text) >= 12 Then
    Text4.Text = "号码超长第一位数应为零。"
End If
End Sub
Private Sub Text5_LostFocus()
Dim strChangH, strChangL As Variant
Dim strSendTel, strChang As String
strChang = ""
'PDU_No_codes exchange
If Len(Text5.Text) >= 11 And Len(Text5.Text) < 12 Then
strPDUMess = CStr(Text5.Text)
strSendTel = "86" & strPDUMess & "F"
For i = 1 To Len(strSendTel) / 2
    strChangH = Mid(strSendTel, 1, 1)
    strChangL = Mid(strSendTel, 2, 1)
    strSendTel = Mid(strSendTel, 3)
    strChang = strChang & strChangL & strChangH
Next i
Text4.Text = strChang
Else
   MsgBox "号码超过11位,第一位数应为零。", 0, "  GSM短信系统"
   Text4.Text = ""
    End If
End Sub