module1.bas

通过电脑的串口

Attribute VB_Name = "Module1"
'短信息数据结构
Public Type typeSMS
    SMSCLen         As String  'SMSC信息的长度 (08)
    AddressType     As String   'SMSC的地址类型 (91意味着国际格式的电话号码）
    SourceCenter    As String   '服务中心号码（半八位的十进制数）,加入F来保证位数
    
    SMSDeliver1     As String   'SMS_DELIVER的第一个8位
    sPhoneNumLen    As String   '地址长度。发送号码的长度
    sPhoneNumType   As String   '发送号码的地址类型,91意味着国际格式的电话号码，否则为A1
    sPhoneNumber    As String   '发送号码(半八位的十进制数),有一个F结尾
    ProtocolFlag    As String   '协议标识(00)
    EncodeType      As String   '编码方式,一般00为英文的7bit编码,08为中文的Unicode编码
    TimePost        As String   '时间邮戳(半8位)(A7)
    PDUDataLen      As String   'TP-UDL.用户数据长度，信息的长度(编码前).
    PDUData         As String   'PDU数据(以0x1A结束）
End Type

Public Function PDU7BitDecode(ByVal varString As String) As String
'==============================================================================
'SMS PDU格式7位编码的解码函数
'Ahui 2002.4于北京
'------------------------------------------------------------------------------
'PDU7bit编码 (用于英文)
'解码
'以两个16进制字符(共8位)为单元，将串反转，如54 64 72 0A 4A反转为4A 0A 72 64 54
'变成定长8位的二进制,01001010 00001010 01110010 01100100 01010100
'从右取每7位为一个字符，01001 0100000 1010011(S) 1001001(I) 1001000(H) 1010100(T)
'将所得字符再反转一次，即得,THIS
'------------------------------------------------------------------------------
Dim tempString As String        '输入串
Dim tempTwo(160) As String      '存放二进制数据的数组
Dim tempSource(160) As String   '存放二进制数据对应字符的数组
Dim tempAllTwo As String        '存放整个二进制数据中
Dim tempAllString As String     '解码结果
Dim i As Integer                '计数器
Dim tempiString As String * 2   '临时存放反转结果段
Dim tempIndex As Integer        '数组指针

tempString = varString
tempIndex = Len(tempString) / 2
For i = 0 To Len(tempString) - 1 Step 2
    tempiString = Mid(tempString, i + 1, 2)
    tempTwo(tempIndex) = Ten2Two("&h" & tempiString)
    tempIndex = tempIndex - 1
Next

tempAllTwo = Join(tempTwo, "")
tempIndex = 0
For i = Len(tempAllTwo) To 7 Step -7
    tempSource(tempIndex) = Chr(Two2Ten(Mid(tempAllTwo, i - 7 + 1, 7)))
    tempIndex = tempIndex + 1
Next
tempAllString = Join(tempSource, "")

PDU7BitDecode = tempAllString

End Function
Public Function PDUChineseDecode(ByVal varString As String) As String
'==============================================================================
'SMS PDU格式中文Unicode编码的解码函数
'Ahui 2002.4于北京
'==============================================================================
Dim tempString As String
Dim tempAllString As String
Dim i As Integer
Dim k() As Byte
tempString = varString
k = StrConv(tempString, vbFromUnicode)
For i = 0 To Len(tempString) * 2 - 1 Step 4
    tempAllString = tempAllString & ("&h" & Val(k(i + 2)) & Val(k(i)))
Next

PDUChineseDecode = tempAllString

End Function
Public Function PDUHalf8bitEncode(ByVal varString As String) As String
'==============================================================================
'SMS PDU格式中半8位编码函数
'Ahui 2002.4于北京
'==============================================================================
'
'
Dim i As Integer
Dim tempString As String
Dim tempAllString As String
If Len(varString) = 11 Then
tempString = varString & "F"
Else: tempString = varString
End If

For i = 0 To Len(tempString) - 1 Step 2
    tempAllString = tempAllString & StrReverse(Mid(tempString, i + 1, 2))
Next


PDUHalf8bitEncode = tempAllString
End Function

Public Function PDUChineseEncode(ByVal varString As String) As String
'==============================================================================
'SMS PDU格式中英文Unicode编码函数
'Ahui 2002.5于北京
'==============================================================================

Dim tempString As String
Dim tempAllString As String
Dim i As Integer
Dim TEMP As String
tempString = varString
For i = 0 To Len(tempString) - 1
    TEMP = Hex(AscW(Mid(tempString, i + 1, 1)))
    If Len(TEMP) = 2 Then TEMP = "00" & TEMP
    If Len(TEMP) = 1 Then TEMP = "000" & TEMP
    tempAllString = tempAllString & TEMP
Next

PDUChineseEncode = tempAllString

End Function
Public Function Two2Ten(ByVal varString As String) As Long
'将二进制转化为十进制
Dim Slen As Long, i As Long, returnNum As Long
Slen = Len(varString)
For i = 0 To Slen - 1
    returnNum = returnNum + Val(Mid(varString, i + 1, 1) * (2 ^ (Slen - i - 1)))
Next
Two2Ten = returnNum

End Function
Public Function Ten2Two(ByVal varNum As Long)
'将十进制数转化为定长8位的二进制串
'输入参数可以为&h类的十六进制
Dim returnString As String, ModNum As Integer
Do While varNum > 0
    ModNum = varNum Mod 2
    varNum = Fix(varNum / 2)
    returnString = Trim(Str(ModNum)) + returnString
Loop
Dim i As Integer
For i = 1 To 8 - Len(returnString)
    '不足8位时，在前面补上0
    returnString = 0 & returnString
Next
Ten2Two = returnString

End Function
Public Function PDUHalf8bitDecode(ByVal varString As String) As String
'==============================================================================
'SMS PDU格式中半8位解码函数
'Ahui 2002.4于北京
'==============================================================================
'3119769416F6
'
Dim i As Integer
Dim tempString As String
Dim tempAllString As String

tempString = varString

For i = 0 To Len(tempString) - 1 Step 2
    tempAllString = tempAllString & StrReverse(Mid(tempString, i + 1, 2))
Next
'去掉PDU格式中为保证位数增加的多余的"F"字符
If Right(tempAllString, 1) = "F" Then tempAllString = Left(tempAllString, Len(tempAllString) - 1)

PDUHalf8bitDecode = tempAllString

End Function