commsms.cls

通过西门子模块收发短信

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SMS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Option Compare Text
Private blnExceed As Boolean '超时标志
Private strContent As String  '定义PDU码最终解析得到的内容
Private strSMSCode As String '原始PDU码
Private strSMSLen As String '原始PDU码长度
Private I As Long, J As Long '常用循环变量
Private Index As Long '短信位置
Private strSMSComin As String '串口读入数据
Private MyComm As MSComm '串口操作对象
Private sglBasetime As Single '基准时间
Private InSMSList As String '读入的原始短信息序列
Private DealString As String '原始短信息
Private UseComList As String '初始化后的串口对象序列

Public Type ReadInfo '定义读入信息结构
  strHNB As String
  strCon As String
End Type

'读取手机模块信息
Public Function ReadSMS(ReadList() As ReadInfo) As String

Dim CountMe As Long
Dim strRemainPart As String
Dim longLOCATION As Long '定义信息特征字位置
Dim strPDUHANDNUM As String  '定义手机号码对应pdu码
Dim strHandNum As String     '定义手机号码
Dim strSender As String    '定义发送者
Dim strUType As String '定义用户类型
Dim strSMSType As String  '定义读入SMS类型
Dim strCodeSys As String   '定义编码格式
Dim strLenthCode As String '定义长度码
Dim longCodeNum As Long    '定义文字码
Dim longCodeLenth As Long  '定义文字码长度
Dim strPDUContent As String '定义文字pdu码
Dim strUnicode As String   '定义累加中的unicode码
On Error GoTo ErrorDeal

CountMe = 0
MyComm.Output = "AT+CMGL=4" & Chr(13)

Call WaitA

If blnExceed = True Then
   ReadSMS = "ERROR/超时错误"
   Exit Function
End If

InSMSList = ""

If InStr(strSMSComin, "CMGL:") = 0 Then
   strSMSComin = ""
   Exit Function
Else
   Do '逐个获取原始短信息位置
   DoEvents
      DealString = GetBetweenPart(strSMSComin, "+", ",,")
      
      If DealString <> "" Then
         InSMSList = InSMSList + GetBetweenPart(DealString, "CMGL: ", ",") + ","
         strSMSComin = GetRightPart(strSMSComin, ",,")
      Else
         Exit Do
      End If
   Loop Until InStr(strSMSComin, "CMGL") = 0
   strSMSComin = ""
End If

If InStr(InSMSList, ",") = 0 Then '如果没有原始短信息则退出
   Exit Function
End If

