modpdu.bas

手机短信开发

Attribute VB_Name = "modPdu"

Option Explicit

'功能： 生成PDU串
'输入： 短信息内容、目标手机号码、[可选的短信服务中心号码]
'输出： 生成的PDU串
'返回： 整个字串的长度
'
Public Function GetPDU(ByVal SMSText As String, _
                        ByVal DestNo As String, _
                        ByRef PDUString As String, _
                        Optional ByVal ServiceNo As String) As Long
    On Error GoTo ErrorPDU
    Dim i As Integer
    Dim iAsc As Integer
    Dim iLen As Integer
    Dim strTmp As String
    Dim strTmp2 As String
    Dim strDest As String
    Dim strChar As String
    Dim blIsEmptyService As Boolean
    
    For i = 1 To Len(DestNo)
        strChar = Mid(DestNo, i, 1)
        iAsc = Asc(strChar)
        If iAsc > 57 Or iAsc < 48 Then Exit Function
    Next i
    
    If Len(DestNo) = 14 Then
        If Left(DestNo, 3) = "+86" Then
            DestNo = Right(DestNo, 11)
        Else
            Exit Function
        End If
    End If
    
    If Len(DestNo) = 0 Or SMSText = "" Then Exit Function
    
    Dim objDll As New myVBDll
    
    DestNo = DestNo & "F"
    
    If ServiceNo = "" Then
        strTmp = "0001000D9168"
        blIsEmptyService = True
    Else
        blIsEmptyService = False
        strTmp = "089168"
        If Len(ServiceNo) = 14 Then
            If Left(ServiceNo, 3) = "+86" Then
                ServiceNo = Right(ServiceNo, 11)
            Else
                Exit Function
            End If
        End If
        
        For i = 1 To Len(ServiceNo)
            strChar = Mid(ServiceNo, i, 1)
            iAsc = Asc(strChar)
            If iAsc > 57 Or iAsc < 48 Then Exit Function
        Next i
        ServiceNo = ServiceNo & "F"
'        Debug.Print ServiceNo
        strDest = ""
        For i = 1 To 12 Step 2
            strTmp2 = Mid(ServiceNo, i, 2)
            strDest = strDest & Right(strTmp2, 1) & Left(strTmp2, 1)
        Next i
        strTmp = strTmp & strDest & "11000D9168"
'        Debug.Print strTmp

    End If
    strDest = ""
    For i = 1 To 12 Step 2
        strTmp2 = Mid(DestNo, i, 2)
        strDest = strDest & Right(strTmp2, 1) & Left(strTmp2, 1)
    Next i
'    Debug.Print strTmp
'    Debug.Print strDest
    strTmp = strTmp & strDest
    strTmp = strTmp & "000800"
    
'    Debug.Print strTmp
'     Debug.Print SMSText
     
  
        If Len(SMSText) > 70 Then
            SMSText = Left(SMSText, 70)
            
        
        End If


    SMSText = objDll.GB2Unicode(SMSText)

    
    iLen = Len(SMSText) \ 2
    strChar = Hex(iLen)
    If Len(strChar) < 2 Then strChar = "0" & strChar
    strTmp = strTmp & strChar & SMSText
'    Debug.Print strChar
'    Debug.Print SMSText
    
    Set objDll = Nothing
    PDUString = strTmp
    If blIsEmptyService Then
        GetPDU = Len(strTmp) / 2 - 1
    Else
        GetPDU = Len(strTmp) / 2 - 9
    End If
    Exit Function
ErrorPDU:
    Set objDll = Nothing
    GetPDU = 0
    PDUString = ""
    MsgBox "Error:" & Err & "." & vbCrLf & Err.Description
End 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) <= 0 Then
            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 < 48 Then
                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) - 1
End Function




Public Function genPDU(ByVal SMSText As String, _
                        ByVal DestNo As String, _
                        Optional ByVal ServiceNo As String) As SMSPDUStruct

    
    Dim Msg As SMSPDUStruct
    
    
    If Len(DestNo) = 0 Then
'        genPDU = 0
        Exit Function
    End If
    
'    If ServiceNo = "" Then
'        ServiceNo = "[phone]"
'    End If

        If Len(SMSText) > 70 Then
            SMSText = Left(SMSText, 70)
            
        
        End If

    Msg.SMSC = ServiceNo
    Msg.DestPhoneNum = DestNo
    
    FormatPhoneNum Msg.SMSC, Msg.SMSCType
    Msg.SMSCLen = Int2HexStr(Len(Msg.SMSC & Msg.SMSCType) / 2)  '短信息中心地址长度。（短信息中心号码类型 + 短信息中心号码长度 /2 的十六进制表示）
    
    ' msg.DestPhoneNumType 被叫号码类型。有+86时候为"91"，否则为"81"
    Msg.DestPhoneNumLen = Int2HexStr(FormatPhoneNum(Msg.DestPhoneNum, Msg.DestPhoneNumType))    ''被叫号码长度。被叫号码长度的十六进制表示。
    
    
    
    Dim iLen As Integer
     
    SMSText = GB2Unicode(SMSText)   '把汉字符转化为UNICODE的HEX编码字符串
    
