VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TC35"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim v_ErrMsg          As String '當前的錯誤信息
Dim v_IsInit          As Boolean   '是否已經初始化
Dim v_MSComm          As MSCommLib.MSComm '所用的串口對像
Dim v_ServiceTelphone As String '短信服務器中心呈碼


'以下三個變量用于控制異步事件
Dim v_bExit         As Boolean
Dim v_StartTimes    As Long '執行執行的開始時間
Dim v_Msg           As String '發送的SM內容
Dim v_Telphone      As String '發送的電話號碼
Dim v_LastHappenTime   As Date '最后嘗試的時間

Dim v_Para1          As String '系統參數
Dim v_Para2          As String '系統參數
Dim v_Para3          As String '系統參數
Dim v_Key            As String '系統參數

Const MAXSENDTIME = 9000  '發送一條SM的最長時間9秒
Const SUFX = "000800"

Public Enum EventStatus '定義事件狀態
      STATUS_SENDING = 1 '正在發送
      STATUS_GETTING = 2 '正在讀取數據
      STATUS_SENDED = 2  '發送完成
      STATUS_OK = 3    '發送OK
      STATUS_UNKNOWS = 0 '狀態未知
      STATUS_ERROR = 4 '發送出錯
      STATUS_OUTTIME = 5 '獲取超時
      STATUS_BREAK = 6 '獲取超時
End Enum

Public Event ChangeStatus(ByVal Status As EventStatus) '定義事件

'取得短信內容
Public Property Get Msg() As String
   Msg = v_Msg
End Property


'設置發送的短信內容
Public Property Let Msg(ByVal newValue As String)
    v_Msg = newValue
End Property


'取得短信內容
Public Property Get Key() As String
   Key = v_Key
End Property


'設置發送的短信內容
Public Property Let Key(ByVal newValue As String)
    v_Key = newValue
End Property


'取得接收的電話號碼
Public Property Get Telphone() As String
   Telphone = v_Telphone
End Property


'設置短信發送的接收號碼
Public Property Let Telphone(ByVal newValue As String)
    v_Telphone = newValue
End Property


'當前操作的錯誤信息
Public Property Get LastHappenTime() As Date
    LastHappenTime = v_LastHappenTime
End Property

'當前相關的參數1值
Public Property Get Para1() As String
    Para1 = v_Para1
End Property

'設置操作的參數1
Public Property Let Para1(ByVal newValue As String)
    v_Para1 = newValue
End Property


'取得當前的參數2值
Public Property Get Para2() As String
    Para2 = v_Para2
End Property

'當前操作的Para2值
Public Property Let Para2(ByVal newValue As String)
    v_Para2 = newValue
End Property


'當前操作的錯誤信息
Public Property Get Para3() As String
    Para3 = v_Para3
End Property


'當前操作的錯誤信息
Public Property Let Para3(ByVal newValue As String)
    v_Para3 = newValue
End Property



'當前操作的錯誤信息
Public Property Get ErrMsg() As String
    ErrMsg = v_ErrMsg
End Property

'初始化是否成功
Public Property Get IsInit() As Boolean
    IsInit = v_IsInit
End Property

'當前發送SM的服務號碼
Public Property Get ServiceTelphone() As String
    ServiceTelphone = v_ServiceTelphone
End Property


'設置發送SM的服務號碼
Public Property Let ServiceTelphone(newValue As String)
   Dim s As String
   s = checkTelphone(newValue, "發送短信服務中心") '檢查服務中心號碼是否正確
   If s <> "" Then
      v_ServiceTelphone = s
   End If
End Property


'初始化串口
'入口參數
'　mscomm 通訊對象
'  commPort COM端口號
' ServerCenter 發送SM的服務號碼
'返回：TRUR |false
'  若為 false ,v_ErrMsg 會有詳細的錯誤描述
Public Function Init(MSComm As MSComm, _
                     Optional ByVal CommPort As Integer = 1, _
                     Optional ByVal ServerCenter As String = "13800755500" _
                     ) As Boolean
   On Error GoTo laberr
   Dim ts As String
   
   v_IsInit = False
   
   v_ServiceTelphone = checkTelphone(ServerCenter, "發送短信服務中心") '檢查服務中心號碼是否正確
   If v_ServiceTelphone = "" Then Exit Function
   
   Set v_MSComm = MSComm
   With MSComm
        If .PortOpen = True Then .PortOpen = False '已經找開端口，則關閉它
        .CommPort = CommPort '寫端口號
        If .PortOpen = False Then .PortOpen = True '打開端口
        .Settings = "9600,n,8,1" '設置相關值
        If Output("ATE0" & vbCr, False, True, 1000) = True Then '不需要T35返回命令數值
            v_IsInit = Output("AT+CMGF=0" & vbCr, False, True, 1000) '設置發送短信的格式為PDU
        End If
   End With
   Init = v_IsInit
   Exit Function
