main.frm

at命令调试精灵 可以执行at命令

    MSComm1.InBufferCount = 0 ';//清除接收缓冲区
    MSComm1.OutBufferCount = 0 ';//清除发送缓冲区
    MSComm1.RTSEnable = True '; //请求发送
    MSComm1.RThreshold = 1 ';//设置为接收缓冲区每接收一个字符将引发一次OnComm事件
    MSComm1.DTREnable = True '; // 数据终端准备好
    MSComm1.Handshaking = comNone
    MSComm1.Settings = CStr(cmbBaud.Text) & ",N,8,1" ';//设置波特率无校验，8个数据位，1个停止位
    MSComm1.PortOpen = True
    
    If MSComm1.PortOpen = True Then
        'atcommandstr = atcommandstr & "ATS4=124" & vbCr & ","  '设置响应格式化字符为"|"
        'atcommandstr = atcommandstr & "AT+CNMI=2,2,0,0,1" & vbCr & ","  '当有某类短消息到达时，如何处理它
        atcommandstr = atcommandstr & "ATE0" & vbCr & ","  '命令回显,ATE0命令不回显
        atintodllist ("ATE0")
        atcommandstr = atcommandstr & "AT+CMGF=0" & vbCr & "," '切换到pdu格式,否则将读出短信时出错
        atintodllist ("AT+CMGF=0")
        atcommandstr = atcommandstr & "AT+CSCA=" & txtMsgCenter.Text & vbCr & "," '设置短信中心服务号码
        atintodllist ("AT+CSCA=" & txtMsgCenter.Text)
        atcommandstr = atcommandstr & "ATI" & vbCr & ","  '查询产品信息
        atintodllist ("ATI")
        cmdConnect.Enabled = False
        cmdDisConnect.Enabled = True
        openstate = True
        runatTimer.Enabled = True
    Else
        MsgBox ("连接失败，看端口有没设置正确")
        openstate = False
        runatTimer.Enabled = False
    End If
    Exit Sub
e:
    MsgBox ("连接失败，看端口有没设置正确")
End Sub

Sub atintodllist(atcommand As String)
atcommanddlindex = atcommanddlindex + 1
Set Itm = atcommanddl.ListItems.Add(, "w" & atcommanddlindex)
Itm.Text = atcommand
Set Itm = Nothing
End Sub

Private Sub cmdDisConnect_Click()
Call dk
End Sub
Sub dk() '断开操作
    On Error Resume Next
    MSComm1.PortOpen = False
    cmdConnect.Enabled = True
    cmdDisConnect.Enabled = False
    openstate = False
    runatTimer.Enabled = False
End Sub

Private Sub Command1_Click()
If atstrt.Text = "" Then
MsgBox ("请输入at指令")
Exit Sub
End If
If openstate = True Then
atcommandstr = atcommandstr & atstrt.Text & vbCr & ","
atintodllist (atstrt.Text)
Else
ts ("设备未连接")
End If
End Sub
Sub ts(str As String)
Label3.Caption = str
End Sub



Private Sub Form_Load()
With atcommanddl '加入ListItems的列标题
    .ColumnHeaders.Clear
    .ColumnHeaders.Add , , "at指令", .Width
End With
setregEx
End Sub

Private Sub MSComm1_OnComm()
Select Case MSComm1.CommEvent
      Case comEventBreak   ' 收到 Break。
      ts ("接收到一个中断信号")
       Case comEventCDTO   ' CD (RLSD) 超时。
       ts ("载波检测超时。在系统规定时间内传输一个字符时，Carrier Detect 线为低电平。Carrier Detect 也称为 Receive Line Signal Detect (RLSD)。")
      Case comEventCTSTO   ' CTS Timeout。
      ts ("Clear To Send 超时。在系统规定时间内传输一个字符时，Clear To Send 线为低电平。")
      Case comEventDSRTO   ' DSR Timeout。
      ts ("Data Set Ready 超时。在系统规定时间内传输一个字符时，Data Set Ready 线为低电平。")
      Case comEventFrame   ' Framing Error
      ts ("帧错误。硬件检测到一帧错误")
      Case comEventOverrun   '数据丢失。
      ts ("端口超速。没有在下一个字符到达之前从硬件读取字符，该字符丢失。")
      Case comEventRxOver '接收缓冲区溢出。
      ts ("接受缓冲区溢出。接收缓冲区没有空间。")
      Case comEventRxParity ' Parity 错误。
      ts ("奇偶校验。硬件检测到奇偶校验错误")
      Case comEventTxFull   '传输缓冲区已满。
      ts ("传输缓冲区已满。传输字符时传输缓冲区已满")
      Case comEventDCB   '获取 DCB] 时意外错误
      ts ("检索端口的设备控制块 (DCB) 时的意外错误")

   ' 事件
      Case comEvCD   ' CD 线状态变化。
      'ts ("Carrier Detect 线的状态发生变化。")
      dk
      Case comEvCTS   ' CTS 线状态变化。
      'ts ("Clear To Send 线的状态发生变化。")
      dk
      Case comEvDSR   ' DSR 线状态变化。
      'ts ("Data Set Ready 线的状态发生变化。该事件只在 DST 从 1 变到 0 时才发生。")
      dk
      Case comEvRing   ' Ring Indicator 变化。
      'ts ("检测到振铃信号。一些 UART（通用异步接收— 传输）可能不支持该事件。")
      Case comEvReceive   ' 收到 RThreshold # of
      'ts ("收到 Rthreshold 个字符。该事件将持续产生直到用 Input 属性从接收缓冲区中删除数据。")
      OnCommstr = MSComm1.Input
      atjg.Text = atjg.Text & OnCommstr 'OnCommstr是数量不等的字符串
      resultstr = resultstr & OnCommstr
      Case comEvSend   ' 传输缓冲区有 Sthreshold 个字符
      ts ("在传输缓冲区中有比 Sthreshold 数少的字符。")              '
      Case comEvEOF   ' 输入数据流中发现 EOF 字符
       ts ("收到文件结束（ASCII 字符为 26）字符。")              '
   End Select