Do
DoEvents
   CountMe = CountMe + 1
   Index = GetLeftPart(InSMSList, ",")
   MyComm.Output = "AT+CMGR=" & Index & Chr(13)
   InSMSList = GetRightPart(InSMSList, ",")
   Call WaitA
   If InStr(strSMSComin, "ERROR") > 0 Or blnExceed = True Then '判断出错
      strSMSComin = ""
      GoTo Escape
   ElseIf InStr(strSMSComin, "0,,0") > 0 Then
      strSMSComin = ""
      GoTo Escape
   ElseIf InStr(strSMSComin, "0D9168") > 0 Then '判断为个人信息
      longLOCATION = InStr(strSMSComin, "0D9168")
      strSMSType = "用户"
   ElseIf InStr(strSMSComin, "0DA168") > 0 Then
      longLOCATION = InStr(strSMSComin, "0DA168")
      strSMSType = "用户"
   ElseIf InStr(strSMSComin, "0B91") Then
      longLOCATION = InStr(strSMSComin, "0B91")
      strSMSType = "联通"
   ElseIf InStr(strSMSComin, "0BA1") > 0 Then
      longLOCATION = InStr(strSMSComin, "0BA1")
      strSMSType = "外地"
   ElseIf InStr(strSMSComin, "0B91") > 0 Then
      longLOCATION = InStr(strSMSComin, "0B91")
      strSMSType = "外地"
   ElseIf InStr(strSMSComin, "A12185F0") > 0 Then  '判断为秘书台信息
      longLOCATION = InStr(strSMSComin, "A12185F0")
      strSMSType = "秘书台"
   ElseIf InStr(strSMSComin, "A1218500") > 0 Then
      longLOCATION = InStr(strSMSComin, "A1218500")
      strSMSType = "上海秘书台"
   ElseIf InStr(strSMSComin, "912185F0") > 0 Then '判断为秘书台信息
      longLOCATION = InStr(strSMSComin, "912185F0")
      strSMSType = "秘书台"
   ElseIf InStr(strSMSComin, "0991") > 0 And InStr(strSMSComin, "2185F0") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "2185F0")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "0791201552F8") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "0791201552F8")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "089120155208") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "089120155208")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "05A15099F8") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "05A15099F8")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "05A12185F1") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "05A12185F1")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "05912185F1") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "05912185F1")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "05BB2185F0") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "05BB2185F0")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "1091218510") > 0 Then
      strRemainPart = Right(GetRightPart(strSMSComin, "1091218510"), Len(GetRightPart(strSMSComin, "1091218510")) - 10)
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "08A1") > 0 And InStr(strSMSComin, "2185") > 0 And InStr(strSMSComin, "2185") - InStr(strSMSComin, "08A1") = 8 Then
      strRemainPart = GetRightPart(strSMSComin, "2185")
      strSMSType = "外地秘书台"
   ElseIf InStr(strSMSComin, "04A17852") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "04A17852")
      strSMSType = "蔚蓝联通"
   ElseIf InStr(strSMSComin, "0AA17096100111") > 0 Then
      strRemainPart = GetRightPart(strSMSComin, "0AA17096100111")
      strSMSType = "东莞移动"
   Else
      Call DelSMS(Index)
      GoTo Escape
   End If
  
   If InStr(strSMSType, "秘书台") > 0 Then '通过PDU码判断短信中的基本信息，手机号码/时间
      strHandNum = "12580"
   ElseIf strSMSType = "蔚蓝联通" Then
      strHandNum = "8725"
   ElseIf strSMSType = "东莞移动" Then
      strHandNum = "0769011011"
   ElseIf strSMSType = "联通" Or strSMSType = "外地" Then
      strPDUHANDNUM = Right(Left(strSMSComin, longLOCATION + 15), 12)
      strHandNum = Right(Left(strPDUHANDNUM, 2), 1) + Left(strPDUHANDNUM, 1) + Right(Left(strPDUHANDNUM, 4), 1) + Right(Left(strPDUHANDNUM, 3), 1) + Right(Left(strPDUHANDNUM, 6), 1) + Right(Left(strPDUHANDNUM, 5), 1) + Right(Left(strPDUHANDNUM, 8), 1) + Right(Left(strPDUHANDNUM, 7), 1) + Right(Left(strPDUHANDNUM, 10), 1) + Right(Left(strPDUHANDNUM, 9), 1) + Right(Left(strPDUHANDNUM, 12), 1)
   Else
      strPDUHANDNUM = Right(Left(strSMSComin, longLOCATION + 17), 12)
      strHandNum = Right(Left(strPDUHANDNUM, 2), 1) + Left(strPDUHANDNUM, 1) + Right(Left(strPDUHANDNUM, 4), 1) + Right(Left(strPDUHANDNUM, 3), 1) + Right(Left(strPDUHANDNUM, 6), 1) + Right(Left(strPDUHANDNUM, 5), 1) + Right(Left(strPDUHANDNUM, 8), 1) + Right(Left(strPDUHANDNUM, 7), 1) + Right(Left(strPDUHANDNUM, 10), 1) + Right(Left(strPDUHANDNUM, 9), 1) + Right(Left(strPDUHANDNUM, 12), 1)
   End If
   
   If strSMSType = "秘书台" Then '获取PDU编码格式
      strCodeSys = Right(Left(strSMSComin, longLOCATION + 11), 2)
   ElseIf strSMSType = "上海秘书台" Then
      strCodeSys = Right(Left(strSMSComin, longLOCATION + 9), 2)
   ElseIf strSMSType = "外地秘书台" Or strSMSType = "蔚蓝联通" Or strSMSType = "东莞移动" Then
      strCodeSys = Right(Left(strRemainPart, 4), 2)
   ElseIf strSMSType = "联通" Or strSMSType = "外地" Then
      strCodeSys = Right(Left(strSMSComin, longLOCATION + 19), 2)
   Else
      strCodeSys = Right(Left(strSMSComin, longLOCATION + 21), 2)
   End If
  
   If strCodeSys = "00" Or strCodeSys = "02" Then '判断编码格式并获取相应信息
      Call ChangeMode(Index) '英文编码，改变读写模式为文本方式
   ElseIf strCodeSys = "08" Or strCodeSys = "0A" Or strCodeSys = "19" Then
      If strSMSType = "用户" Then
         strLenthCode = Right(Left(strSMSComin, longLOCATION + 37), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strSMSComin, longLOCATION + 37 + 2 * longCodeLenth), 2 * longCodeLenth)
      ElseIf strSMSType = "联通" Or strSMSType = "外地" Then
         strLenthCode = Right(Left(strSMSComin, longLOCATION + 35), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strSMSComin, longLOCATION + 35 + 2 * longCodeLenth), 2 * longCodeLenth)
      ElseIf strSMSType = "秘书台" Then '获取UNICODE码长度信息及文字内容UNICODE码
         strLenthCode = Right(Left(strSMSComin, longLOCATION + 27), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strSMSComin, longLOCATION + 27 + 2 * longCodeLenth), 2 * longCodeLenth)
      ElseIf strSMSType = "上海秘书台" Then
         strLenthCode = Right(Left(strSMSComin, longLOCATION + 25), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strSMSComin, longLOCATION + 27 + 2 * longCodeLenth), 2 * longCodeLenth)
      ElseIf strSMSType = "外地秘书台" Or strSMSType = "蔚蓝联通" Or strSMSType = "东莞移动" Then
         strLenthCode = Right(Left(strRemainPart, 20), 2)
         longCodeLenth = Chex(Left(strLenthCode, 1)) * 16 + Chex(Right(strLenthCode, 1))
         strPDUContent = Right(Left(strRemainPart, 20 + 2 * longCodeLenth), 2 * longCodeLenth)
      End If
       
      strContent = ""
       
      For I = 1 To longCodeLenth / 2 '转化UNICODE码为汉字
          strUnicode = Left(strPDUContent, 4)
          longCodeNum = Chex(Left(strUnicode, 1)) * 16 * 16 * 16 + Chex(Right(Left(strUnicode, 2), 1)) * 16 * 16 + Chex(Right(Left(strUnicode, 3), 1)) * 16 + Chex(Right(strUnicode, 1))
          strContent = strContent + ChrW(longCodeNum)
          strPDUContent = Right(strPDUContent, Len(strPDUContent) - 4)
      Next I
   Else
      Call DelSMS(Index)
      GoTo Escape
   End If
    
   For J = 1 To 50
      If ReadList(J).strHNB = "" Then   '写入读入sms清单底部
         ReadList(J).strHNB = strHandNum
         ReadList(J).strCon = strContent
         Exit For
      End If
   Next J
   Call DelSMS(Index)