laberr:
   v_ErrMsg = "初始化出錯,錯誤信息為" & Err.Description
   Debug.Print v_ErrMsg
   Init = False
End Function

'將信息內容轉換成USC2編碼
Private Function toUSC2(ByVal s As String) As String
  Dim i As Integer
  Dim rs As String
  Dim n As Integer
  Dim tn As Integer
  rs = ""
  For i = 1 To Len(s)
      n = AscW(Mid(s, i, 1)) '取得USC2值
      tn = Abs(n)
      If tn >= 16 And tn <= 127 Then '若值d 16－127之間，則只需要在編碼前面加入2個0
            rs = rs & "00"
      ElseIf tn >= 1 And tn < 16 Then '在1-15之間，需要前面加入3個0，如回車的編碼為 000D
           rs = rs & "000"
      End If
      rs = rs & Hex(n)   ' Mid(s, i, 1) & "=" & Hex(n) & ","
  Next i
  toUSC2 = rs
End Function

'將電話號碼移位處理
Private Function toTelphone(ByVal Mobile As String) As String
     Dim l As String
     Dim r As String
     Dim rs As String
     Dim i As Integer
     Dim n As Integer
     rs = ""
     n = Len(Mobile)
     For i = 1 To n Step 2
        l = Mid(Mobile, i, 1)
        If i = n Then '若是最后一位,則后面加入F
           r = "F"
        Else
           r = Mid(Mobile, i + 1, 1)
        End If
        rs = rs & r & l '高低位互換
     Next i
     toTelphone = rs
End Function

'發送SM
' 入口參數：
'   mobile 手機號碼/市話通號碼(必須加入長度區號)
'   Msg SM內容不能70個字符
'返回 TRUR | false
'  若為False, v_ErrMsg表示錯誤信息
Public Function Send() As Boolean
     Dim pmsg As String
     Dim length As Integer
     Dim at As String
     Dim pdu As String
     Dim Mobile As String
     
     Dim CenterPart As String
     
     Dim TPPart As String
     Dim SMPart As String
     
     Send = False
     
     If v_IsInit = False Then v_ErrMsg = "通訊串口未初始化或者初始化不成功": Exit Function
     
     length = Len(v_Msg) * 2
     If length > 140 Then
        v_ErrMsg = "發送的短信內容不能超過70個字符。"
        Exit Function
     End If
     
     '檢查手機號碼,若不成功，則會返回空字符串值
     Mobile = checkTelphone(v_Telphone) '檢查接收的手機或者市話通號碼是否正確
     If Mobile = "" Then Exit Function
     
     
     pmsg = toUSC2(v_Msg) '將SM轉換成USC2編碼
     
     CenterPart = toTelphone(v_ServiceTelphone) '將其轉換成電話要求的編碼
     CenterPart = toHex(Len(CenterPart) / 2 + 1, 2) & "91" & CenterPart '生成頭部信息
   
     TPPart = "1100" & toHex(Len(Mobile), 2) & "91" & toTelphone(Mobile)
     '短信信息部分
     SMPart = SUFX & IIf(length < 16, "0", "") & Hex(length) & pmsg
     
     '組成成AT發送SM的命令串，并等待正確返回"> "，超時是1秒
     at = "AT+CMGS=" & ((Len(TPPart) + Len(SMPart)) \ 2) & vbCr
     If Output(at, False, True, 1000, "> ") = True Then
           '正確接受到“> ",則向串口寫入相關的信息內容
            at = CenterPart & TPPart & SMPart & Chr$(26)
            Send = Output(at, True)
     End If
End Function

Public Sub Break()
      v_bExit = True
End Sub

