mdlcommon.bas

这是一个通过手机串口实现短信发送的实例

Attribute VB_Name = "mdlCommon"
Option Explicit

Public g_blIsEndCall        As Boolean
Public g_blIsListSMS        As Boolean
Public g_blIsSysBusy        As Boolean
Public g_blIsWaiting        As Boolean
Public g_blIsNewSMSIn       As Boolean
Public g_blIsNewCallIn      As Boolean
Public g_blIsSendingSMS     As Boolean
Public g_blIsHexCommData    As Boolean
Public g_blMaySaveAllSMS    As Boolean

Public g_strSave        As String
Public g_strThisAT      As String
Public g_strLastAT      As String
Public g_strLatestAT    As String

Public g_nCountPlaySnd  As Long

Public g_SysInfo As SysStruct

Dim n_CountListSMS      As Long


Public OldWindowProc As Long
Public TheForm As Form
Public TheMenu As Menu

Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Declare Function GetForegroundWindow Lib "user32" () As Long

Public Const WM_USER = &H400
Public Const WM_LBUTTONUP = &H202
Public Const WM_MBUTTONUP = &H208
Public Const WM_RBUTTONUP = &H205
Public Const TRAY_CALLBACK = (WM_USER + 1001&)
Public Const GWL_WNDPROC = (-4)
Public Const GWL_USERDATA = (-21)
Public Const NIF_ICON = &H2
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIF_MESSAGE = &H1
Public Const NIM_MODIFY = &H1
Public Const NIM_DELETE = &H2

Public Type NOTIFYICONDATA
    cbSize As Long
    hWnd As Long
    uID As Long
    uFlags As Long
    uCallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type

Private TheData As NOTIFYICONDATA
' *********************************************
' The replacement window proc.
' *********************************************
Public Function NewWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = TRAY_CALLBACK Then
        ' The user clicked on the tray icon.
        ' Look for click events.
        If lParam = WM_LBUTTONUP Then
            ' On left click, show the form.
            If TheForm.WindowState = vbMinimized Then
                TheForm.WindowState = TheForm.LastState
                TheForm.Visible = True
                TheForm.SetFocus
            Else
                'TheForm.Visible = False
                TheForm.LastState = TheForm.WindowState
                TheForm.WindowState = vbMinimized
                TheForm.Hide
            End If
            Exit Function
        End If
        If lParam = WM_RBUTTONUP Then
            ' On right click, show the menu.
            TheForm.PopupMenu TheMenu
            Exit Function
        End If
    End If
    
    ' Send other messages to the original
    ' window proc.
    NewWindowProc = CallWindowProc( _
        OldWindowProc, hWnd, Msg, _
        wParam, lParam)
End Function
' *********************************************
' Add the form's icon to the tray.
' *********************************************
Public Sub AddToTray(frm As Form, mnu As Menu)
    ' ShowInTaskbar must be set to False at
    ' design time because it is read-only at
    ' run time.

    ' Save the form and menu for later use.
    Set TheForm = frm
    Set TheMenu = mnu
    
    ' Install the new WindowProc.
    OldWindowProc = SetWindowLong(frm.hWnd, _
        GWL_WNDPROC, AddressOf NewWindowProc)
    
    ' Install the form's icon in the tray.
    With TheData
        .uID = 0
        .hWnd = frm.hWnd
        .cbSize = Len(TheData)
        .hIcon = frm.Icon.Handle
        .uFlags = NIF_ICON
        .uCallbackMessage = TRAY_CALLBACK
        .uFlags = .uFlags Or NIF_MESSAGE
        .cbSize = Len(TheData)
    End With
    Shell_NotifyIcon NIM_ADD, TheData
End Sub
' *********************************************
' Remove the icon from the system tray.
' *********************************************
Public Sub RemoveFromTray()
    ' Remove the icon from the tray.
    With TheData
        .uFlags = 0
    End With
    Shell_NotifyIcon NIM_DELETE, TheData
    
    ' Restore the original window proc.
    SetWindowLong TheForm.hWnd, GWL_WNDPROC, _
        OldWindowProc
End Sub
' *********************************************
' Set a new tray tip.
' *********************************************
Public Sub SetTrayTip(tip As String)
    With TheData
        .szTip = tip & vbNullChar
        .uFlags = NIF_TIP
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub
' *********************************************
' Set a new tray icon.
' *********************************************
Public Sub SetTrayIcon(pic As Picture)
    ' Do nothing if the picture is not an icon.
    If pic.Type <> vbPicTypeIcon Then Exit Sub

    ' Update the tray icon.
    With TheData
        .hIcon = pic.Handle
        .uFlags = NIF_ICON
    End With
    Shell_NotifyIcon NIM_MODIFY, TheData
End Sub




''************************************
'功能：解析串口中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
    'Static g_strLastAT As String
    
    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
    
    'iCountMonitor = iCountMonitor + 1
    strTmp = ""
    For i = 1 To Len(strInput)
        strTmp1 = Mid(strInput, i, 1)
        If strTmp1 <> vbLf Then strTmp = strTmp & strTmp1
    Next i
    'strInput = strTmp
    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
'                            Text5.Text = Left(g_strSave, iLen)
                            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
'                    Text5.Text = g_strSave
                    g_strSave = ""
                    g_strThisAT = ""
                    g_blIsWaiting = True
                End If
            End If