smspduclass.cls

手机短信开发

''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 = mvarDestPhoneNumType
End 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 = mvarDestPhoneNumLen
End Property



Public Property Let TPMR(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.TPMR = 5
    If vData >= 0 And vData < 256 Then
        mvarTPMR = vData
    
    Else
        RaiseEvent ValidResult(2, "TP-MR Error!")
        
    End If
End Property


Public Property Get TPMR() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.TPMR
    TPMR = mvarTPMR
End Property



Public Property Let MsgHead(ByVal vData As Integer)
'向属性指派值时使用，位于赋值语句的左边。
'Syntax: X.MsgHead = 5
    If vData >= 0 And vData < 256 Then
        mvarMsgHead = vData
    Else
        RaiseEvent ValidResult(1, "MsgHead Error!")
        
        
    End If
End Property


Public Property Get MsgHead() As Integer
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.MsgHead
    MsgHead = mvarMsgHead
End Property



Public 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) < 11 Then
            RaiseEvent ValidResult(7, "SMSC Error!")
            vData = "[phone]"
        End If
        vData = "+86" & Right(vData, 11)
        mvarSMSC = vData
        mvarSMSCLen = FormatPhoneNum(vData, mvarSMSCType) / 2
    End If
    
End Property


Public Property Get SMSC() As String
'检索属性值时使用，位于赋值语句的右边。
'Syntax: Debug.Print X.SMSC
    SMSC = mvarSMSC
End Property



'Public Property Let SMSCType(ByVal vData As String)
''向属性指派值时使用，位于赋值语句的左边。
''Syntax: X.SMSCType = 5
'    mvarSMSCType = vData
'End Property


Public 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 = mvarSMSCType
End 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 = mvarSMSCLen
End Property



Private Sub Class_Initialize()
    
mvarSMSCLen = 0
mvarSMSCType = ""
mvarSMSC = ""
mvarMsgHead = 17
mvarTPMR = 0
mvarDestPhoneNumLen = 0
mvarDestPhoneNumType = ""
mvarDestPhoneNum = ""
mvarTPPID = 0
mvarTPDSC = 8
mvarTPVP = 255
mvarMSGLen = 0
mvarMSGContent = ""
mvarPDULen = 0
mvarPDU = ""

    
'    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 Sub

Private 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

'由于位置上略有处理，实际号码应为： 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 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) < 2 Then strA = "0" & strA
        strB = Hex(byteA(i + 1))
        If Len(strB) < 2 Then strB = "0" & strB
        strTmpUnicode = strTmpUnicode & strB & strA
    Next i
    
    GB2Unicode = strTmpUnicode
    Exit Function

ErrorUnicode:
'    MsgBox "错误：" & Err & "." & vbCrLf & Err.Description
    RaiseEvent ValidResult(Err.Number, Err.Description)
    
    GB2Unicode = ""
End Function