smspdufrm.frm

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

Dim Recbu, OverFinger, ATA, MemoryState As Variant
Dim Statedat(100) As Variant
Dim SMSCTR$
Dim smsrec$
Dim flgPDU, CMGFflg As Boolean
Dim Tmptime As Variant
Dim strPDUMess, MyFILE As String
Dim Callh, Callok, CallErro As Variant
Dim Indexb, nPORT As Variant
Dim strSMS, MOBNum, SIMNO  As Variant
''Dim strChang As Variant
Private Sub Command1_Click()
 '
    Text2.Text = ""
    smsrec$ = Trim(Text6.Text)
    strPDUMess = Trim(Text4.Text)
    If strPDUMess = "" Or Text6.Text = "" Then Exit Sub
If Asc(smsrec$) < 0 Then
  MSComm1.Output = "AT+CMGF=0" & Chr$(13)  'IN PDU
         Tmptime = Timer + 1
             Do While Tmptime > Timer
                  DoEvents
             Loop
   flgPDU = True
 ' CMGFflg = False
    Recbu = ""
  ''  MessageOut = 4
   If Len(Trim(Text5.Text)) >= 11 Then   '12
   ''  Call SendHZ(Chedabu, smsrec$)  'Sending Hanzi
     Call HanziSend(strPDUMess, smsrec$)   '     Call HanziSend(strPDUMess, smsrec$)
     DoEvents
   Tmptime = Timer + 3
             Do While Tmptime > Timer
                  DoEvents
             Loop
   End If
   MSComm1.Output = "AT+CMGF=" & "1" & Chr$(13)
Else
        MsgBox "非汉字输入，请重新录入！", vbInformation, "GSM短信系统"
'    SMSCTR$ = "ATD" & Text5.Text & ";" & Chr$(13)
  End If
End Sub
Private Sub Command3_Click()
If Len(Text5.Text) >= 11 And (Text4.Text) <> "" Then
 strSMS = Trim(Text4.Text)
 SMSCTR$ = "AT+CMGW=" & "1860" & Chr$(13)
           MSComm1.Output = "AT+CMGW=" & "1860" & Chr$(13)
           Tmptime = Timer + 1.2
             Do While Tmptime > Timer
                  DoEvents
             Loop
           MSComm1.Output = strSMS & Chr$(26) & Chr$(13)
        MsgBox "PDU_No.短信息已写入卡中!", 0, "  GSM短信OK"
      Recbu = ""
      strSMS = ""
      SMSCTR$ = ""
    Else: MsgBox "非法号码，请重新录入！", vbInformation, "GSM短信系统"
    Recbu = ""
    End If
'
End Sub
Private Sub Command2_Click()
Text2.Text = ""
 Call mnuCommRead_Click
 Text7.Text = Trim(SIMNO)
'CMGFflg = True
End Sub

Private Sub Command4_Click()
  Text2.Text = ""
Call mnuCommClear_Click
End Sub
Private Sub Command7_Click()
'
End Sub

Private Sub Form_Load()
Dim tmpPORT As String
'
    Text2.Text = ""
    ATA = 0
    flg = 1
    aa = 0
    Indexb = 1
  Text7.Text = "1"
    MessageOut = 0
    Text6.Text = ""
    Text5.Text = "13XXXXXXXXX"   ''13705666342
    Text4.Text = ""
    List1.Text = "1"
    SIMNO = 1
Me.Move 2880, 1080, Me.Width, Me.Height  'OLD=2200,1800
MOBNum = 1
''Command2.SetFocus (0)
'MyFILE = App.Path + "\HZTHelp.DOC"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Cancel = 0
End
End Sub
Private Sub mnuCommClear_Click()
 Indexb = 1
           Text2.Text = ""
           If Indexb >= 20 Or Indexb < 0 Then
            ''  Indexb = 1
              Exit Sub
            End If
    Do While Indexb <= 10   ''  OLD=12
             SMSCTR$ = "AT+CMGD=" & Indexb & Chr$(13)
             'SMSCTR$ = "AT+CMGL=ALL" & Chr$(13)
             MSComm1.Output = SMSCTR$
             Recbu = ""
             Tmptime = Timer + 1.4
              Do While Tmptime > Timer
                  DoEvents
             Loop
      ''      MSComm1.Output = "AT+CMGD=" & Indexb & Chr$(13)
             Indexb = Indexb + 1
        Loop
          MsgBox "SIM卡的信息已清空 !", 0, "  GSM短信系统"
            Text2.Text = ""
            Recbu = ""
End Sub
Private Sub mnuCommNumb_Click()
Dim MOBILENum, MOBName As String
''MOBNum = Val(Text7.Text)
MOBILENum = CStr(Text5.Text)
MOBName = CStr(Text4.Text)
If Len(Text5.Text) >= 8 And MOBNum <> "" Then
If MOBNum = 1 Or MOBNum = 3 Then
MSComm1.Output = "AT+CPBW=" & MOBNum & Chr$(44) & Chr$(34) & MOBILENum & Chr$(34) & Chr$(44) & "129" & Chr$(44) & Chr$(34) & "CAR" & Chr$(34) & Chr$(13)
     MessageOut = 0
   MOBNum = MOBNum + 1
        Tmptime = Timer + 1.4
              Do While Tmptime > Timer
                  DoEvents
             Loop
   MSComm1.Output = "AT+CPBW=" & MOBNum & Chr$(44) & Chr$(34) & MOBILENum & Chr$(34) & Chr$(44) & "129" & Chr$(44) & Chr$(34) & "CAR" & Chr$(34) & Chr$(13)
      MessageOut = 0
 MOBNum = MOBNum + 1