'向串口MSCOMM輸出一個命令或者信息
'入口參數
'  msg 需要輸出的信息串
'  isCheckResult 是否需要檢查返回的結果(TRUe需要,False不需要)
'  nTimeout 等待結果超時的毫秒數(只對isCheckResult=true有效)
'　okRetMsg　返回正確結果時含的字符特征串，如"OK"
'　errRetMsg 返回錯誤結果時含的字符特征串，如"ERROR"
'返回值：truE \ FALSE
' 若為fasle ,v_ErrMsg表示出錯的信息詳情
Public Function Output(ByVal Msg As String, _
                       Optional ByVal isChangeStatusEvent As Boolean = False, _
                       Optional ByVal isCheckResult As Boolean = True, _
                       Optional ByVal nTimeout As Long = MAXSENDTIME, _
                       Optional ByVal okRetMsg As String = "OK", _
                       Optional ByVal errRetMsg As String = "ERROR" _
                      ) As Boolean
    Dim i As Integer
    Dim n As Integer
    Dim rs As String
    Dim StartTime As Long
    Dim isChangedEvents As Boolean
    'If v_IsInit = False Then v_ErrMsg = "通訊串口未初始化或者初始化不成功": Exit Function
    
    isChangedEvents = False
    
    With v_MSComm
        '清輸入內容以及輸出內容
        While .InBufferCount > 0
              DoEvents
              rs = .Input
        Wend
        '清除輸出、輸入Buffer
        .InBufferCount = 0
        .OutBufferCount = 0
        
        .Output = Msg
        While .OutBufferCount > 0 '發送信息,直到完成
              DoEvents
              If isChangedEvents = False And isChangeStatusEvent = True Then
                 RaiseEvent ChangeStatus(STATUS_SENDING)
                 isChangedEvents = True
              End If
        Wend
        
        If isChangeStatusEvent Then
            RaiseEvent ChangeStatus(STATUS_SENDED)
        End If
         
       
       isChangedEvents = False
       If isCheckResult = True Then '需要處理返回結果
            rs = ""
            StartTime = timeGetTime
            Do
               
               DoEvents
               
               If v_bExit Then
                  Output = False
                  v_ErrMsg = "用戶中斷"
                  If isChangeStatusEvent = True Then
                        RaiseEvent ChangeStatus(STATUS_BREAK)
                  End If
                  Exit Function
               End If
               
               rs = rs & .Input
               If isChangeStatusEvent = True And rs <> "" And isChangedEvents = False Then
                    RaiseEvent ChangeStatus(STATUS_GETTING)
                    isChangedEvents = True
               End If
               
               If InStr(1, rs, okRetMsg) > 0 Then '返回的結果中含有正確代碼特征
                  v_ErrMsg = "發送成功！"
                  Output = True '處理正確
                  If isChangeStatusEvent Then
                       RaiseEvent ChangeStatus(STATUS_OK)
                  End If
                  v_LastHappenTime = Time
                  Exit Function
               ElseIf InStr(1, rs, errRetMsg) > 0 Then '返回的結果中含有錯誤代碼特征
                  v_ErrMsg = "發送失敗！"
                  v_LastHappenTime = Time
                  If isChangeStatusEvent Then
                     RaiseEvent ChangeStatus(STATUS_ERROR)
                  End If
                  Output = False '處理失敗
                  Exit Function
               End If
            Loop Until StartTime + nTimeout < timeGetTime '直到沒超時
            v_LastHappenTime = Time
            v_ErrMsg = "發送超時"
            If isChangeStatusEvent Then
               RaiseEvent ChangeStatus(STATUS_OUTTIME)
            End If
            Output = False
      Else
         v_LastHappenTime = Time
         v_ErrMsg = "發送成功！"
         If isChangeStatusEvent Then
            RaiseEvent ChangeStatus(STATUS_OK)
         End If
         Output = True
      End If
   End With
End Function

'將n轉換成Hex格式,nbits表示結果的位數
Private Function toHex(ByVal n As Integer, Optional ByVal nBits As Integer = 2) As String
   Dim s As String
   Dim i As Integer
   s = Hex(n)
   For i = Len(s) + 1 To nBits
      s = "0" & s
   Next i
   toHex = s
End Function


'檢查手機號碼是否正確,若正確返回加入了國別或者接受者信息的號碼,否則為空字符串值，此時v_ErrMsg表示錯誤信息
Private Function checkTelphone(ByVal Mobile As String, _
                          Optional ByVal Name As String = "接收短信的手機/市話通") As String
   
   Dim c As String
   Dim n As Integer
   Dim i As Integer
   
   checkTelphone = ""
   n = Len(Mobile)
   If n < 7 Then
        v_ErrMsg = Name & "號碼長度必須大于或等于7。"
   Else
          If Left(Mobile, 2) = "13" Then
                   If n <> 11 Then
                       v_ErrMsg = Name & "(當前為手機)號碼[" & Mobile & "]必須由11位數字組成."
                       Exit Function
                   Else
                       For i = 1 To 11
                          c = Mid(Mobile, i, 1)
                          If c < "0" Or c > "9" Then
                             v_ErrMsg = Name & "(當前為手機)號碼[" & Mobile & "]必須由11位數字組成."
                             Exit Function
                          End If
                       Next i
                       
                       v_ErrMsg = ""
                       checkTelphone = "86" & Mobile
                   End If
           Else
                  For i = 1 To n
                      c = Mid(Mobile, i, 1)
                      If c < "0" Or c > "9" Then
                         v_ErrMsg = Name & "號碼[" & Mobile & "]必須由11或12位數字組成."
                         Exit Function
                      End If
                   Next i
                   v_ErrMsg = ""
                   checkTelphone = Mobile
           End If
   End If
End Function

'對象初始化
Private Sub Class_Initialize()
    v_IsInit = False
    v_ErrMsg = "通訊串口未初始化"
    v_ServiceTelphone = ""
    v_Para1 = ""
    v_Para2 = ""
    v_Para3 = ""
    v_Key = ""
    
    v_bExit = False
    '異步初始化
    Call Destory
    Set v_MSComm = Nothing

End Sub

Private Sub Class_Terminate()
    Destory
End Sub


Public Sub Destory()
    On Error Resume Next
    With v_MSComm
            If .PortOpen = True Then .PortOpen = False
    End With
End Sub