'    strChar = Hex(iLen)
'    If Len(strChar) < 2 Then strChar = "0" & strChar
'    strTmp = strChar & SMSText
'    If flash = True Then
'        SMSText = "0001" & SMSText
'    End If
    Msg.MSGContent = SMSText
    iLen = Len(SMSText) \ 2
'    Debug.Print SMSText
    
    Msg.MSGLen = Int2HexStr(iLen)   '短信息长度
    
    
    
'    Debug.Print strChar
'    Debug.Print SMSText
    

''    PDUString = strTmp
'    If blIsEmptyService Then
'        iLen = Len(strTmp) / 2 - 1
'    Else
'        iLen = Len(strTmp) / 2 - 9
'    End If
    
    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）
    
    If Len(ServiceNo) = 0 Then
        Msg.PDU = Msg.SMSCLen & Msg.MsgHead & Msg.TPMR & Msg.DestPhoneNumLen & Msg.DestPhoneNumType & Msg.DestPhoneNum & _
                    Msg.TPPID & Msg.TPDSC & Msg.TPVP & Msg.MSGLen & Msg.MSGContent
        
        Msg.PDULen = Len(Msg.PDU) / 2 - 1
        
    
    Else
        Msg.PDU = Msg.SMSCLen & Msg.SMSCType & Msg.SMSC & Msg.MsgHead & Msg.TPMR & Msg.DestPhoneNumLen & Msg.DestPhoneNumType & Msg.DestPhoneNum & _
                    Msg.TPPID & Msg.TPDSC & Msg.TPVP & Msg.MSGLen & Msg.MSGContent
        
        Msg.PDULen = Len(Msg.PDU) / 2 - 9   'PDU字符串长度
    End If
    genPDU = Msg
    
    Exit Function
ErrorPDU:
    
    MsgBox "Error:" & Err & "." & vbCrLf & Err.Description
End Function

Public Function Int2HexStr(ByVal arg0 As Integer) As String
    Dim strChar As String
    strChar = ""
    
    strChar = Hex(arg0)
    If Len(strChar) < 2 Then strChar = "0" & strChar
    Int2HexStr = strChar
End Function


Public Function genWapPushPdu(ByVal url As String, ByVal title As String, ByVal SMSC As String, ByVal phoneNum As String) As WAPPushPDUStruct

    Dim wapPush As WAPPushPDUStruct
    
    
    
    With wapPush
'        .SMSCLen
'        .SMSCType
        .SMSC = SMSC
        .PROTOCOL = "51"
        .TPMRBase = "00"
'        .RePhoneNumLen
'        .RePhoneNumType
        .RePhoneNum = phoneNum
        
        
        FormatPhoneNum .SMSC, .SMSCType
        .SMSCLen = Int2HexStr(Len(.SMSC & .SMSCType) / 2)  '短信息中心地址长度。（短信息中心号码类型 + 短信息中心号码长度 /2 的十六进制表示）
    
    ' msg.DestPhoneNumType 被叫号码类型。有+86时候为"91"，否则为"81"
        .RePhoneNumLen = Int2HexStr(FormatPhoneNum(.RePhoneNum, .RePhoneNumType))    ''被叫号码长度。被叫号码长度的十六进制表示。
            
            
        .TPPID = "00"
        .TPDSC = "F5"
        .TPVP = "A7"
'        .MSGLen
        
        .WAPPUSHHeadLen = "0B"
        .WAPPUSHFlag = "00"
        .DATALen = "03"
        .WAPPUSHCOMBFlag = "03"
        .Total = "01"
        .MSGID = "01"
        .WAPPUSHBegin = "05040B8423F0"
        .WSP = "29060603AE81EA8DCA"
        .Flag = "02"
        .DTDSIFlag = "05"
        .UTF = "6A"
        .FlagBegin = "00"
        
        .SIBegin = "45"
        .IndicationBegin = "C6"
        .Action = "08"
        .Href = "0C"
        .HrefBegin = "03"
        .url = GB2Unicode(url)
        .HrefEnd = "00"
        .Split = "01"
        .TitleBegin = "03"
        .title = GB2Unicode(title)
        .TitleEnd = "00"
        .SIEnd = "01"
        .IndicationEnd = "01"
 
        Dim str1, str2 As String
        
        str1 = .SMSCLen & .SMSCType & .SMSC & .PROTOCOL & .TPMRBase & .RePhoneNumLen & .RePhoneNumType & .RePhoneNum & .TPPID & .TPDSC & .TPVP
        str2 = .WAPPUSHHeadLen & .WAPPUSHFlag & .DATALen & .WAPPUSHCOMBFlag & .Total & .MSGID & .WAPPUSHBegin & _
                .WSP & .Flag & .DTDSIFlag & .UTF & .FlagBegin & .SIBegin & .IndicationBegin & .Action & .Href & _
                .HrefBegin & .url & .HrefEnd & .Split & .TitleBegin & .title & .TitleEnd & .SIEnd & .IndicationEnd

        .MSGLen = Int2HexStr(Len(str2) / 2 + 1)
        .PDU = str1 & .MSGLen & str2
        .PDULen = Len(.PDU) / 2 - 9
        
        
    End With
    genWapPushPdu = wapPush
End Function