|
|
|
|
|
Code der Funktionen im Modul modHexDump.bas
Private Declare Sub CopyMemory Lib "kernel32" _
Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, _
ByVal ByteLen As Long)
Public Enum HexStringConstants
hsANSI
hsUnicode
End Enum
Public Function StringToHexString(Text As String, _
Optional ByVal CharMode As HexStringConstants, _
Optional ByVal ReverseOrder As Boolean = True, _
Optional Delimiter As String, _
Optional GroupDelimiter As String, _
Optional ByVal CharsPerGroup As Long = 4) As String
Dim nStringHex As String
Dim nBytes() As Byte
Dim nPosStringHex As Long
Dim nChar As Long
Dim nByteNum As Long
Dim nDigit As String
Dim nLenStringHex As Long
Dim nGroup As String
Dim nPosGroup As Long
Dim nLenGroup As Long
Dim nLenDigit As Long
Dim nLenDelimiter As Long
Dim nLenGroupDelimiter As Long
nBytes = Text
Select Case CharMode
Case hsUnicode
If ReverseOrder Then
If Len(Delimiter) Then
nLenDelimiter = Len(Delimiter)
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = (UBound(nBytes) + 1) * 2 _
+ (Len(Text) - 1) * nLenDelimiter + 2
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex _
+ (Len(Text) \ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex _
+ ((Len(Text) \ CharsPerGroup) - 1) * nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(4) & Delimiter
nLenDigit = Len(nDigit)
nLenGroup = nLenDigit * CharsPerGroup _
+ nLenGroupDelimiter - nLenDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
nGroup = Left$(nGroup, nPosGroup * nLenDigit _
- nLenDelimiter)
Exit For
End If
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * nLenDigit + 1, nLenDigit) _
= nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$((UBound(nBytes) + 1) * 2 _
+ (Len(Text) - 1) * Len(Delimiter))
nDigit = Space$(4) & Delimiter
nLenDigit = Len(nDigit)
nPosStringHex = 1
For nChar = 1 To Len(Text)
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nStringHex, nPosStringHex, nLenDigit) _
= nDigit
nPosStringHex = nPosStringHex + nLenDigit
Next 'nChar
End If
Else
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = (UBound(nBytes) + 1) * 2
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex _
+ (Len(Text) \ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex _
+ ((Len(Text) \ CharsPerGroup) - 1) _
* nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(4)
nLenGroup = 4 * CharsPerGroup + nLenGroupDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
Exit For
End If
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * 4 + 1, 4) = nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$((UBound(nBytes) + 1) * 2)
For nPosStringHex = 0 To UBound(nBytes) Step 2
Mid$(nStringHex, nPosStringHex * 2 + 1, 2) = _
Right$("00" & Hex$(nBytes(nPosStringHex + 1)), 2)
Mid$(nStringHex, nPosStringHex * 2 + 3, 2) = _
Right$("00" & Hex$(nBytes(nPosStringHex)), 2)
Next 'nPosStringHex
End If
End If
Else
If Len(Delimiter) Then
nLenDelimiter = Len(Delimiter)
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = (UBound(nBytes) + 1) * 2 _
+ (Len(Text) - 1) * nLenDelimiter + 2
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex + (Len(Text) _
\ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex + ((Len(Text) _
\ CharsPerGroup) - 1) * nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(4) & Delimiter
nLenDigit = Len(nDigit)
nLenGroup = nLenDigit * CharsPerGroup _
+ nLenGroupDelimiter - nLenDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
nGroup = Left$(nGroup, nPosGroup _
* nLenDigit - nLenDelimiter)
Exit For
End If
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * nLenDigit + 1, nLenDigit) _
= nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$((UBound(nBytes) + 1) * 2 _
+ (Len(Text) - 1) * Len(Delimiter))
nDigit = Space$(4) & Delimiter
nLenDigit = Len(nDigit)
nPosStringHex = 1
For nChar = 1 To Len(Text)
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nStringHex, nPosStringHex, nLenDigit) _
= nDigit
nPosStringHex = nPosStringHex + nLenDigit
Next 'nChar
End If
Else
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = (UBound(nBytes) + 1) * 2
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex + (Len(Text) _
\ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex + ((Len(Text) _
\ CharsPerGroup) - 1) * nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(4)
nLenGroup = 4 * CharsPerGroup + nLenGroupDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
Exit For
End If
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
Mid$(nDigit, 3, 2) = _
Right$("00" & Hex$(nBytes(nByteNum + 1)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * 4 + 1, 4) = nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$((UBound(nBytes) + 1) * 2)
For nPosStringHex = 0 To UBound(nBytes)
Mid$(nStringHex, nPosStringHex * 2 + 1, 2) = _
Right$("00" & Hex$(nBytes(nPosStringHex)), 2)
Next 'nPosStringHex
End If
End If
End If
Case hsANSI
If Len(Delimiter) Then
nLenDelimiter = Len(Delimiter)
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = (UBound(nBytes) + 1) _
+ (Len(Text) - 1) * nLenDelimiter + 2
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex + (Len(Text) _
\ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex + ((Len(Text) _
\ CharsPerGroup) - 1) * nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(2) & Delimiter
nLenDigit = Len(nDigit)
nLenGroup = nLenDigit * CharsPerGroup _
+ nLenGroupDelimiter - nLenDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
nGroup = Left$(nGroup, nPosGroup * nLenDigit _
- nLenDelimiter)
Exit For
End If
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * nLenDigit + 1, nLenDigit) _
= nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$((UBound(nBytes) + 1) _
+ (Len(Text) - 1) * nLenDelimiter)
nDigit = Space$(2) & Delimiter
nLenDigit = Len(nDigit)
nPosStringHex = 1
For nChar = 1 To Len(Text)
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
nByteNum = nByteNum + 2
Mid$(nStringHex, nPosStringHex, nLenDigit) = nDigit
nPosStringHex = nPosStringHex + nLenDigit
Next 'nChar
End If
Else
If Len(GroupDelimiter) Then
nLenGroupDelimiter = Len(GroupDelimiter)
nLenStringHex = UBound(nBytes) + 1
If Len(Text) Mod CharsPerGroup Then
nLenStringHex = nLenStringHex + (Len(Text) _
\ CharsPerGroup) * nLenGroupDelimiter
Else
nLenStringHex = nLenStringHex + ((Len(Text) _
\ CharsPerGroup) - 1) * nLenGroupDelimiter
End If
nStringHex = Space$(nLenStringHex)
nDigit = Space$(2)
nLenGroup = 2 * CharsPerGroup + nLenGroupDelimiter
nPosStringHex = 1
For nChar = 1 To Len(Text)
nGroup = Space$(nLenGroup)
For nPosGroup = 0 To CharsPerGroup - 1
If nByteNum > UBound(nBytes) Then
Exit For
End If
Mid$(nDigit, 1, 2) = _
Right$("00" & Hex$(nBytes(nByteNum)), 2)
nByteNum = nByteNum + 2
Mid$(nGroup, nPosGroup * 2 + 1, 2) = nDigit
Next 'nPosGroup
If Len(nGroup) = nLenGroup Then
Mid$(nGroup, nLenGroup - nLenGroupDelimiter + 1, _
nLenGroupDelimiter) = GroupDelimiter
End If
Mid$(nStringHex, nPosStringHex, nLenGroup) = nGroup
nPosStringHex = nPosStringHex + nLenGroup
If nByteNum > UBound(nBytes) Then
Exit For
End If
Next 'nChar
Else
nStringHex = Space$(UBound(nBytes) + 1)
For nPosStringHex = 0 To UBound(nBytes) - 1 Step 2
Mid$(nStringHex, nPosStringHex + 1, 2) = _
Right$("00" & Hex$(nBytes(nPosStringHex)), 2)
Next 'nPosStringHex
End If
End If
End Select
StringToHexString = Trim$(nStringHex)
End Function
Public Function HexStringToString(HexString As String, _
Optional ByVal CharMode As HexStringConstants, _
Optional ByVal ReverseOrder As Boolean = True, _
Optional Delimiter As String, _
Optional GroupDelimiter As String) As String
Dim nBytes() As Byte
Dim l As Long
Dim nHexString As String
If Len(Delimiter) Then
nHexString = Replace(HexString, Delimiter, "")
Else
nHexString = HexString
End If
If Len(GroupDelimiter) Then
nHexString = Replace(nHexString, GroupDelimiter, "")
End If
Select Case CharMode
Case hsUnicode
ReDim nBytes(0 To (Len(nHexString) - 1) \ 2)
If ReverseOrder Then
For l = 1 To UBound(nBytes) + 1
nBytes(l - 1) = _
Val("&H" & Mid$(nHexString, l * 2 + 1, 2))
Next 'l
Else
For l = 0 To UBound(nBytes)
nBytes(l) = Val("&H" & Mid$(nHexString, l * 2 + 1, 2))
Next 'l
End If
Case hsANSI
ReDim nBytes(0 To Len(nHexString) - 1)
For l = 1 To Len(nHexString) - 1 Step 2
nBytes(l - 1) = Val("&H" & Mid$(nHexString, l, 2))
Next 'l
End Select
HexStringToString = nBytes
End Function
Public Function HexDump(ByVal Ptr As Long, _
ByVal Bytes As Long, _
Optional Delimiter As String, _
Optional GroupDelimiter As String, _
Optional ByVal CharsPerGroup As Long = 4) As String
Dim nStr As String
Dim nHexDump As String
If Bytes And 1 Then
nStr = String$((Bytes + 1) \ 2, Chr$(0))
Else
nStr = String$(Bytes \ 2, Chr$(0))
End If
CopyMemory ByVal StrPtr(nStr), ByVal Ptr, Bytes
nHexDump = StringToHexString(nStr, hsUnicode, False, _
Delimiter, GroupDelimiter, CharsPerGroup)
If Bytes And 1 Then
HexDump = Left$(nHexDump, Len(nHexDump) - 2)
Else
HexDump = nHexDump
End If
End Function
|
|
|