''Text7.Text = CStr(MOBNum)
 ''MsgBox "2个报警电话号码已存入 ", 0, "  GSM短信系统"
''ElseIf MOBNum = 2 Then
''MSComm1.Output = "AT+CPBW=" & MOBNum & Chr$(44) & Chr$(34) & MOBILENum & Chr$(34) & Chr$(44) & "129" & Chr$(44) & Chr$(34) & "CAR" & Chr$(34) & Chr$(13)
 '     MessageOut = 0
             Tmptime = Timer + 1.6
              Do While Tmptime > Timer
                  DoEvents
             Loop
  ''MOBNum = MOBNum + 1
  'Text7.Text = CStr(MOBNum)
''ElseIf MOBNum = 3 Then
MSComm1.Output = "AT+CPBW=" & MOBNum & Chr$(44) & Chr$(34) & MOBILENum & Chr$(34) & Chr$(44) & "129" & Chr$(44) & Chr$(34) & "CAR" & Chr$(34) & Chr$(13)
 ''MOBNum = MOBNum + 1  'MOVED TO ABOVE
  Text7.Text = CStr(MOBNum)
MsgBox " 车主报警号码已存入电话簿（1/2） ", 0, "  GSM短信系统"
 MOBNum = 3
Else
MOBNum = 1
Exit Sub
End If
 Text2.Text = ""
 Recbu = ""
End If
End Sub
'
Private Sub mnuCommOut_Click()
''If MSComm1.PortOpen Then
''MSComm1.Output = "AT+CMGF=1" & Chr$(13)
'End If
Unload Me
End Sub
'
Private Sub mnuCommPort232_Click()
 '   MSComm1.CommPort = 1
 '   MSComm1.Settings = "9600,n,8,1"     '19200
 '   MSComm1.PortOpen = True
 '   MSComm1.DTREnable = True
 '   MSComm1.RTSEnable = True
 '   MSComm1.RThreshold = 1
End Sub

Private Sub mnuCommRead_Click()
Indexb = Val(Text7.Text)
If Indexb <= 25 Or Indexb > 0 Then
 MSComm1.Output = "AT+CMGR=" & Indexb & Chr$(13)
 SIMNO = SIMNO + 1
 ''Text7.Text = Trim(Indexb)
   ''  MessageOut = 1
End If
End Sub
'
Private Sub mnuCommSelcheck_Click()
If MOBNum <= 1 Then
 nPORT = Val(List1.Text)
End If
If Not MSComm1.PortOpen Then
    MSComm1.CommPort = nPORT
    MSComm1.Settings = "9600,n,8,1"     '19200
    MSComm1.DTREnable = True
    MSComm1.RTSEnable = True
    MSComm1.RThreshold = 1
    MSComm1.PortOpen = True
 End If
             Recbu = ""
        Tmptime = Timer + 1.6
              Do While Tmptime > Timer
                  DoEvents
             Loop
         For OverFinger = 0 To 3
         '
         If OverFinger = 0 Then
             SMSCTR$ = "AT+CPIN?" & Chr$(13)
             MSComm1.Output = SMSCTR$
             MessageOut = 9
       '
             CheckMessage = 0
             Tmptime = Timer + 3  'OLD=3.5
              Do While CheckMessage = 0 And Tmptime > Timer
                  DoEvents
             Loop
             Recbu = ""
              'Statedat(OverFinger) = InStr(Chedabu, "+CPIN:")
             If Statedat(OverFinger) >= 1 Then
                 Text2.Text = Text2.Text & Chr$(13) & Chr$(10) & "SIM卡有效"
              SMSCTR$ = "AT+CSQ" & Chr$(13)
              MSComm1.Output = SMSCTR$
            CMGFflg = True
             Else
               Rev = MsgBox("SIM卡未装/串口不匹配", 0, "  GSM短信系统")
               OverFinger = 255
             End If
          ElseIf OverFinger = 1 Then
             CheckMessage = 0
             Tmptime = Timer + 3
              Do While CheckMessage = 0 And Tmptime > Timer
                  DoEvents
             Loop
             Recbu = ""
             'Stche = Mid$(Chedabu, 7, 2)
           ''  If Statedat(OverFinger) > 5 And Statedat(OverFinger) < 99 Then
                Text2.Text = Text2.Text & Chr$(13) & Chr$(10) & "信号良好"
              SMSCTR$ = "AT+CREG?" & Chr$(13)
               MSComm1.Output = SMSCTR$
              ''  OverFinger = OverFinger + 1
           ''  Else
            '    Rev = MsgBox("信号较差", 0, "  GSM短信系统")
            '    OverFinger = 250
            ' End If
          ElseIf OverFinger = 2 Then
             CheckMessage = 0
             Tmptime = Timer + 2
              Do While Tmptime > Timer      'CheckMessage = 0 And
                  DoEvents
             Loop
             'Stche = InStr(Chedabu, "+CREG: 0,1")
             If Val(OverFinger) > 1 Then    'OLD=Statedat(OverFinger)
                  Text2.Text = Text2.Text & Chr$(13) & Chr$(10) & "GSM已登录"
                  Rev = MsgBox("GSM_MODEM已准备就绪", 0, "  GSM短信系统")
             ''   SMSCTR$ = "AT+CPMS?" & Chr$(13)     ''
            CMGFflg = True
            Tmptime = Timer + 1
              Do While CheckMessage = 0 And Tmptime > Timer
                  DoEvents
             Loop
            MessageOut = 0
              MSComm1.Output = "AT+CMGF=" & "1" & Chr$(13)  'for BENQ ="AT$NOSLEEP=1" & Chr$(13)      'JUST CACELED NOW
            Tmptime = Timer + 1.1
              Do While CheckMessage = 0 And Tmptime > Timer
                  DoEvents
             Loop
                   Text2.Text = ""
             Else
                   Rev = MsgBox("GSM登录失败", 0, "  GSM短信系统")
                 SMSCTR$ = "AT+CPMS?" & Chr$(13)
                MSComm1.Output = SMSCTR$
                 MessageOut = 4     ''
                 Text2.Text = ""
                 Exit Sub
             End If
