moduledo.bas

手机编程

Attribute VB_Name = "ModuleDo"
Private Declare Function GetTickCount Lib "kernel32" () As Long
Public Function Encode(TxtMessage As String) As String
    Dim High As String, Low As String, OneWord As String
    Dim i As Integer
    For i = 1 To Len(TxtMessage)        '将短信息转化为编码
        OneWord = Mid(TxtMessage, i, 1)
        Low = Hex(AscB(MidB(OneWord, 1, 1)))
        High = Hex(AscB(MidB(OneWord, 2, 1)))
        If Len(High) = 1 Then High = "0" + High
        If Len(Low) = 1 Then Low = "0" + Low
        Encode = Encode + High + Low     '得到的编码
    Next i
End Function
Public Function Decode(EncodeMessage As String) As String
    Dim Word(2) As Byte
    Dim ascii As String
    Dim Temp As String
    Dim j As Integer, Pos As Integer
    Pos = 1
    j = 1
    Do
        If j >= Len(EncodeMessage) Then
            Exit Function
        End If
        ascii = Mid(EncodeMessage, j, 2)
        j = j + 2
        
        Word(Pos) = Val("&H" + ascii)
        Pos = Pos - 1
        If Pos < 0 Then
            Temp = Word
            Decode = Decode + Left(Temp, 1)
            Pos = 1
        End If
    Loop
End Function
Public Function GetSendPDU(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) <> 11 Or SMSText = "" Then Exit Function
    
    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"
        
        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"

    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
    strTmp = strTmp & strDest
    strTmp = strTmp & "000800"
    
    
    SMSText = Encode(SMSText)
    iLen = Len(SMSText) \ 2
    strChar = Hex(iLen)
    If Len(strChar) < 2 Then strChar = "0" & strChar
    strTmp = strTmp & strChar & SMSText
    
    PDUString = strTmp
    If blIsEmptyService Then
        GetSendPDU = Len(strTmp) / 2 - 1
    Else
        GetSendPDU = Len(strTmp) / 2 - 9
    End If
    Exit Function
ErrorPDU:
    GetSendPDU = 0
    PDUString = ""
    'MsgBox "Error:" & Err & "." & vbCrLf & Err.Description
End Function
Public Sub TimeDelay(DT As Long)
    Dim T As Long
    T = GetTickCount()
    Do
        'DoEvents
    Loop Until GetTickCount - T > DT
End Sub