Public Function Encode7Bit(ByVal Content As String) As String
'Prepare
Dim CharArray As Char() = Content.ToCharArray
Dim c As Char
Dim t As String
For Each c In CharArray
t = CharTo7Bits(c) + t
Next
'Add "0"
Dim i As Integer
If (t.Length Mod 8) <> 0 Then
For i = 1 To 8 - (t.Length Mod 8)
t = "0" + t
Next
End If
'Split into 8bits
Dim result As String
For i = t.Length - 8 To 0 Step -8
result = result + BitsToHex(Mid(t, i + 1, 8))
Next
Return result
End Function
Private Function BitsToHex(ByVal Bits As String) As String
'Convert 8Bits to Hex String
Dim i, v As Integer
For i = 0 To Bits.Length - 1
v = v + Val(Mid(Bits, i + 1, 1)) * 2 ^ (7 - i)
Next
Dim result As String
result = Format(v, "X")
If result.Length = 1 Then
result = "0" + result
End If
Return result
End Function
Private Function CharTo7Bits(ByVal c As Char) As String
Dim Result As String
Dim i As Integer
For i = 0 To 6
If (Asc(c) And 2 ^ i) > 0 Then
Result = "1" + Result
Else
Result = "0" + Result
End If
Next
Return Result
End Function
Private Function EncodeUCS2(ByVal Content As String) As String
Dim i, j, v As Integer
Dim Result, t As String
For i = 1 To Content.Length Step 4
v = AscW(Mid(Content, i, 4))
t = Format(v, "X")
For j = 1 To 4 - t.Length
t = "0" & t
Next
Result += t
Next
Return Result
End Function
本文地址：http://com.8s8s.com/it/it43878.htm