Date: 02-16-2022
Return to Index
created by gbSnippets
'Reads a file or accepts a string and returns a multi-line hex
'representation of the file content, 8 characters wide. Useful
'in examining characters which do not print/display.
'Primary Code:
'Accepts a string or a filename and returns a formatted hex string of the content
'There are 8 characters per line, displayed in Hex and Ascii format.
Function HexString(t$, sFlag&) As String '0=string 1=filename
Dim temp$, filedata$, a$, b$, c$, i As Long, temp2$
If sFlag& Then Open t$ For Binary As #1 : Get$ #1, Lof(1), t$ : Close #1
For i = 1 To Len(t$)
b$ = Mid$(t$,i,1)
temp2$ = temp2$ + IIf$(Verify (b$, Chr$(65 To 90, 97 To 122)),".",b$)
a$ = IIf$(Len(Hex$(Asc(b$))) = 1, " 0", " ")
c$ = IIf$(i Mod 8, "", Space$(3) + temp2$ + $CrLf)
temp$ = temp$ + a$ + Hex$(Asc(b$)) + c$
If i Mod 8 = 0 Then temp2$ = ""
Next i
temp$ = temp$ + Space$((8-(Len(t$) Mod 8))*3+3) + temp2$
Function = temp$
End Function
'Compilable Example: (Jose Includes)
'displays a string (optionally from a file) in Hex format
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "win32api.inc"
#Include "RichEdit.inc"
#Include "CommCtrl.inc"
Global hDlg As Dword, hRichEdit As Dword
%ID_RichEdit = 500
Function PBMain() As Long
Dialog New Pixels, 0, "Test Code",300,300,200,150, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, 100,"Push", 30,10,140,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Local temp$
If CB.Msg = %WM_Command AND CB.Ctl = 100 AND CB.Ctlmsg = %BN_Clicked Then
' temp$ = HexString("This is a test." + $CrLf + "Done.", 0) '0=string 1=filename
temp$ = HexString("myfile.txt", 1) '0=string 1=filename
DisplayWaitDialog hDlg, temp$, 0 '0=string 1=filename
End If
End Function
Sub DisplayWaitDialog(hParent As Dword, temp$, sFlag&)
Local x As Long, y As Long, w As Long, h As Long, Style&
Local wX As Long, wY As Long, hFont As Dword, hWait As Dword
Dialog Get Client hParent To w,h
wX = 320 : wY = 200 : x = (w-wX)/2 : y = (h-wY)/2
Dialog New Pixels, hParent, "", x, y, wX, wY, %WS_OverlappedWindow To hWait
style& = %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel Or %WS_TabStop
LoadLibrary("riched32.dll") : InitCommonControls
Control Add "RichEdit", hWait, %ID_RichEdit, temp$,0,0,wX,wY, style&, %WS_Ex_ClientEdge
Control Handle hWait, %ID_RichEdit To hRichEdit
Font New "Courier new", 10, 1 To hFont
Control Set Font hWait, %ID_RichEdit, hFont
SendMessage hRichEdit, %WM_SetText, 0, StrPTR(temp$)
SetHexColors(hRichEdit)
Dialog Show Modeless hWait Call hWaitDlgProc
End Sub
CallBack Function hWaitDlgProc() As Long
Local P As Point
Select Case CB.Msg
Case %WM_InitDialog
SetFocus hRichEdit
SendMessage GetDlgItem(CB.Hndl, %ID_RichEdit), %EM_SETSEL, -1, 0 'remove and textbox will be highlighted
P.x = 0 : P.y = 0
SendMessage hRichEdit, %EM_SetScrollPos, 0, VarPTR(p) 'go to top
End Select
End Function
Sub SetHexColors(hRE As Dword) 'assumes 16,3,8 construction
Local i As Long, iLineCount&, P As CharRange, iResult&, cf As CharFormat
cf.cbSize = Len(cf) 'Length of structure
cf.dwMask = %CFM_COLOR 'Set mask to colors only
iLineCount& = SendMessage(hRE, %EM_GetLineCount, 0,0)
For i = 0 To iLineCount& - 1
'starting point of each line
SendMessage hRE, %EM_LineIndex, i, 0 To P.cpmin 'position of 1st char in start line
'select 1-16, set to red text
P.cpmax = P.cpmin + 24
SendMessage hRE, %EM_EXSetSel, 0, VarPTR(P) To iResult&
cf.crTextColor = %Red
SendMessage(hRE, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPTR(cf))
'select 20-27, set to blue text
P.cpmin = P.cpmin + 27
P.cpmax = P.cpmin + 8
SendMessage hRE, %EM_EXSetSel, 0, VarPTR(P) To iResult&
cf.crTextColor = %Blue
SendMessage(hRE, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPTR(cf))
Next i
End Sub
Function HexString(t$, sFlag&) As String '0=string 1=filename
Dim temp$, filedata$, a$, b$, c$, i As Long, temp2$
If sFlag& Then Open t$ For Binary As #1 : Get$ #1, Lof(1), t$ : Close #1
For i = 1 To Len(t$)
b$ = Mid$(t$,i,1)
temp2$ = temp2$ + IIf$(Verify (b$, Chr$(65 To 90, 97 To 122)),".",b$)
a$ = IIf$(Len(Hex$(Asc(b$))) = 1, " 0", " ")
c$ = IIf$(i Mod 8, "", Space$(3) + temp2$ + $CrLf)
temp$ = temp$ + a$ + Hex$(Asc(b$)) + c$
If i Mod 8 = 0 Then temp2$ = ""
Next i
temp$ = temp$ + Space$((8-(Len(t$) Mod 8))*3+3) + temp2$
Function = temp$
End Function
'gbs_00152
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm