Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Hex Display of String/File (Popup Dialog)

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Hex Display of String/File (Popup Dialog)

    Sometimes, I want to see the content of a string (or a file) in hex format - usually when the string is giving me unexpected results.

    Here's a basic function that takes a string and returns a formatted hex display - lines of 8 characters in 2-digit hex, 3 spaces for separation, and then the 8 characters in ASCII. All characters other than letters are displayed as a period.

    I include the basic function in most of my programs - not usually for the user, but for myself to use in debugging string content as needed. The function alone, with a MsgBox can be quite useful. But I've also provided code for a popup dialog, using the function, which includes a richedit control that colors the hex differently from the ASCII.

    The code is provided below, and is also available in the gbSnippets PowerBASIC source code library (snippet# gbs_00152). You can get the entire library by downloading gbSnippets or you can view individual snippets online.

    gbSnippets home page: http://www.garybeene.com/sw/gbsnippets.htm
    Online source code listings: http://www.garybeene.com/power/code/

    If you've already installed gbSnippets, you can ensure that your local library is synchronized with the latest snippets on the gbSnippets server by using the "Actions/Synchronize with gbSnippets Server" menu.

    Here's the output:
    Code:
     42 65 67 69 6E 6E 69 6E   Beginnin
     67 20 6F 66 20 53 61 6D   g.of.Sam
     70 6C 65 20 54 65 78 74   ple.Text
    Here's the formatting function (ascii to hex):
    Code:
    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
    And here's the popup dialog using a richedit control to colorize the hex and ASCII to make it easier to see.

    Code:
    'Compilable Example:
    'displays a string (optionally from a file) in Hex format
    #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
    Last edited by Gary Beene; 28 Sep 2009, 03:10 PM.
Working...
X