End Sub



Private Sub runatTimer_Timer()
If atcommandstr = "" Or openstate = False Then
Exit Sub
End If
Dim atcommandstrarray
atcommandstrarray = Split(atcommandstr, ",")
runatTimer.Enabled = False
MSComm1.Output = CStr(atcommandstrarray(0))
viewresutTimer.Enabled = True
End Sub

Private Sub viewresutTimer_Timer()
    Dim atcommandstrarray
    
    If RegExpTest(vbCr & vbLf & "[^§]{1,}" & vbCr & vbLf, resultstr, "") <> "" Then
            If atcommandstr <> "" Then
                atcommandstrarray = Split(atcommandstr, ",")
                atcommandstr = Mid(atcommandstr, Len(atcommandstrarray(0)) + 2)
                If atcommanddl.ListItems.Count <> 0 Then
                atcommanddl.ListItems.Remove (1)
                End If
                resultstr = ""
                viewresutTimer.Enabled = False
                runatTimer.Enabled = True
            End If
    End If
    
    Exit Sub
    
    '当返回结果时，就删除执行完的命令，有的命令返回的结果并不是以ok或error结束的
    
    If Right(resultstr, 2) = vbCr & vbLf Then
            If atcommandstr <> "" Then
                atcommandstrarray = Split(atcommandstr, ",")
                atcommandstr = Mid(atcommandstr, Len(atcommandstrarray(0)) + 2)
                resultstr = ""
                viewresutTimer.Enabled = False
                runatTimer.Enabled = True
            End If
    End If
    
    Exit Sub
    
    '执行atcommandstr里的命令后，返回结果（ok或error）时，再清除对应的命令
    If InStr(Right(resultstr, 4), "OK") <> 0 Or InStr(Right(resultstr, 7), "ERROR") <> 0 Then
        If atcommandstr <> "" Then
            atcommandstrarray = Split(atcommandstr, ",")
            atcommandstr = Mid(atcommandstr, Len(atcommandstrarray(0)) + 2)
            resultstr = ""
            viewresutTimer.Enabled = False
            runatTimer.Enabled = True
        End If
    End If
    
    Exit Sub
    
    '执行atcommandstr里的命令，如果执行返回ok，则清除对应的命令
    If InStr(Right(resultstr, 4), "OK") <> 0 Then
        If atcommandstr <> "" Then
        atcommandstrarray = Split(atcommandstr, ",")
        atcommandstr = Mid(atcommandstr, Len(atcommandstrarray(0)) + 2)
        resultstr = ""
        viewresutTimer.Enabled = False
        runatTimer.Enabled = True
        End If
    End If
    Exit Sub
    '执行atcommandstr里的命令，如果返回错误，则继续执行该指令
    If InStr(Right(resultstr, 7), "ERROR") <> 0 Then
        resultstr = ""
        viewresutTimer.Enabled = False
        runatTimer.Enabled = True
    End If
End Sub
Public Function RegExpTest(patrn As String, strng As String, splitstr As String) As String 'splitstr是分割符
  Dim Match, Matches, str As String, RetStr As String  ' 建立变量。
  regEx.Pattern = patrn         ' 设置模式。
  regEx.IgnoreCase = False         ' 设置是否区分字符大小写。
  regEx.Global = True 'True         ' 设置全局可用性。
  Set Matches = regEx.Execute(strng)   ' 执行搜索。
  For Each Matche In Matches      ' 遍历匹配集合。
    str = Matche.Value
    RetStr = RetStr & str & splitstr
  Next
  RegExpTest = RetStr
End Function

Function ReplaceTest(inputString As String, patrn As String, replacementText As String) As String
    regEx.Pattern = patrn ' 设置模式。
    regEx.IgnoreCase = False ' 设置是否区分大小写。
    regEx.Global = True
    ReplaceTest = regEx.Replace(inputString, replacementText)
End Function

Public Sub setregEx()
Set regEx = New RegExp
End Sub