mg801a.ctl

短信收发控制（AT命令）

doerrors:
    Select Case (Err.Number)
    Case 68
        RaiseEvent OnResult(Port_invalid)
    Case 8005
        RaiseEvent OnResult(Port_used)
    End Select
    Int_state = Lookfor
    Err.Clear
End Function

Public Sub PortClose()
'关闭端口
    On Error Resume Next
    scCOMM1.PortClose
    Timer_gsm.Enabled = False
    Str_pnum = ""
    Str_sca = ""
    Str_ops = ""
    Int_sq = 0
    Lng_ops = 0
End Sub

Public Function Letsend(Pnum As String, Mess As String, _
                        Optional Sca As String = "", Optional Mode As Integer = -1) As Boolean
    '发送短消息
    If GSM.send_en = True Or Int_state <> Normal Then
        Letsend = False
    Else
        Letsend = True
        GSM.send_en = True
        GSM.Mess = Mess
        GSM.Sca = Sca
        GSM.Pnum = Pnum
        GSM.Mode = Mode
    End If
End Function

Public Function StopSend()
    GSM.send_en = False
End Function

Public Function Letdel(Optional Index As Integer = 0) As Boolean
    '删除短消息
    If Int_state <> Normal Then
        Letdel = False
    End If
    If GSM.del_en Then
        Letdel = False
    ElseIf Index = 0 Or Index = Int_smindex Then
        Letdel = True
        U_sm.echo = SMgot
        GSM.del_en = True
    Else
        Letdel = False
    End If
End Function

Public Function Getsm(echo As Boolean, Rtime As String, _
                        Pnum As String, Rmess As String) As Integer
    '取接收到的短消息
    If U_sm.echo = Noerr Then
        echo = True
        Rtime = U_sm.Date
        Pnum = U_sm.Num
        Rmess = U_sm.Mess
    Else
        echo = False
    End If
    Getsm = U_sm.Index
End Function

Public Function GetPas(Code As Integer, Description As String)
    '取设备物理状态
    On Error Resume Next
    Code = Int_pas
    Select Case Code
    Case 0
        Description = "设备就绪"
    Case 1
        Description = "设备无效"
    Case 2
        Description = "设备未知"
    Case 3
        Description = "设备振铃"
    Case 4
        Description = "设备通话"
    Case 5
        Description = "设备休眠"
    Case Else
        Description = ""
    End Select
End Function

Public Function GetSOPort(Port As Integer, State As Boolean)
    '取端口号及设备状态
    Port = scCOMM1.Port
    If Int_state <> Lookfor Then
        State = True
    Else
        State = False
    End If
End Function

Public Function GetME() As Integer
    '取设备逻辑状态
    GetME = Int_state
End Function

Public Function GetWork() As Integer
    Dim Work As Integer
    '取设备工作状态
    Work = 0
    If GSM.send_en Then Work = 1
    If GSM.del_en Then Work = Work + 10
    If GSM.Write_en Then Work = Work + 100
    If GSM.hungup_en Then Work = Work + 1000
    GetWork = Work
End Function

Public Function GetOpsName() As String
    '取运营商的名称
    GetOpsName = Str_ops
End Function
'==============================================================
Private Sub Sub_gsminit()
    '数据初始化
    Int_state = Connect
    Int_pas = -1
    Int_snum = 0
    Int_sq = 0
    GSM.hungup_en = False
    GSM.send_en = False
    GSM.del_en = False
    U_sm.echo = SMgot
End Sub

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetBaudRate
Public Function GetBaudRate() As String
    GetBaudRate = scCOMM1.GetBaudRate()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetDataBits
Public Function GetDataBits() As String
    GetDataBits = scCOMM1.GetDataBits()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetFlowControl
Public Function GetFlowControl() As String
    GetFlowControl = scCOMM1.GetFlowControl()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetParity
Public Function GetParity() As String
    GetParity = scCOMM1.GetParity()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetPort
Public Function GetPort() As Long
    GetPort = scCOMM1.GetPort()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,GetStopBits
Public Function GetStopBits() As String
    GetStopBits = scCOMM1.GetStopBits()
End Function

'注意！不要删除或修改下列被注释的行！
'MappingInfo=scCOMM1,scCOMM1,-1,PortOpened
Public Function PortOpened() As Boolean
    PortOpened = scCOMM1.PortOpened()
End Function

'================================
Private Sub Fun_gsm()
    '组织ME的操作步骤,响应外界的请求
    Dim str_temp As String
    Dim int_i As Integer
    Dim int_k As Integer
    Dim int_len As Integer
    Dim bool_en As Boolean
    
    If Int_state = Lookfor Then
        Exit Sub
    End If
    
    If Int_lastorder = -1 Then
    '第一条AT指令
        Int_order = Init_me
        str_temp = Fun_makeAT(Int_order)
        Call Fun_gsm_send(str_temp)
        With Twait
         .enabel = False
         .timeup = False
         .value = 0
        End With
        Exit Sub
    End If
    '等待定时到
    If Twait.timeup = True Then
        Twait.timeup = False
        If Int_order = Send_pdu Or Int_order = Send_ctrlz Then
            str_temp = Fun_makeAT(Int_order)
            Call Fun_gsm_send(str_temp)
            Exit Sub
        End If
        If GSM.send_en = True And Int_state = Normal Then
