Hex Display of String/File

Category: Files/Folders

Date: 03-28-2012

Return to Index


 
'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:
'displays a string (optionally from a file) in Hex format
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#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


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm