短信PDU编码类,可以用COMM连MODEM可以方便的发短信.

编码 网上有很多利用COM口连接手机,利用手机MODEM,使用AT指令发送短信，介绍PDU编码的原理很多，写一个现成的类出来，给有需要的人参考和使用。SMSPDUClass.clsOption Explicit'保持属性值的局部变量Private mvarSMSCLen As Integer '局部复制Private mvarSMSCType As String '局部复制Private mvarSMSC As String '局部复制Private mvarMsgHead As Integer '局部复制Private mvarTPMR As Integer '局部复制Private mvarDestPhoneNumLen As Integer '局部复制Private mvarDestPhoneNumType As String '局部复制Private mvarDestPhoneNum As String '局部复制Private mvarTPPID As Integer '局部复制Private mvarTPDSC As Integer '局部复制Private mvarTPVP As Integer '局部复制Private mvarMSGLen As Integer '局部复制Private mvarMSGContent As String '局部复制Private mvarPDULen As Integer '局部复制Private mvarPDU As String '局部复制'要引发该事件，请遵循下列语法使用 RaiseEvent:'RaiseEvent ValidResult[(arg1, arg2, ... , argn)]Public Event ValidResult(ByVal ErrorCode As Integer, ByVal ErrorString As String)Public Function genPDU(Optional ByVal SMSContent As String, _ Optional ByVal DestNo As String, _ Optional ByVal ServiceNo As String) As String'mvarSMSCLen = 0'mvarSMSCType = ""'mvarSMSC = ""'mvarMsgHead = 11'mvarTPMR = 0'mvarDestPhoneNumLen = 0'mvarDestPhoneNumType = ""'mvarDestPhoneNum = ""'mvarTPPID = 0'mvarTPDSC = 8'mvarTPVP = 0'mvarMSGLen = 0'mvarMSGContent = ""'mvarPDULen = 0'mvarPDU = "" If Len(SMSContent) > 0 Then mvarMSGContent = SMSContent End If If Len(DestNo) > 0 Then mvarDestPhoneNum = DestNo End If If Len(ServiceNo) > 0 Then mvarSMSC = ServiceNo If Len(mvarSMSC) > 14 Then RaiseEvent ValidResult(7, "SMSC Error!") mvarSMSC = "[phone]" End If If Len(mvarSMSC) RaiseEvent ValidResult(7, "SMSC Error!") mvarSMSC = "[phone]" End If mvarSMSC = "+86" & Right(mvarSMSC, 11) End If If Len(mvarDestPhoneNum) = 0 Then genPDU = "" RaiseEvent ValidResult(3, "DestPhoneNumber is null!") Exit Function End If If mvarTPDSC 0 And mvarTPDSC 8 Then genPDU = "" RaiseEvent ValidResult(5, "TP-DCS Error!") Exit Function End If Dim ServiceNumPDU As String Dim DestPhoneNumPDU As String ServiceNumPDU = mvarSMSC DestPhoneNumPDU = mvarDestPhoneNum' msg.DestPhoneNumType 被叫号码类型。有+86时候为"91"，否则为"81" If Len(mvarSMSC) > 0 Then FormatPhoneNum ServiceNumPDU, mvarSMSCType mvarSMSCLen = Len(ServiceNumPDU & mvarSMSCType) / 2 '短信息中心地址长度。（短信息中心号码类型 + 短信息中心号码长度 /2 的十六进制表示） End If mvarDestPhoneNumLen = FormatPhoneNum(DestPhoneNumPDU, mvarDestPhoneNumType) ''被叫号码长度。被叫号码长度的十六进制表示。' If Len(mvarMSGContent) > 70 Then mvarMSGContent = Left(mvarMSGContent, 70) End If ' mvarMSGLen = Len(mvarMSGContent) Dim SMSText As String SMSText = mvarMSGContent ' SMSText = GB2Unicode(SMSText) '把汉字符转化为UNICODE的HEX编码字符串'' mvarMSGLen = Len(SMSText) \ 2 If Len(mvarSMSC) = 0 Then mvarSMSCLen = 0 mvarPDU = Int2HexStr(mvarSMSCLen) & Int2HexStr(mvarMsgHead) & Int2HexStr(mvarTPMR) & Int2HexStr(mvarDestPhoneNumLen) & mvarDestPhoneNumType & DestPhoneNumPDU & _ Int2HexStr(mvarTPPID) & Int2HexStr(mvarTPDSC) & Int2HexStr(mvarTPVP) & Int2HexStr(mvarMSGLen) & SMSText mvarPDULen = Len(mvarPDU) / 2 - 1 Else mvarPDU = Int2HexStr(mvarSMSCLen) & mvarSMSCType & ServiceNumPDU & Int2HexStr(mvarMsgHead) & Int2HexStr(mvarTPMR) & Int2HexStr(mvarDestPhoneNumLen) & mvarDestPhoneNumType & DestPhoneNumPDU & _ Int2HexStr(mvarTPPID) & Int2HexStr(mvarTPDSC) & Int2HexStr(mvarTPVP) & Int2HexStr(mvarMSGLen) & SMSText mvarPDULen = Len(mvarPDU) / 2 - 9 'PDU字符串长度 End If genPDU = mvarPDU End Function'Public Property Let PDU(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.PDU = 5' mvarPDU = vData'End PropertyPublic Property Get PDU() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.PDU Call genPDU PDU = mvarPDUEnd Property'Public Property Let PDULen(ByVal vData As Integer)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.PDULen = 5' mvarPDULen = vData'End PropertyPublic Property Get PDULen() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.PDULen PDULen = mvarPDULenEnd PropertyPublic Property Let MSGContent(ByVal vData As String)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.MSGContent = 5 mvarMSGContent = vData mvarMSGLen = Len(vData) * 2 End PropertyPublic Property Get MSGContent() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.MSGContent MSGContent = mvarMSGContentEnd Property'Public Property Let MSGLen(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.MSGLen = 5' mvarMSGLen = vData'End PropertyPublic Property Get MSGLen() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.MSGLen MSGLen = mvarMSGLenEnd PropertyPublic Property Let TPVP(ByVal vData As Integer)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.TPVP = 5 If vData >= 0 And vData mvarTPVP = vData Else RaiseEvent ValidResult(6, "TP-VP Error!") End IfEnd PropertyPublic Property Get TPVP() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.TPVP TPVP = mvarTPVPEnd PropertyPublic Property Let TPDCS(ByVal vData As Integer)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.TPDSC = 5 If vData >= 0 And vData mvarTPDSC = vData Else RaiseEvent ValidResult(5, "TP-DCS Error!") End IfEnd PropertyPublic Property Get TPDCS() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.TPDSC TPDCS = mvarTPDSCEnd PropertyPublic Property Let TPPID(ByVal vData As Integer)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.TPPID = 5 If vData >= 0 And vData mvarTPPID = vData Else RaiseEvent ValidResult(4, "TP-PID Error!") End IfEnd PropertyPublic Property Get TPPID() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.TPPID TPPID = mvarTPPIDEnd PropertyPublic Property Let DestPhoneNum(ByVal vData As String)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.DestPhoneNum = 5 If Len(vData) = 0 Then RaiseEvent ValidResult(3, "DestPhoneNumber is null!") Else mvarDestPhoneNum = vData mvarDestPhoneNumLen = FormatPhoneNum(vData, mvarDestPhoneNumType) End IfEnd PropertyPublic Property Get DestPhoneNum() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.DestPhoneNum DestPhoneNum = mvarDestPhoneNumEnd Property'Public Property Let DestPhoneNumType(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.DestPhoneNumType = 5' mvarDestPhoneNumType = vData'End Property''Public Property Get DestPhoneNumType() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.DestPhoneNumType If Len(mvarDestPhoneNum) = 0 Then mvarDestPhoneNumType = "FF" Else Dim str As String str = mvarDestPhoneNum FormatPhoneNum str, mvarDestPhoneNumType End If DestPhoneNumType = mvarDestPhoneNumTypeEnd Property'Public Property Let DestPhoneNumLen(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.DestPhoneNumLen = 5' mvarDestPhoneNumLen = vData'End Property''Public Property Get DestPhoneNumLen() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.DestPhoneNumLen If Len(DestPhoneNum) = 0 Then mvarDestPhoneNumLen = 0 Else Dim str As String str = DestPhoneNum mvarDestPhoneNumLen = FormatPhoneNum(str, mvarDestPhoneNumType) End If DestPhoneNumLen = mvarDestPhoneNumLenEnd PropertyPublic Property Let TPMR(ByVal vData As Integer)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.TPMR = 5 If vData >= 0 And vData mvarTPMR = vData Else RaiseEvent ValidResult(2, "TP-MR Error!") End IfEnd PropertyPublic Property Get TPMR() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.TPMR TPMR = mvarTPMREnd PropertyPublic Property Let MsgHead(ByVal vData As Integer)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.MsgHead = 5 If vData >= 0 And vData mvarMsgHead = vData Else RaiseEvent ValidResult(1, "MsgHead Error!") End IfEnd PropertyPublic Property Get MsgHead() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.MsgHead MsgHead = mvarMsgHeadEnd PropertyPublic Property Let SMSC(ByVal vData As String)'向属性指派值时使用，位于赋值语句的左边。'Syntax: X.SMSC = 5 If Len(vData) = 0 Then mvarSMSCLen = 0 mvarSMSC = vData Else If Len(vData) > 14 Then RaiseEvent ValidResult(7, "SMSC Error!") vData = "[phone]" End If If Len(vData) RaiseEvent ValidResult(7, "SMSC Error!") vData = "[phone]" End If vData = "+86" & Right(vData, 11) mvarSMSC = vData mvarSMSCLen = FormatPhoneNum(vData, mvarSMSCType) / 2 End If End PropertyPublic Property Get SMSC() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.SMSC SMSC = mvarSMSCEnd Property'Public Property Let SMSCType(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.SMSCType = 5' mvarSMSCType = vData'End PropertyPublic Property Get SMSCType() As String'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.SMSCType If Len(SMSC) = 0 Then mvarSMSCType = "FF" Else Dim str As String str = SMSC FormatPhoneNum str, mvarSMSCType End If SMSCType = mvarSMSCTypeEnd Property'Public Property Let SMSCLen(ByVal vData As String)''向属性指派值时使用，位于赋值语句的左边。''Syntax: X.SMSCLen = 5' mvarSMSCLen = vData'End Property''Public Property Get SMSCLen() As Integer'检索属性值时使用，位于赋值语句的右边。'Syntax: Debug.Print X.SMSCLen If Len(SMSC) = 0 Then mvarSMSCLen = 0 Else Dim str As String str = SMSC FormatPhoneNum str, mvarSMSCType mvarSMSCLen = Len(mvarSMSCType & str) / 2 End If SMSCLen = mvarSMSCLenEnd PropertyPrivate Sub Class_Initialize() mvarSMSCLen = 0mvarSMSCType = ""mvarSMSC = ""mvarMsgHead = 17mvarTPMR = 0mvarDestPhoneNumLen = 0mvarDestPhoneNumType = ""mvarDestPhoneNum = ""mvarTPPID = 0mvarTPDSC = 8mvarTPVP = 255mvarMSGLen = 0mvarMSGContent = ""mvarPDULen = 0mvarPDU = "" ' Msg.MsgHead = "11" '文件头字节 (header byte, 是一种 bitmask) 。这里 11 指正常地发送短信息。' Msg.TPMR = "00" '信息参考号。（ TP-MR ）' Msg.TPPID = "00" '‘一般都是 00 ，表示点到点的标准短信' Msg.TPVP = "FF" '‘有效期 (TP-VP), 短信的有效时间 ,00或FF表示有效' Msg.TPDSC = "08" '用户信息编码方式 (TP-DCS) , 7-bit 编码（ 08 ： UCS2 编码 汉字一般为08） End SubPrivate Function Int2HexStr(ByVal arg0 As Integer) As String Dim strChar As String strChar = "" strChar = Hex(arg0) If Len(strChar) Int2HexStr = strCharEnd Function'由于位置上略有处理，实际号码应为： 8613805515500( 字母 F 意指长度减 1),'这是作者所在地 GSM 短信息中心的号码。 ( 号码处理方法为 , 如果为 +86 开始 , 将 + 号去掉 ,'然后判断是否为偶数 , 不是在末尾补 F, 然后将奇数位和偶数位互换 )Public Function FormatPhoneNum(ByRef phoneNum As String, ByRef tonNpiFlag As String) As Integer Dim i As Integer Dim iAsc As Integer Dim strChar As String ' If Len(phoneNum) = 14 Then' If Left(phoneNum, 3) = "+86" Then' phoneNum = Right(phoneNum, 11)' Else' If Len(phoneNum) 11 Then' FormatSMSC = 0' Exit Function' End If' End If' End If If Len(phoneNum) FormatPhoneNum = 0 Exit Function End If If Left(phoneNum, 3) = "+86" Then phoneNum = Right(phoneNum, 13) tonNpiFlag = "91" Else' If Len(phoneNum) 11 Then' FormatSMSC = 0' Exit Function' End If tonNpiFlag = "81" End If For i = 1 To Len(phoneNum) strChar = Mid(phoneNum, i, 1) iAsc = Asc(strChar) If iAsc > 57 Or iAsc FormatPhoneNum = 0 Exit Function End If Next i If Len(phoneNum) Mod 2 0 Then phoneNum = phoneNum & "F" End If Dim strTmp2, strTmp1 As String strTmp1 = "" For i = 1 To Len(phoneNum) Step 2 strTmp2 = Mid(phoneNum, i, 2) strTmp1 = strTmp1 & Right(strTmp2, 1) & Left(strTmp2, 1) Next i phoneNum = strTmp1 FormatPhoneNum = Len(phoneNum) - 1End FunctionPublic Function GB2Unicode(ByVal strGB As String) As String Dim byteA() As Byte Dim i As Integer Dim strTmpUnicode As String Dim strA As String Dim strB As String On Error GoTo ErrorUnicode i = LenB(strGB) ReDim byteA(1 To i) For i = 1 To LenB(strGB) strA = MidB(strGB, i, 1) byteA(i) = AscB(strA) Next i '此时已经将strGB转换为Unicode编码，保存在数组byteA()中。 '下面需要调整顺序并以字符串的形式返回 strTmpUnicode = "" For i = 1 To UBound(byteA) Step 2 strA = Hex(byteA(i)) If Len(strA) strB = Hex(byteA(i + 1)) If Len(strB) strTmpUnicode = strTmpUnicode & strB & strA Next i GB2Unicode = strTmpUnicode Exit FunctionErrorUnicode:' MsgBox "错误：" & Err & "." & vbCrLf & Err.Description RaiseEvent ValidResult(Err.Number, Err.Description) GB2Unicode = ""End Function使用方法：Dim sms1 As New SMSPDUClass sms1.DestPhoneNum = "13922992078" sms1.SMSC = "[phone]" sms1.MSGContent = "aa" SendSms sms1.pdu,sms1.pduleniPublic Function SendSms(ByVal strSMSPdu As String, ByVal SMSLen As Integer) As Boolean With MSComm1 If .PortOpen = True Then' Debug.Print Now() If SMSLen > 5 Then .Output = "AT+CMGF=0" & vbCr .Output = "AT+CMGS=" & SMSLen & vbCr Else SendSms = False Exit Function End If If Len(strSMSPdu) = 0 Then SendSms = False Exit Function End If' Debug.Print Now() Dim i As Long For i = 0 To 10000 Step 1 DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents DoEvents Next' Debug.Print Now() .Output = strSMSPdu & Chr(26) SendSms = True' Debug.Print Now() Else SendSms = False Exit Function End If End WithEnd Function