'            int_i = Len(GSM.Pnum)
'            int_k = Len(GSM.Mess)
'            int_len = Fun_tpdulen(int_i, int_k)
            Int_order = Send_sm
            str_temp = Fun_makeAT(Int_order)
            Call Fun_gsm_send(str_temp)
        ElseIf GSM.hungup_en = True Then
            Int_order = hungup
            str_temp = Fun_makeAT(Int_order)
            Call Fun_gsm_send(str_temp)
        ElseIf GSM.del_en Then
            Int_order = Del_sm
            str_temp = Fun_makeAT(Int_order, Int_smindex)
            Call Fun_gsm_send(str_temp)
        Else
            str_temp = Fun_makeAT(Int_order, Int_smindex)
            Call Fun_gsm_send(str_temp)
        End If
    End If
    '接收定时到
    If Trece.timeup = True Then
        Trece.timeup = False
        Call Fun_gsm_rtimeup
        
        str_temp = Fun_makeAT(Int_order, Int_smindex)
        Call Fun_gsm_send(str_temp)
    End If
End Sub

Private Function Fun_makeAT(Source As ATorder, Optional Indication As Integer = 1) As String
    '组织AT指令
    Dim str_result As String
    Dim U_pdu As User_pdu
    
    On Error GoTo doerrors
    Select Case (Source)
    Case Init_me
        str_result = Con_str_at & Con_str_echo & vbCr & Con_str_at & Con_str_replong & vbCr & Con_str_at & Con_str_pas & vbCr
    Case Init_sm
        str_result = Con_str_at & Con_str_sms & Con_str_pms & vbCr
    Case Read_sim
        str_result = Con_str_at & Con_str_pin & vbCr
    Case Read_sca_num
        str_result = Con_str_at & Con_str_ops & Con_str_sca & Con_str_num & vbCr
    Case Read_sm
        str_result = Con_str_at & Con_str_read & str(Indication) & vbCr
    Case Del_sm
        str_result = Con_str_at & Con_str_del & str(Indication) & vbCr
    Case List_sm
        str_result = Con_str_at & Con_str_list & vbCr
    Case hand
        str_result = Con_str_at & Con_str_pas & Con_str_sq & vbCr
    Case hungup
        str_result = Con_str_at & Con_str_hungup & vbCr
    Case Send_sm
        str_result = Con_str_at & Con_str_send & Chr(34) & GSM.Pnum & Chr(34) & vbCr & fs_ToUniCodeChar(GSM.Mess) & Chr(0) & Chr(26)
    Case Send_pdu
'        U_pdu = fun_pdu_sm(GSM.Sca, GSM.Pnum, GSM.Mess)
'        If U_pdu.echo = True Then
'            str_result = U_pdu.pdu
'        End If
    Case Send_ctrlz
        str_result = Chr(0) & Chr(&H1A)
    Case Else
        str_result = "error"
    End Select
    Fun_makeAT = str_result
    Exit Function
    
doerrors:
        MsgBox Err.Description, vbCritical, "错误"
End Function

'==================================

'注意！不要删除或修改下列被注释的行！
'MemberInfo=7,1,2,0
Public Property Get Mode() As Integer
Attribute Mode.VB_MemberFlags = "400"
    Mode = m_Mode
End Property

Public Property Let Mode(ByVal New_Mode As Integer)
    If Ambient.UserMode = False Then Err.Raise 387
    If Ambient.UserMode Then Err.Raise 382
    m_Mode = New_Mode
    PropertyChanged "Mode"
End Property

Private Function fs_ToUniCodeChar(ByVal str As String) As String
    Dim nI As Integer
    Dim nCount As Integer
    Dim nAscw As Long
    Dim sRet As String
    Dim sTemp As String
    Dim Bytes(0 To 1023) As Byte
    Dim buf() As Byte
    nCount = LBound(Bytes)
    For nI = 1 To Len(str)
        nAscw = AscW(Mid$(str, nI, 1))
        If nAscw > 255 Or nAscw < 0 Then
            sTemp = Right$("0000" & Hex(nAscw), 4)
            Bytes(nCount) = Val("&H" & Left$(sTemp, 2))
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
            Bytes(nCount) = Val("&H" & Right$(sTemp, 2))
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
        Else
            Bytes(nCount) = 0
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
            Bytes(nCount) = nAscw
            nCount = nCount + 1
            If nCount > UBound(Bytes) Then Exit Function
        End If
    Next nI
    ReDim buf(0 To nCount - 1) As Byte
    For nI = 0 To nCount - 1
        buf(nI) = Bytes(nI)
    Next nI
    sRet = StrConv(buf, vbUnicode)
    fs_ToUniCodeChar = sRet