'
             ElseIf OverFinger = 3 Then
             CheckMessage = 0
             Tmptime = Timer + 1
              Do While CheckMessage = 0 And Tmptime > Timer
                  DoEvents
             Loop
             'Stche = InStr(Chedabu, "+CREG: 0,1")
             If MemoryState > 0 Then
                  'Text2.Text = Text2.Text & Chr$(13) & Chr$(10) & "GSM已登录"
                  Rev = MsgBox("GSM-MODEM内存有" & MemoryState & "条信息！是否清除？", 4, "  GSM短信系统")
                  If Rev = 6 Then
                    Indexb = MemoryState
                    Clearstate = 1
                  Do While Clearstate = 1
                      SMSCTR$ = "AT+CMGR=" & Indexb & Chr$(13)
                      MSComm1.Output = SMSCTR$
             '
                      MessageOut = 1
                      ClearMessage = 0
                    Do While ClearMessage = 0
                      DoEvents
                    Loop
                    Indexb = Indexb - 1
                    If Indexb = 0 Then
                      Clearstate = 0
                    End If
                  Loop
                  Recbu = ""
                  Rev = MsgBox("信息已清空", 0, "  GSM短信系统")
                  MessageOut = 0
                  CMGFflg = True
                  Else
              ''   MSComm1.Output = "AT+CSDH=0" & Chr$(13)   ' Do not show SMS_header values
                 MSComm1.Output = "AT+CMGF=1" & Chr$(13)   '"AT+CLIP=1" & Chr$(13)  'Income call_display enabling
                Tmptime = Timer + 2
                Do While Tmptime > Timer      'CheckMessage = 0 And
                  DoEvents
                Loop
                End If
          '
             Else
               '  MsgBox "GSM登录失败", 0, "  GSM短信系统"
               ''    OverFinger = 250
             End If
          End If
        Next
             Recbu = ""
             MessageOut = 0
             Text2.Text = ""
End Sub
Sub mnuCommSetting_Click()
CMGFflg = True
End Sub
Private Sub mnuCommWrite_Click()
'
End Sub

Private Sub mnuHELP_Click()
Dim RetVal As Variant
If Not CheckFile(MyFILE) Then
  MsgBox "帮助文件不存在", vbInformation + vbCritical, "出错提示" '给出缺少信息提示
Else
'' Open File For Random As ( & "MyFILE" & "")
''RetVal = Shell("WINWORD.EXE " & "D:\写卡操作NEW.DOC", 1)
''RetVal = Shell("C:\WINDOWS\RECENT\WINWORD8.LNK", 1)
 MsgBox "请在WIN—WORD下打开《写卡操作Help.DOC》", vbInformation + vbCritical, "提 示"
 End If
End Sub

Private Sub mnuSetCenter_Click()
    Text2.Text = ""
    '
    MessageOut = 8
    SMSCTR$ = "AT+CSCA=+86" & Text6.Text & Chr$(13)
    MSComm1.Output = SMSCTR$
End Sub

Private Sub mnuSetOut_Click()
             Recbu = ""
             MessageOut = 0
   '
    Text2.Text = ""
MSComm1.Output = "AT+CPOF" & Chr$(13)    'CLOSE THE GSMM
End Sub

Private Sub mnuStateReport_Click()
''Dim strSMS As Variant
'
             Text2.Text = ""
             strSMS = Trim(Text6.Text)
             If Len(Text6.Text) >= 12 And (Text5.Text) <> "" Then
              SMSCTR$ = "AT+CMGW=" & Trim(Text5.Text) & Chr$(13) ' "AT+CMGW="  & Len(strSMS) / 2 &