common.bas

6．1 PC机与PC机串口通信.rar

Attribute VB_Name = "mdlCommon"
Option Explicit
Public g_blIsListSMS        As Boolean
Public g_blIsSysBusy        As Boolean
Public g_blIsWaiting        As Boolean
Public g_blIsNewSMSIn       As Boolean
Public g_blIsSendingSMS     As Boolean
Public g_blIsHexCommData    As Boolean
Public g_blMaySaveAllSMS    As Boolean
Public g_blwav              As Boolean
Public g_strSave        As String
Public g_strThisAT      As String
Public g_strLastAT      As String
Public g_strLatestAT    As String
Public n_CountListSMS   As Long
Public g_SysInfo As SysStruct
Public TheForm As Form
Public TheMenu As Menu
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 'VB延时API函数
Public Declare Sub winhelp Lib "user32" (ByVal hWnd As Long, ByVal lphelpfile As String, ByVal wcommand As Long, ByVal dwData As Long) '调用帮助API函数
Public Declare Function htmlHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwndCaller As Long, ByVal pszFile As String, ByVal uCommand As Long, ByVal dwData As Long) As Long
Public Const HH_DISPLAY_INDEX = 2
Public Const HH_DISPLAY_TOC = 1
Public Const HH_DISPLAY_TOPIC = 0
Type SysStruct
    CommPort As Integer
    Baud As String
    ServiceNo As String
    DestNo As String
    SMSMelody As Integer
    Clock As Boolean
    ClockSet As String
End Type
Type SMSDef
    ListOrRead As Boolean       '是否用列举(List)方法读取
    SmsIndex As Long
    SourceNo As String
    ReachDate As String
    ReachTime As String
    SmsMain As String
End Type


'功能：解析串口中AT命令返回的信息
'输入参数:      串口数据
'输出参数：
'strATData:     短消息内容(UD)
'iSMSIdx:       短消息序号
'strSMSTime:    短消息接收时间
'strSMSSourceNO:源SIM卡号
'strSMSStatus:  短消息状态："READ"—已读，"UNREAD"—未读，"SENT"—发送，"UNSENT"—未发送
Public Function GetDataFromCommPort(ByVal strInput As String, strATData As String, Optional CommandStatus As String, Optional TimedOut As Boolean, Optional iSMSIdx As Integer, Optional strSMSTime As String, Optional strSMSSourceNO As String, Optional strSMSStatus As String) As Boolean
    On Error GoTo ErrorG
    Dim strTmp As String, strTmp1 As String
    Dim i As Integer, iTmp1 As Integer, iTmp2 As Integer
    Dim iLen As Integer
    Dim blHasError As Boolean
    Dim blIfInprogress As Boolean
    Static iCountMonitor As Integer
    strTmp = ""
    For i = 1 To Len(strInput)
        strTmp1 = Mid(strInput, i, 1)
        If strTmp1 <> vbLf Then strTmp = strTmp & strTmp1
    Next i
    g_strSave = g_strSave & strTmp '"AT+CMGR=1" & vbCrLf & "+CMGR: REC"
    If InStr(strTmp, vbCr) > 0 Then ' And (InStr(strTmp, "OK") > 0 Or InStr(strTmp, "ERROR") > 0) Then
        g_blIsWaiting = False
        iCountMonitor = 0
    End If
    iCountMonitor = iCountMonitor + 1
    '1、看是否是AT命令或者其响应
    '   a. 如果是AT开头或者有A/且A/之后是回车换行，则表示ATE1
    '   b. 如果不是以上或者以以上字符串开头，回车换行之后以"+"开头，或者"OK"、"ERROR"
    '   则表示是AT命令的响应。
    '   另外，还有一种可能是以上所述字符串出现在半道，
    '   那么，在这种情况下需要查找符合条件的字符串，从中截取出响应字符串
    '   在这里，如果命令一时没有全部返回，因为串口数据不一定会得到全部数据
    '   所以，设置一个静态的Bool变量blIsWaiting，来指示是否结束了本条AT响应单元
