
下面是我搜来的汉字转16进制字符的代码,速度特快。请大家搜藏。并请大家帮助我解决如何16进制字符再转回汉字的问题。
Option Explicit
Private Sub Command1_Click()
Dim strWj As String
Dim aryContent() As Byte
Dim i As Long
Dim j As Long
Open "c:/a.txt" For Binary As #1
ReDim aryContent(LOF(1) - 1)
Get #1, , aryContent
Close #1
For i = 0 To UBound(aryContent)
' Me.Print Right("00" & Hex(aryContent(i)), 2)
Select Case Right("00" & Hex(aryContent(i)), 2)
Case "0D"
strWj = strWj
Case "0A"
strWj = strWj & vbCrLf
Case Else
strWj = strWj & Right("00" & Hex(aryContent(i)), 2) & " "
DoEvents
End Select
Next
Text1 = strWj
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub
Public Function GetHexStr(b() As Byte) As String
Dim i As Long, temp As String, temp1 As String, tmp1 As String, tmp2 As String
Dim n As Byte, m As Byte
Dim s As Long, u As Long
'Dim t As Long
't = GetTickCount
'转换成十六进制
For i = LBound(b) To UBound(b)
m = b(i)
If m = 0 Then
temp = temp & "00 "
ElseIf m < 10 Then
temp = temp & "0" & m & " "
ElseIf m < 16 Then
temp = temp & "0" & Chr(55 + m) & " "
Else
n = m Mod 16
m = m \ 16
If n > 9 Then
temp1 = Chr(55 + n)
Else
temp1 = n
End If
n = m Mod 16
m = m \ 16
If n > 9 Then
temp1 = Chr(55 + n) & temp1
Else
temp1 = n & temp1
End If
temp = temp & temp1 & " "
End If
If s > 1000 Then
If u > 500 Then
DoEvents
tmp2 = tmp2 & tmp1
tmp1 = temp
u = 0
Else
u = u + 1
tmp1 = tmp1 & temp
temp = vbNullString
End If
s = 0
Else
s = s + 1
End If
Next
GetHexStr = tmp2 & tmp1 & temp
'MsgBox GetTickCount - t
' Text2.Text = GetHexStr
End Function
Option Explicit
Private Sub Command1_Click()
Dim strWj As String
Dim aryContent() As Byte
Dim i As Long
Dim j As Long
Open "c:/a.txt" For Binary As #1
ReDim aryContent(LOF(1) - 1)
Get #1, , aryContent
Close #1
For i = 0 To UBound(aryContent)
' Me.Print Right("00" & Hex(aryContent(i)), 2)
Select Case Right("00" & Hex(aryContent(i)), 2)
Case "0D"
strWj = strWj
Case "0A"
strWj = strWj & vbCrLf
Case Else
strWj = strWj & Right("00" & Hex(aryContent(i)), 2) & " "
DoEvents
End Select
Next
Text1 = strWj
ErrHandler:
' 用户按了“取消”按钮
Exit Sub
End Sub
Public Function GetHexStr(b() As Byte) As String
Dim i As Long, temp As String, temp1 As String, tmp1 As String, tmp2 As String
Dim n As Byte, m As Byte
Dim s As Long, u As Long
'Dim t As Long
't = GetTickCount
'转换成十六进制
For i = LBound(b) To UBound(b)
m = b(i)
If m = 0 Then
temp = temp & "00 "
ElseIf m < 10 Then
temp = temp & "0" & m & " "
ElseIf m < 16 Then
temp = temp & "0" & Chr(55 + m) & " "
Else
n = m Mod 16
m = m \ 16
If n > 9 Then
temp1 = Chr(55 + n)
Else
temp1 = n
End If
n = m Mod 16
m = m \ 16
If n > 9 Then
temp1 = Chr(55 + n) & temp1
Else
temp1 = n & temp1
End If
temp = temp & temp1 & " "
End If
If s > 1000 Then
If u > 500 Then
DoEvents
tmp2 = tmp2 & tmp1
tmp1 = temp
u = 0
Else
u = u + 1
tmp1 = tmp1 & temp
temp = vbNullString
End If
s = 0
Else
s = s + 1
End If
Next
GetHexStr = tmp2 & tmp1 & temp
'MsgBox GetTickCount - t
' Text2.Text = GetHexStr
End Function



七奈