Escape:
  
Loop Until InSMSList = "" Or CountMe >= 50

ReadSMS = "OK/" & (J - 1)

Exit Function

ErrorDeal:

Call DelSMS(Index)
strSMSComin = ""
ReadSMS = "ERROR/" + Err.Description
  
End Function

Private Function Chex(ByVal vhex As String) As Long '16-10部分转换函数

On Error GoTo ErrorDeal

If vhex = "A" Then
   Chex = 10
ElseIf vhex = "B" Then
   Chex = 11
ElseIf vhex = "C" Then
   Chex = 12
ElseIf vhex = "D" Then
   Chex = 13
ElseIf vhex = "E" Then
   Chex = 14
ElseIf vhex = "F" Then
   Chex = 15
Else
   Chex = vhex
End If

Exit Function

ErrorDeal:

Chex = 0

End Function

Private Sub DelSMS(I As Long) '删除短信

strSMSComin = ""
MyComm.Output = "AT+CMGD=" & I & Chr(13)
Call WaitA
strSMSComin = ""
  
End Sub

Private Sub ChangeMode(I As Long)
Dim strINT As String

blnExceed = False
strSMSComin = ""

MyComm.Output = "AT+CMGF=1" & Chr(13) '更改进入文本模式
Call WaitA
If blnExceed = True Or InStr(strSMSComin, "ERROR") > 0 Then
   Exit Sub
End If

strSMSComin = ""
MyComm.Output = "AT+CMGR=" & I & Chr(13) '读取文本
Call WaitA
If blnExceed = True Or InStr(strSMSComin, "ERROR") > 0 Then
   Exit Sub
End If

strINT = Right(strSMSComin, Len(strSMSComin) - InStr(strSMSComin, Chr(34) & Chr(13)) - 2)
strContent = Left(strINT, Len(strINT) - 8)
strSMSComin = ""
MyComm.Output = "AT+CMGF=0" & Chr(13) '返回PDU模式
Call WaitA
strSMSComin = ""

End Sub

Public Function SendSMS(PhoneNum As String, SendInfo As String) As String '发送信息函数
On Error GoTo ErrorDeal

blnExceed = False
strSMSComin = ""

Call SMSDeal(PhoneNum, SendInfo)  '将内容编为PDU码
MyComm.Output = "AT+CMGS=" + strSMSLen & Chr(13) '输入字节数
sglBasetime = Timer
Do                                             '等待
  DoEvents
  strSMSComin = MyComm.Input
Loop Until InStr(strSMSComin, ">") > 0 Or InStr(strSMSComin, "ERROR") > 0 Or Timer > sglBasetime + 2

If InStr(strSMSComin, "ERROR") > 0 Then
   strSMSComin = ""
   SendSMS = "ERROR/发送失败"
   Exit Function
ElseIf Timer > sglBasetime + 2 Then  '如果错误,退出
   strSMSComin = ""