ProcessNextData:
    Do
        If Left(g_strSave, 1) = vbCr Then
            g_strSave = Right(g_strSave, Len(g_strSave) - 1)
        Else
            Exit Do
        End If
    Loop
    If Not g_blIsWaiting Then
        If g_strThisAT = "" Then
            g_blIsWaiting = True
            If UCase(Left(g_strSave, 3)) = "A/" & vbCr Then
                CommandStatus = "重复上次指令"
                g_strSave = Right(g_strSave, Len(g_strSave) - 3)
                g_strThisAT = ""
                g_blIsWaiting = False
            ElseIf UCase(Left(g_strSave, 2)) = "AT" Then '命令的回显
                iLen = InStr(g_strSave, vbCr) '查找命令输入结束符号——回车
                If iLen > 0 Then
                    g_strLastAT = Left(g_strSave, iLen) '保存回显的命令，作为指示的依据。
                    g_strSave = Right(g_strSave, Len(g_strSave) - iLen) '只保留命令的执行部分
                    g_strThisAT = "IsEcho"
                Else
                    g_blIsWaiting = True
                End If
            ElseIf UCase(Left(g_strSave, 2)) <> "AT" Then '如果开头字符不是AT+，那么需要搜索一下；
                iTmp1 = InStr(g_strSave, "+")               '首先查找AT指令响应标志"+"
                If iTmp1 > 0 Then                        '如果找到了"+"
                    iTmp2 = InStr(g_strSave, ":")           '查找响应结束符标志":"
                    If iTmp2 > 0 And iTmp2 > iTmp1 Then  '根据起始符"+"，用以确定最近返回的是哪一个指令
                        g_strThisAT = Mid(g_strSave, iTmp1, iTmp2 - iTmp1 + 1)
                        g_strSave = Right(g_strSave, Len(g_strSave) - iTmp1 + 1)
                        blHasError = False
                    Else
                        '假如没有找到成对出现或者任何一个都没有的返回值，那么要等待后面的内容
                        If Len(g_strSave) - iTmp1 > 15 Then
                            blHasError = True
                        Else
                            blHasError = False
                            g_blIsWaiting = True
                        End If
                    End If
                Else
                    If InStr(g_strSave, "OK") > 0 Then '是OK吗？
                        g_strThisAT = "OK"
                    ElseIf InStr(g_strSave, "ERROR") > 0 Then  '不是OK，是ERROR吗？
                        g_strThisAT = "ERROR"           '但属于非正常操作
                    ElseIf InStr(g_strSave, "RING") > 0 Then
                        g_strThisAT = "RING"
                    Else
                        iLen = InStr(g_strSave, vbCr)
                        If iLen > 0 Then
                            g_strSave = Right(g_strSave, Len(g_strSave) - iLen)
                            g_strThisAT = ""
                            blHasError = False
                        Else
                            blHasError = True
                        End If
                    End If
                End If
                If blHasError Then
                    g_strSave = ""
                    g_strThisAT = ""
                    g_blIsWaiting = True
                End If
            End If
        End If
        'If g_strThisAT <> "" Then g_blIsWaiting = Not AnalysisData(g_strSave, g_strThisAT, blIfInprogress, CommandStatus)
    End If
    If TimedOut = True Then
        TimedOut = False
    End If
    TimedOut = g_blIsWaiting
    If g_strSave <> "" And g_strSave <> vbCr Then
        If g_strThisAT = "" Then
            iCountMonitor = iCountMonitor + 1
            If Not g_blIsWaiting Then GoTo ProcessNextData
        End If
    ElseIf g_strSave = vbCr Or g_strSave = "" Then
        g_strSave = ""
        g_blIsWaiting = False
        g_strThisAT = ""
        g_strLastAT = ""
    End If
    strATData = g_strSave
    GetDataFromCommPort = True
    Exit Function
ErrorG:
    CommandStatus = "获取串口数据:" & Err.Description
End Function
Public Function PickAllSMS(ByRef InputString As String, RetSMS() As SMSDef) As String
    Dim i As Integer, iTmp As Integer, iLen As Integer, iNext As Integer, iCr As Integer
    Dim n As Long
    Dim strTmp As String, strTmp1 As String, strTmp2 As String
    Dim btTmp() As Byte, btTmp2() As Byte
    Dim blRet As Boolean
On Error Resume Next
    strTmp = ""
    btTmp = InputString
    '======== 将短消息中的双引号去除 ========
    iTmp = 0
    For i = 0 To UBound(btTmp)
        strTmp1 = Chr(btTmp(i))
        If strTmp1 <> """" And btTmp(i) <> 0 And strTmp1 <> vbLf Then
            ReDim Preserve btTmp2(0 To iTmp + 1)
            btTmp2(iTmp) = btTmp(i)
            btTmp2(iTmp + 1) = 0
            iTmp = iTmp + 2
        End If
    Next i
    InputString = btTmp2
    n = 0
    i = 1
    Do
        iTmp = InStr(i, InputString, "+CMGL:")
        iCr = InStr(iTmp, InputString, vbCr)
        
        If iTmp > 0 Then
            If iCr - iTmp + 1 > 0 Then n = n + 1
        ElseIf iTmp = 0 Then
            Exit Do
        End If
        i = iTmp + 7