End Function

Private Function Fun_gsm_send(Source As String)
    '发送帧
    RaiseEvent OnComm(Send)
    scCOMM1.SendData Source
    With Trece
        .enabel = True
        .timeup = False
        .value = Con_int_rt
    End With
    Int_lastorder = Int_order
    If Int_order = Init_me Then
        Trece.value = Trece.value * 2
    ElseIf Int_order = List_sm Then
        Trece.value = Trece.value * 6
    End If
End Function

Private Function Fun_gsm_rtimeup()
    '接收超时处理
    Dim sgl_now As Single
    Dim sgl_last As Single
    
    On Error GoTo doerrors
    
    Int_snum = Int_snum + 1
    If Len(Str_rece) <> 0 Then
        scCOMM1.SendData Chr(0) & Chr(26)
    End If
    If Int_snum = Con_int_snum Then
    '重新启动设备
    '        Int_snum = 0
    '        Int_state = Connect
'        If MSComm_gsm.DSRHolding = False Then
'            RaiseEvent OnResult(Gsm_conerr)
'        Else
'            RaiseEvent OnResult(Gsm_commerr)
'        End If
'        MSComm_gsm.RTSEnable = False
'        MSComm_gsm.DTREnable = False
        scCOMM1.PortClose
'        MSComm_gsm.PortOpen = False
        '重启端口，延时2秒
        sgl_last = Time
        Do
            sgl_now = Time
            If (sgl_now - sgl_last) * 3600 * 24 >= 2 Then Exit Do
            DoEvents
        Loop
        scCOMM1.PortOpen
'        MSComm_gsm.PortOpen = True
'        MSComm_gsm.RTSEnable = True
'        MSComm_gsm.DTREnable = True
        Call Sub_gsminit
        Int_order = Init_me
    '    Str_pnum = ""
    '    Str_sca = ""
    '    Str_ops = ""
    '    Int_sq = 0
    '    Lng_ops = 0
    End If
    Exit Function
doerrors:
        MsgBox Err.Description, vbCritical, "Fun_gsm_rtimeup 错误"
End Function

Private Function Fun_gsm_rece(Source As String) As User_gsmrece
    '串口接收内容判定成帧
    Dim int_pos As Integer
    Dim int_len As Integer
    Dim str_echo As String
    
    On Error GoTo doerrors
    Fun_gsm_rece.Rflag = False
    Fun_gsm_rece.Rece = Source
    '振铃指示帧
    int_pos = InStr(1, Source, Con_str_ring)
    If int_pos <> 0 Then
        GSM.hungup_en = True
    End If
    'AT正确应答帧
    int_pos = InStr(1, Source, Con_str_ok)
    If int_pos <> 0 Then
        str_echo = Mid$(Source, 1, int_pos + 3)
        int_len = Len(Source)
        Fun_gsm_rece.Rece = Right$(Source, int_len - int_pos - 3)
        Fun_gsm_rece.echo = str_echo
        Fun_gsm_rece.Result = True
        Fun_gsm_rece.Rflag = True
        Trece.enabel = False
        Exit Function
     End If
    ' 错误帧
    int_pos = InStr(1, Source, Con_str_error)
    If int_pos <> 0 Then
        str_echo = Mid$(Source, 1, int_pos + 6)
        int_len = Len(Source)
        Fun_gsm_rece.Rece = Right$(Source, int_len - int_pos - 6)
        Fun_gsm_rece.echo = str_echo
        Fun_gsm_rece.Result = False
        Fun_gsm_rece.Rflag = True
        Trece.enabel = False
        Exit Function
    End If
    '发送提示帧
'    int_pos = InStr(1, Source, Con_str_send_rev)
'    If int_pos <> 0 Then
'        str_echo = Mid$(Source, 1, int_pos + 1)
'        int_len = Len(Source)
'        Fun_gsm_rece.Rece = Right$(Source, int_len - int_pos - 1)
'        Fun_gsm_rece.echo = str_echo
'        Fun_gsm_rece.Result = True
'        Fun_gsm_rece.Rflag = True
'        Trece.enabel = False
'        Exit Function
'    End If
    'int_pos = InStr(1, Source, Con_str_nmi_rev)
    'If int_pos <> 0 Then
    '    int_pos = InStr(int_pos, Source, vbCrLf)
    '    If int_pos <> 0 Then
    '        str_echo = Mid$(Source, 1, int_pos + 1)
    '        int_len = Len(Source)
    '        Fun_gsm_rece.Rece = Right$(Source, int_len - int_pos - 1)
    '        Fun_gsm_rece.echo = str_echo
    '        Fun_gsm_rece.Result = True
    '        Fun_gsm_rece.Rflag = True
    '        Trece.enabel = False
    '        Int_lastorder = Nmi
    '        Exit Function
    '    End If
    'End If
    Exit Function
doerrors:
        MsgBox Err.Description, vbCritical, "错误"
End Function