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

Inspect Any File Program for PB DLL 6.X

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

  • Inspect Any File Program for PB DLL 6.X

    ' Inspect Any File Program for PB for Windows.
    '
    ' Works now with both PBWin 6.x and 7.x
    '
    ' You can see the hex codes and characters at the same time.
    ' Files of any size can be read and displayed.
    ' A previously presented virtual list box is used to display
    ' the data.
    '
    ' This version includes inspection of text-data in the clipboard.
    '
    ' November 16, 2003: A BYTE SEQUENCE SEARCH has been added.
    '
    ' Erik Christensen ---- e.chr@email.dk
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    %NOANIMATE    = 1
    %NOCOMBO      = 1
    %NODRAGLIST   = 1
    %NOHEADER     = 1
    %NOIMAGELIST  = 1
    %NOLISTVIEW   = 1
    %NOSTATUSBAR  = 1
    %NOTABCONTROL = 1
    %NOTOOLBAR    = 1
    %NOTOOLTIPS   = 1
    %NOTREEVIEW   = 1
    %NOUPDOWN     = 1
    #INCLUDE "win32api.inc"
    #INCLUDE "commctrl.inc"
    #INCLUDE "COMDLG32.INC"
    ' ----------------------------------------------------------
    %Form1_FILE                                     = 500
    %Form1_OPENFILE                                 = 510
    %Form1_CLIPBOARD                                = 515
    %Form1_EXIT                                     = 525
    %Form1_FIND                                     = 530
    '
    %ListBox            = 100
    %TextOfListItems    = 105
    %RowHeaderList      = 110
    %RowIdent           = 120
    %Characters         = 125
    %VertScrollbar      = 135
    %SearchResult       = 140
    '
    %HiddenListbox      = 200
    '
    %FindLabel1         = 400
    %FindLabel2         = 405
    %FindText1          = 410
    %FindText2          = 412
    %Find               = 415
    %FindClose          = 420
    %Frame              = 425
    %OptionDown         = 430
    %OptionUp           = 435
    ' --------------------------------------------------
    DECLARE SUB ShowListDialog(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION ListDialogProc
    DECLARE CALLBACK FUNCTION CBF_Header()
    DECLARE CALLBACK FUNCTION CBF_Exit()
    DECLARE CALLBACK FUNCTION CBF_ListBox()
    DECLARE SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
    DECLARE FUNCTION FilNameOpen() AS LONG
    DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION TextFromClipboard(Txt AS STRING) AS LONG
    DECLARE CALLBACK FUNCTION CBF_FindText()
    DECLARE CALLBACK FUNCTION CBF_Find()
    DECLARE CALLBACK FUNCTION CBF_FindClose()
    DECLARE CALLBACK FUNCTION CBF_Text1()
    DECLARE CALLBACK FUNCTION CBF_Text2()
    ' --------------------------------------------------
    GLOBAL Brush&
    GLOBAL hListForm&           ' Dialog handle
    GLOBAL hFindForm&
    GLOBAL Rows AS LONG         ' Total number of rows in array
    GLOBAL PageRows AS LONG     ' Number of rows on a page
    GLOBAL siY AS SCROLLINFO
    GLOBAL PrevKey AS LONG      ' Previously pressed key
    GLOBAL gOldSubClassProc&
    GLOBAL PathAndFile AS ASCIIZ * %MAX_PATH  ' path and file for opened file
    GLOBAL XCR!,YCR!            ' conversion factors from pixels to dialog units
    GLOBAL XMaxScr AS LONG
    GLOBAL YMaxScr AS LONG
    GLOBAL hForm1_Menu0&
    GLOBAL hForm1_Menu1&
    GLOBAL hForm1_Menu2&
    GLOBAL FileStr$
    GLOBAL LenFileStr&,FilePos&
    GLOBAL LogPixelsY AS LONG ' pixels per inch of screen height
    GLOBAL LogPixelsX AS LONG ' pixels per inch of screen width
    GLOBAL Text1$,Text2$
    ' --------------------------------------------------
    '
    FUNCTION PBMAIN
        LOCAL hDC AS LONG
        LOCAL Count&
        Brush&=CreateSolidBrush(RGB(196,196,196))  ' light grey
        'Retrieves a handle of a display device context (DC) for the
        'client area of the specified window (here the desktop).
        hDC = GetDC(%HWND_DESKTOP)
        '
        'Retrieves device-specific information about the number
        'of pixels per logical inch along the screen height and width
        '(depends on screen resolution setting).
        'This is important to define appropriate font sizes.
        LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
        LogPixelsX  = GetDeviceCaps(hDC, %LOGPIXELSX)
        '
        ReleaseDC %HWND_DESKTOP, hDC
        ShowListDialog 0
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
        DeleteObject Brush&
    END FUNCTION
    ' --------------------------------------------------
    '
    FUNCTION XDU(XPct AS SINGLE) AS LONG  ' X transformation function just for this program
        XDU=XPct*790*0.01/XCR!
    END FUNCTION
    '
    FUNCTION YDU(YPct AS SINGLE) AS LONG  ' Y transformation function just for this program
        YDU=YPct*543*0.01/1.90
    END FUNCTION
    '
    SUB ShowListDialog(BYVAL hParent&)
        LOCAL Style&, ExStyle&,hCtl&,i&,j&
        LOCAL X&,Y&,X1&,Y1&,hDlg&,res&
        LOCAL Correct AS LONG
        XMaxScr=GetSystemMetrics(%SM_CXFULLSCREEN)
        IF XMaxScr >800 THEN XMaxScr=800
        YMaxScr=GetSystemMetrics(%SM_CYFULLSCREEN)
        IF YMaxScr >543 THEN YMaxScr=543
        X&=300: Y&=200
        DIALOG NEW 0,"",,,X&,Y&, %WS_VISIBLE, TO hDlg&
        DIALOG UNITS hDlg&, X&, Y& TO PIXELS X1&, Y1&
        DIALOG END hDlg&
        XCR!=X1&*10000/X&: XCR!=XCR!/10000
        YCR!=Y1&*10000/Y&: YCR!=YCR!/10000
            IF XCR!>1.75 THEN ' large characters Windows setting
            Correct = 0
        ELSE                  ' small characters Windows setting
            Correct = 40
        END IF
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hParent&, "Inspect Any File Program: Hex Codes And Characters", 0, 0,XDU(99.8),YDU(82), Style&, ExStyle& TO hListForm&
        CONTROL ADD LISTBOX, hListForm&,%ListBox, , XDU(11.5),YDU(6.65),XDU(84.8)-Correct,YDU(59.41)-Correct/5, _
           %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ListBox
        CONTROL SEND hListForm&,%ListBox,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
        '
        ' Make a small (and therefore automatically hidden) listbox to receive keyboard input when having the focus.
        ' Since this listbox needs to be active, you should not hide it by using any specific command to that effect.
        ' If you make its height small as here, it will be hidden automatically.
        CONTROL ADD LISTBOX, hListForm&, %HiddenListbox,, XDU(1),YDU(85),XDU(15),YDU(1), _
            %WS_CHILD OR %LBS_NOTIFY
        '
        CONTROL ADD SCROLLBAR, hListForm&,%VertScrollbar,"" , XDU(96.3)-Correct,YDU(6.65),XDU(2.6),YDU(56.4)-Correct/3.4, _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        CONTROL ADD LISTBOX, hListForm&,  %RowHeaderList, ,XDU(0.8),YDU(6.65),XDU(10.8),YDU(59.4)-Correct/5, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTICOLUMN OR %WS_BORDER OR %WS_TABSTOP CALL CBF_Header
        CONTROL SEND hListForm&,%RowHeaderList,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
        CONTROL ADD LABEL, hListForm&,  %RowIdent," Byte", XDU(1.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&,  %TextOfListItems," Hex values",XDU(12.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&, %Characters,"Characters", XDU(70)-Correct*1.8,YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD LABEL, hListForm&, %SearchResult,"", XDU(5),YDU(69.4),XDU(90),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        ' Set focus to hidden list (away from the shown listbox). Thus the
        ' automatic internal movements will just affect that hidden list. The
        ' movements specified in the program can then affect the shown listbox without
        ' being hampered by any "internal" automatic keyboard movements in this
        ' control.
        CONTROL SET FOCUS hListForm&, %HiddenListbox
        ' ---------------------------
        MENU NEW BAR TO hForm1_Menu0&
        ' ---------------------------
        MENU NEW POPUP TO hForm1_Menu1&
        MENU ADD POPUP, hForm1_Menu0& ,"&File", hForm1_Menu1&, %MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu1&, "&Open File", %Form1_OPENFILE, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "Get Data From &Clipboard", %Form1_CLIPBOARD, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
        MENU NEW POPUP TO hForm1_Menu2&
        MENU ADD POPUP, hForm1_Menu0& ,"Fi&nd", hForm1_Menu2&,%MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu2&, "&Find", %Form1_FIND,%MF_GRAYED
        MENU ATTACH hForm1_Menu0&, hListForm&
        '
        DIALOG SHOW MODELESS hListForm& , CALL ListDialogProc
    END SUB
    ' --------------------------------------------------
    '
    CALLBACK FUNCTION ListDialogProc
        LOCAL hCtl&,j&,Result&,Res&
        SELECT CASE CBMSG
            CASE %WM_INITDIALOG
                ' Make subclassing to the hidden list (away from the shown listbox
                ' control). When having the focus this hidden list will receive
                ' the keyboard input. Thus the automatic internal movements will
                ' then take place in that hidden list (not in the shown listbox).
                CONTROL HANDLE CBHNDL, %HiddenListbox TO hCtl&
                gOldSubClassProc = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassKeys))
                '
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINEDOWN      : INCR siY.nPos
                    CASE %SB_PAGEDOWN      : siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %SB_LINEUP        : DECR siY.nPos
                    CASE %SB_PAGEUP        : siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %SB_THUMBTRACK,%SB_THUMBPOSITION
                        ' This code allows for tracking above the 16-bit limit (65536) of HIWRD
                        ' Proposed by Borje Hagsten
                        siY.cbSize = SIZEOF(siY)
                        siY.fMask  = %SIF_TRACKPOS
                        CONTROL SEND CBHNDL, %VertScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siY)
                        siY.nPos   = siY.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                ' Ensure that position is within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            CASE %WM_DESTROY
                ' Important! Remove the subclassing
                SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassProc
            ' -----------------------------------------------
            CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE %RowHeaderList
                        SetTextColor CBWPARAM, RGB(0,0,0)
                        SetBkColor   CBWPARAM, RGB(196,196,196)
                        FUNCTION=Brush&
                    CASE ELSE
                        FUNCTION=0
                END SELECT
            CASE %WM_COMMAND
                ' Process Messages to Controls that have no Callback Function
                ' and Process Messages to Menu Items
                SELECT CASE CBCTL
                    CASE  %Form1_OPENFILE
                        IF FilNameOpen() THEN
                            FilePos&=0
                            CONTROL SET TEXT hListForm&, %SearchResult,""
                            Rows = CEIL(LenFileStr& / 15)
                            Rows = MAX(16,Rows)
                            ' Number of rows in a displayed page
                            PageRows=16
                            ' Define vertical scrollbar
                            siY.cbSize = SIZEOF(siY)
                            siY.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                            siY.nMin   = 1
                            siY.nMax   = Rows
                            siY.nPage  = PageRows
                            siY.nPos   = 1
                            CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
                            '
                            ' Fill window with data. This "rocking" of the window refreshes it.
                            CALL UpdateWindowAndScrollbar (2)
                            CALL UpdateWindowAndScrollbar (1)
                            EnableMenuItem hForm1_Menu2& ,%Form1_FIND, %MF_BYCOMMAND OR %MF_ENABLED
                        END IF
                        FUNCTION = 1 : EXIT FUNCTION
                    CASE  %Form1_CLIPBOARD
                        IF TextFromClipboard(FileStr$) = 0 THEN EXIT FUNCTION
                        EnableMenuItem hForm1_Menu2& ,%Form1_FIND, %MF_BYCOMMAND OR %MF_ENABLED
                        LenFileStr& = LEN(FileStr$)
                        FilePos&=0
                        CONTROL SET TEXT hListForm&, %SearchResult,""
                        Rows = CEIL(LenFileStr& / 15)
                        Rows = MAX(16,Rows)
                        ' Number of rows in a displayed page
                        PageRows=16
                        ' Define vertical scrollbar
                        siY.cbSize = SIZEOF(siY)
                        siY.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                        siY.nMin   = 1
                        siY.nMax   = Rows
                        siY.nPage  = PageRows
                        siY.nPos   = 1
                        CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
                        '
                        ' Fill window with data. This "rocking" of the window refreshes it.
                        CALL UpdateWindowAndScrollbar (2)
                        CALL UpdateWindowAndScrollbar (1)
                        FUNCTION = 1 : EXIT FUNCTION
                    CASE  %Form1_EXIT
                        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                        IF res&=%IDYES THEN DIALOG END hListForm&
                    CASE  %Form1_FIND
                        CALL FindCellForm(CBHNDL)
                        CONTROL SET FOCUS hListForm&, %HiddenListbox
                END SELECT
            CASE ELSE
        END SELECT
        ' Enable redrawing of listbox
        CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%TRUE,0 TO Result&
    END FUNCTION
    ' --------------------------------------------------
    CALLBACK FUNCTION SubClassKeys
        ' Subclass callback function for processing key messages.
        ' Inspired by Lance Edmonds who provided a fine example in the Source Code Forum
        LOCAL Result&
        '
        SELECT CASE CBMSG
            CASE %WM_KEYDOWN ' Keys at time of pressing
                SELECT CASE CBWPARAM
                    CASE %VK_UP,%VK_LEFT    : DECR siY.nPos
                    CASE %VK_DOWN,%VK_RIGHT : INCR siY.nPos
                    CASE %VK_PGUP  :   siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %VK_PGDN  :   siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %VK_HOME  :   siY.nPos = 0
                    CASE %VK_END   :   siY.nPos = Rows
                    CASE ELSE
                END SELECT
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            CASE %WM_KEYUP ' Keys at time of release (not used)
            CASE %WM_CHAR  ' Any character key at time of pressing (not used)
        END SELECT
        ' Pass the message on to the original window procedure... the DDT engine!
        FUNCTION = CallWindowProc(gOldSubClassProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    ' --------------------------------------------------
    SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
        ' Updates the listbox data to be presented after scrolling.
        LOCAL j&,Res&,I&,K&,T$,T2$,T3$
        STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
        IF yPos<>yPrevPos THEN ' Moved
            CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
            ' Update vertical scroll bar
            siY.fMask = %SIF_POS
            CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
            '
            CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
            CONTROL SEND hListForm&,%ListBox,%LB_RESETCONTENT,0,0
            IF FileStr$<>"" THEN
                FOR j&=yPos TO yPos + PageRows - 1
                    ' Update row header list
                    LISTBOX ADD hListForm&,%RowHeaderList,RIGHT$("         "+STR$((j&-1)*15+1)+"-",8)
                    ' Update window data
                    T2$="": T3$=""
                    FOR I& = (j&-1)*15+1 TO j&*15
                        IF I& > LenFileStr& THEN EXIT FOR
                        K& = ASC(MID$(FileStr$,I&,1))
                        T2$ = T2$ + RIGHT$("0"+HEX$(K&),2) + " "
                        IF I& MOD 5 = 0 THEN T2$ = T2$ + " "
                        IF K& < 32 THEN K& = 46
                        T3$ = T3$ + CHR$(K&)
                    NEXT
                    LISTBOX ADD hListForm&,%ListBox," "+LEFT$(T2$+SPACE$(48), 48) + T3$
                NEXT
            END IF
        END IF
        ' New "previous" position to be remembered for the next update call
        yPrevPos=yPos
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_ListBox
        IF CBCTLMSG=%LBN_SELCHANGE THEN
            CONTROL SET FOCUS hListForm&, %HiddenListbox
        END IF
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilNameOpen() AS LONG
       LOCAL Path   AS STRING ,FilNum AS LONG
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
       LOCAL txt AS ASCIIZ *(%MAX_PATH+20)
       Path = FilePath(PathAndFile)
       f = FileNam(PathAndFile)
       Style    = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       IF OpenFileDialog(0, "Open File", f, Path, _
         "Text File|*.txt|All Files|*.*", "txt", Style) THEN
          PathAndFile=f
          ' Put file content in FileStr$
          FilNum = FREEFILE
          OPEN PathAndFile FOR BINARY AS #FilNum
          GET$ #FilNum,LOF(FilNum),FileStr$
          CLOSE #FilNum
          LenFileStr& = LEN(FileStr$)
          txt="Inspect File: "+PathAndFile+"     Bytes:"+STR$(LenFileStr&)
          SetWindowText hListForm&,txt
          FUNCTION = 1
       END IF
       CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION TextFromClipboard(Txt AS STRING) AS LONG
        ' Peter Stephensen has provided this function.
        LOCAL hData AS ASCIIZ PTR
        IF OpenClipboard(%NULL) = 0 THEN EXIT FUNCTION
        ' You may change the following line to get clipboard data in other formats
        hData = GetClipboardData (%CF_TEXT)
        CloseClipboard
        Txt = @hData
        SetWindowText hListForm&,"Inspect Clipboard Text Data     Bytes:"+STR$(LEN(txt))
        FUNCTION = 1
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = MID$(Src, x + 1)
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = LEFT$(Src, x)
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Exit
        LOCAL res&
        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Exit Program?")
        IF res&=%IDYES THEN DIALOG END hListForm&
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Header
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    ' Code section for finding a certain byte sequence
    ' ------------------------------------------------
    SUB FindCellForm(BYVAL hListForm&) ' make and display Find form
        LOCAL Style&, ExStyle&, Count&
        Style& = %DS_MODALFRAME OR %WS_CAPTION OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hListForm&, "Find byte sequence", 0, 0,  250,  80, Style&, ExStyle& TO hFindForm&
        CONTROL ADD LABEL, hFindForm&,  %FindLabel1,"Characters:", 1, 11, 45, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
        CONTROL ADD TEXTBOX, hFindForm&,%FindText1, Text1$, 50, 10, 190, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_AUTOHSCROLL,%WS_EX_CLIENTEDGE CALL CBF_Text1
        CONTROL SEND hFindForm&,%FindText1,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
        CONTROL ADD LABEL, hFindForm&,  %FindLabel2,"Hex-Code:", 1, 33, 45, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
        CONTROL ADD TEXTBOX, hFindForm&,  %FindText2,  Text2$, 50, 32, 190, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_AUTOHSCROLL OR %ES_UPPERCASE,%WS_EX_CLIENTEDGE CALL CBF_Text2
        CONTROL SEND hFindForm&,%FindText2,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
        CONTROL ADD FRAME, hFindForm&, %Frame, "Direction",11,48,80,24
        CONTROL ADD OPTION, hFindForm&, %OptionUp, "&Up",16,59,20,12 , %WS_GROUP
        CONTROL ADD OPTION, hFindForm&, %OptionDown, "&Down",55,59,30,12
        CONTROL SEND hFindForm&, %OptionDown,%BM_SETCHECK,%BST_CHECKED,0
        CONTROL ADD BUTTON, hFindForm&,  %Find,  "&Find Next", 150, 60, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Find
        CONTROL ADD BUTTON, hFindForm&,  %FindClose,  "&Close", 200, 60, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FindClose
        CONTROL SET FOCUS hFindForm&,%FindText1
        DIALOG SHOW MODELESS hFindForm&
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Find
        LOCAL hCtl&,i&,t$,res&
        STATIC SearchStart&
        IF CBCTL = %Find AND CBCTLMSG = %BN_CLICKED THEN
            CONTROL GET TEXT hFindForm&, %FindText2 TO text2$
            t$="" ' Transform HEX-codes to string format.
            FOR i=1 TO LEN(text2$) STEP 2
                t$=t$+CHR$(VAL("&H0"+MID$(text2$,i,2)))
            NEXT
            CONTROL SEND CBHNDL,%OptionDown,%BM_GETCHECK,0,0 TO res& ' Get search direction
            IF res&=%BST_CHECKED THEN SearchStart&=FilePos&+1 ELSE SearchStart&=FilePos&-LenFileStr&-1
            i = INSTR(SearchStart&,FileStr$,t$)
            IF i>0 THEN ' String found
                FilePos& = i
                CONTROL SET TEXT hListForm&, %SearchResult,"Last Find: """+text2$+""" or """+text1$+""" was found at byte:"+STR$(i)
                ' Scroll to place match on first line if possible
                siY.nPos = CEIL(i/15)
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            ELSE
                MSGBOX "No match found",%MB_ICONINFORMATION,"Search result:"
            END IF
        END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FindClose
        DIALOG END hFindForm&
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Text1 ' for first text box
      LOCAL hCtl&,i&
      IF CBCTL = %FindText1 AND CBCTLMSG = %EN_CHANGE THEN
        CONTROL HANDLE CBHNDL, CBCTL TO hCtl&
        '
        ' Set corresponding HEX-code in second text box
        IF hCtl& = GetFocus THEN
            CONTROL GET TEXT CBHNDL, CBCTL TO text1$
            text2$=""
            FOR i=1 TO LEN(text1$)
                text2$=text2$+HEX$(ASC(MID$(text1$,i,1)))
            NEXT
            CONTROL SET TEXT CBHNDL, %FindText2, text2$
            ' The following three statements place caret at end of text and scroll into view.
            CONTROL SEND CBHNDL, %FindText2,%EM_SETSEL,0,-1  ' select all text
            CONTROL SEND CBHNDL, %FindText2,%EM_SETSEL,-1,-1 ' de-select text
            CONTROL SEND CBHNDL, %FindText2,%EM_SCROLLCARET,0,0
        END IF
      END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Text2 ' for second text box
      LOCAL hCtl&,i&,x&
      IF CBCTL = %FindText2 AND CBCTLMSG = %EN_CHANGE THEN
        CONTROL HANDLE CBHNDL, CBCTL TO hCtl&
        '
        ' Set corresponding character codes in first text box
        IF hCtl& = GetFocus THEN
            CONTROL GET TEXT CBHNDL, CBCTL TO text2$
            x&=VERIFY(text2$,"0123456789ABCDEF")
            IF x&>0 THEN ' Remove any invalid HEX-code character.
                text2$=LEFT$(text2$,x&-1)
                CONTROL SET TEXT CBHNDL, CBCTL, text2$
                CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,0,-1
                CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,-1,-1
                CONTROL SEND CBHNDL, CBCTL,%EM_SCROLLCARET,0,0
            ELSEIF LEN(text2$) MOD 2 = 0 THEN ' transform to character code if possible.
                text1$=""
                FOR i=1 TO LEN(text2$) STEP 2
                    x&=VAL("&H0"+MID$(text2$,i,2))
                    IF x&<32 THEN text1$=text1$+"." ELSE text1$=text1$+CHR$(x&)
                NEXT
                CONTROL SET TEXT CBHNDL, %FindText1, text1$
                CONTROL SEND CBHNDL, %FindText1,%EM_SETSEL,0,-1
                CONTROL SEND CBHNDL, %FindText1,%EM_SETSEL,-1,-1
                CONTROL SEND CBHNDL, %FindText1,%EM_SCROLLCARET,0,0
            END IF
        END IF
      END IF
    END FUNCTION


    [This message has been edited by Erik Christensen (edited November 16, 2003).]

  • #2
    ' Inspect Any File Program for PB for Windows.
    '
    ' Works now with both PBWin 6.x and 7.x
    '
    ' In this version you can ALSO see the DECIMAL codes in addition
    ' to the hex codes and characters.
    ' Files of any size can be read and displayed.
    ' A previously presented virtual list box is used to display
    ' the data.
    '
    ' This version includes inspection of text-data in the clipboard.
    '
    ' November 16, 2003: A BYTE SEQUENCE SEARCH has been added.
    '
    ' Erik Christensen ---- e.chr@email.dk
    Code:
    #COMPILE EXE
    #REGISTER NONE
    #DIM ALL
    %NOANIMATE    = 1
    %NOCOMBO      = 1
    %NODRAGLIST   = 1
    %NOHEADER     = 1
    %NOIMAGELIST  = 1
    %NOLISTVIEW   = 1
    %NOSTATUSBAR  = 1
    %NOTABCONTROL = 1
    %NOTOOLBAR    = 1
    %NOTOOLTIPS   = 1
    %NOTREEVIEW   = 1
    %NOUPDOWN     = 1
    #INCLUDE "win32api.inc"
    #INCLUDE "commctrl.inc"
    #INCLUDE "COMDLG32.INC"
    ' ----------------------------------------------------------
    %Form1_FILE                                     = 500
    %Form1_OPENFILE                                 = 510
    %Form1_CLIPBOARD                                = 515
    %Form1_EXIT                                     = 525
    %Form1_FIND                                     = 530
    '
    %ListBox            = 100
    %TextOfListItems    = 105
    %RowHeaderList      = 110
    %RowIdent           = 120
    %DecimCodes         = 122
    %Characters         = 125
    %VertScrollbar      = 135
    %SearchResult       = 140
    '
    %HiddenListbox      = 200
    '
    %FindLabel1         = 400
    %FindLabel2         = 405
    %FindText1          = 410
    %FindText2          = 412
    %Find               = 415
    %FindClose          = 420
    %Frame              = 425
    %OptionDown         = 430
    %OptionUp           = 435
    ' --------------------------------------------------
    DECLARE SUB ShowListDialog(BYVAL hParent&)
    DECLARE CALLBACK FUNCTION ListDialogProc
    DECLARE CALLBACK FUNCTION CBF_Header()
    DECLARE CALLBACK FUNCTION CBF_Exit()
    DECLARE CALLBACK FUNCTION CBF_ListBox()
    DECLARE SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
    DECLARE FUNCTION FilNameOpen() AS LONG
    DECLARE FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
    DECLARE FUNCTION TextFromClipboard(Txt AS STRING) AS LONG
    DECLARE CALLBACK FUNCTION CBF_FindText()
    DECLARE CALLBACK FUNCTION CBF_Find()
    DECLARE CALLBACK FUNCTION CBF_FindClose()
    DECLARE CALLBACK FUNCTION CBF_Text1()
    DECLARE CALLBACK FUNCTION CBF_Text2()
    ' --------------------------------------------------
    GLOBAL Brush&
    GLOBAL hListForm&           ' Dialog handle
    GLOBAL hFindForm&
    GLOBAL Rows AS LONG         ' Total number of rows in array
    GLOBAL PageRows AS LONG     ' Number of rows on a page
    GLOBAL siY AS SCROLLINFO
    GLOBAL PrevKey AS LONG      ' Previously pressed key
    GLOBAL gOldSubClassProc&
    GLOBAL PathAndFile AS ASCIIZ * %MAX_PATH  ' path and file for opened file
    GLOBAL XCR!,YCR!            ' conversion factors from pixels to dialog units
    GLOBAL XMaxScr AS LONG
    GLOBAL YMaxScr AS LONG
    GLOBAL hForm1_Menu0&
    GLOBAL hForm1_Menu1&
    GLOBAL hForm1_Menu2&
    GLOBAL FileStr$
    GLOBAL LenFileStr&,FilePos&
    GLOBAL LogPixelsY AS LONG ' pixels per inch of screen height
    GLOBAL LogPixelsX AS LONG ' pixels per inch of screen width
    GLOBAL Text1$,Text2$
    ' --------------------------------------------------
    '
    FUNCTION PBMAIN
        LOCAL hDC AS LONG
        LOCAL Count&
        Brush&=CreateSolidBrush(RGB(196,196,196))  ' light grey
        'Retrieves a handle of a display device context (DC) for the
        'client area of the specified window (here the desktop).
        hDC = GetDC(%HWND_DESKTOP)
        '
        'Retrieves device-specific information about the number
        'of pixels per logical inch along the screen height and width
        '(depends on screen resolution setting).
        'This is important to define appropriate font sizes.
        LogPixelsY  = GetDeviceCaps(hDC, %LOGPIXELSY)
        LogPixelsX  = GetDeviceCaps(hDC, %LOGPIXELSX)
        '
        ReleaseDC %HWND_DESKTOP, hDC
        ShowListDialog 0
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
        DeleteObject Brush&
    END FUNCTION
    ' --------------------------------------------------
    '
    FUNCTION XDU(XPct AS SINGLE) AS LONG  ' X transformation function just for this program
        XDU=XPct*790*0.01/XCR!
    END FUNCTION
    '
    FUNCTION YDU(YPct AS SINGLE) AS LONG  ' Y transformation function just for this program
        YDU=YPct*543*0.01/1.90
    END FUNCTION
    '
    SUB ShowListDialog(BYVAL hParent&)
        LOCAL Style&, ExStyle&,hCtl&,i&,j&
        LOCAL X&,Y&,X1&,Y1&,hDlg&,res&
        LOCAL Correct AS LONG
        XMaxScr=GetSystemMetrics(%SM_CXFULLSCREEN)
        IF XMaxScr >800 THEN XMaxScr=800
        YMaxScr=GetSystemMetrics(%SM_CYFULLSCREEN)
        IF YMaxScr >543 THEN YMaxScr=543
        X&=300: Y&=200
        DIALOG NEW 0,"",,,X&,Y&, %WS_VISIBLE, TO hDlg&
        DIALOG UNITS hDlg&, X&, Y& TO PIXELS X1&, Y1&
        DIALOG END hDlg&
        XCR!=X1&*10000/X&: XCR!=XCR!/10000
        YCR!=Y1&*10000/Y&: YCR!=YCR!/10000
            IF XCR!>1.75 THEN ' large characters Windows setting
            Correct = 0
        ELSE                  ' small characters Windows setting
            Correct = 40
        END IF
        Style& = %WS_POPUP OR %DS_MODALFRAME OR %WS_CAPTION OR %WS_MINIMIZEBOX OR %WS_SYSMENU OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hParent&, "Inspect Any File Program: Hex Codes And Characters", 0, 0,XDU(99.8),YDU(82), Style&, ExStyle& TO hListForm&
        CONTROL ADD LISTBOX, hListForm&,%ListBox, , XDU(11.5),YDU(6.65),XDU(84.8)-Correct,YDU(59.41)-Correct/5, _
           %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %WS_BORDER OR %WS_TABSTOP CALL CBF_ListBox
        CONTROL SEND hListForm&,%ListBox,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
        '
        ' Make a small (and therefore automatically hidden) listbox to receive keyboard input when having the focus.
        ' Since this listbox needs to be active, you should not hide it by using any specific command to that effect.
        ' If you make its height small as here, it will be hidden automatically.
        CONTROL ADD LISTBOX, hListForm&, %HiddenListbox,, XDU(1),YDU(85),XDU(15),YDU(1), _
            %WS_CHILD OR %LBS_NOTIFY
        '
        CONTROL ADD SCROLLBAR, hListForm&,%VertScrollbar,"" , XDU(96.3)-Correct,YDU(6.65),XDU(2.6),YDU(56.4)-Correct/3.4, _
            %WS_CHILD OR %WS_VISIBLE OR %SBS_VERT
        CONTROL ADD LISTBOX, hListForm&,  %RowHeaderList, ,XDU(0.8),YDU(6.65),XDU(10.8),YDU(59.4)-Correct/5, _
            %WS_CHILD OR %WS_VISIBLE OR %LBS_NOTIFY OR %LBS_MULTICOLUMN OR %WS_BORDER OR %WS_TABSTOP CALL CBF_Header
        CONTROL SEND hListForm&,%RowHeaderList,%WM_SETFONT,GetStockObject(%SYSTEM_FIXED_FONT),MAKLNG(%TRUE,0)
        CONTROL ADD LABEL, hListForm&,  %RowIdent," Byte", XDU(1.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&,  %TextOfListItems," Hex values",XDU(12.5),YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&,  %DecimCodes," Decimal values",XDU(44.5)-Correct*.9,YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE
        CONTROL ADD LABEL, hListForm&, %Characters,"Characters", XDU(81.8)-Correct*2.1,YDU(2.96),XDU(17),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        CONTROL ADD LABEL, hListForm&, %SearchResult,"", XDU(5),YDU(69.4),XDU(90),YDU(3.7), _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER
        ' Set focus to hidden list (away from the shown listbox). Thus the
        ' automatic internal movements will just affect that hidden list. The
        ' movements specified in the program can then affect the shown listbox without
        ' being hampered by any "internal" automatic keyboard movements in this
        ' control.
        CONTROL SET FOCUS hListForm&, %HiddenListbox
        ' ---------------------------
        MENU NEW BAR TO hForm1_Menu0&
        ' ---------------------------
        MENU NEW POPUP TO hForm1_Menu1&
        MENU ADD POPUP, hForm1_Menu0& ,"&File", hForm1_Menu1&, %MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu1&, "&Open File", %Form1_OPENFILE, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "Get Data From &Clipboard", %Form1_CLIPBOARD, %MF_ENABLED
        MENU ADD STRING, hForm1_Menu1&, "E&xit",  %Form1_EXIT, %MF_ENABLED
        MENU NEW POPUP TO hForm1_Menu2&
        MENU ADD POPUP, hForm1_Menu0& ,"Fi&nd", hForm1_Menu2&,%MF_ENABLED
        ' - - - - - - - - - - - - - -
        MENU ADD STRING, hForm1_Menu2&, "&Find", %Form1_FIND,%MF_GRAYED
        MENU ATTACH hForm1_Menu0&, hListForm&
        '
        DIALOG SHOW MODELESS hListForm& , CALL ListDialogProc
    END SUB
    ' --------------------------------------------------
    '
    CALLBACK FUNCTION ListDialogProc
        LOCAL hCtl&,j&,Result&,Res&
        SELECT CASE CBMSG
            CASE %WM_INITDIALOG
                ' Make subclassing to the hidden list (away from the shown listbox
                ' control). When having the focus this hidden list will receive
                ' the keyboard input. Thus the automatic internal movements will
                ' then take place in that hidden list (not in the shown listbox).
                CONTROL HANDLE CBHNDL, %HiddenListbox TO hCtl&
                gOldSubClassProc = SetWindowLong(hCtl&, %GWL_WNDPROC, CODEPTR(SubClassKeys))
                '
            CASE %WM_VSCROLL
                SELECT CASE LOWRD(CBWPARAM)
                    CASE %SB_LINEDOWN      : INCR siY.nPos
                    CASE %SB_PAGEDOWN      : siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %SB_LINEUP        : DECR siY.nPos
                    CASE %SB_PAGEUP        : siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %SB_THUMBTRACK,%SB_THUMBPOSITION
                        ' This code allows for tracking above the 16-bit limit (65536) of HIWRD
                        ' Proposed by Borje Hagsten
                        siY.cbSize = SIZEOF(siY)
                        siY.fMask  = %SIF_TRACKPOS
                        CONTROL SEND CBHNDL, %VertScrollbar, %SBM_GETSCROLLINFO,0, VARPTR(siY)
                        siY.nPos   = siY.nTrackPos
                    CASE ELSE              : EXIT FUNCTION
                END SELECT
                ' Ensure that position is within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            CASE %WM_DESTROY
                ' Important! Remove the subclassing
                SetWindowLong hCtl&, %GWL_WNDPROC, gOldSubClassProc
            ' -----------------------------------------------
            CASE %WM_CTLCOLORMSGBOX , %WM_CTLCOLORBTN, %WM_CTLCOLOREDIT,_
                 %WM_CTLCOLORSTATIC, %WM_CTLCOLORSCROLLBAR, %WM_CTLCOLORLISTBOX
                ' Control colors
                SELECT CASE GetDlgCtrlID(CBLPARAM)
                    CASE %RowHeaderList
                        SetTextColor CBWPARAM, RGB(0,0,0)
                        SetBkColor   CBWPARAM, RGB(196,196,196)
                        FUNCTION=Brush&
                    CASE ELSE
                        FUNCTION=0
                END SELECT
            CASE %WM_COMMAND
                ' Process Messages to Controls that have no Callback Function
                ' and Process Messages to Menu Items
                SELECT CASE CBCTL
                    CASE  %Form1_OPENFILE
                        IF FilNameOpen() THEN
                            FilePos&=0
                            Rows = CEIL(LenFileStr& / 8)
                            CONTROL SET TEXT hListForm&, %SearchResult,""
                            Rows = MAX(16,Rows)
                            ' Number of rows in a displayed page
                            PageRows=16
                            ' Define vertical scrollbar
                            siY.cbSize = SIZEOF(siY)
                            siY.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                            siY.nMin   = 1
                            siY.nMax   = Rows
                            siY.nPage  = PageRows
                            siY.nPos   = 1
                            CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
                            '
                            ' Fill window with data. This "rocking" of the window refreshes it.
                            CALL UpdateWindowAndScrollbar (2)
                            CALL UpdateWindowAndScrollbar (1)
                            EnableMenuItem hForm1_Menu2& ,%Form1_FIND, %MF_BYCOMMAND OR %MF_ENABLED
                        END IF
                        FUNCTION = 1 : EXIT FUNCTION
                    CASE  %Form1_CLIPBOARD
                        IF TextFromClipboard(FileStr$) = 0 THEN EXIT FUNCTION
                        EnableMenuItem hForm1_Menu2& ,%Form1_FIND, %MF_BYCOMMAND OR %MF_ENABLED
                        LenFileStr& = LEN(FileStr$)
                        FilePos&=0
                        CONTROL SET TEXT hListForm&, %SearchResult,""
                        Rows = CEIL(LenFileStr& / 8)
    
                        Rows = MAX(16,Rows)
                        ' Number of rows in a displayed page
                        PageRows=16
                        ' Define vertical scrollbar
                        siY.cbSize = SIZEOF(siY)
                        siY.fMask  = %SIF_ALL   ' = %SIF_RANGE OR %SIF_PAGE OR %SIF_POS
                        siY.nMin   = 1
                        siY.nMax   = Rows
                        siY.nPage  = PageRows
                        siY.nPos   = 1
                        CONTROL SEND CBHNDL, %VertScrollbar, %SBM_SETSCROLLINFO, %FALSE, VARPTR(siY)
                        '
                        ' Fill window with data. This "rocking" of the window refreshes it.
                        CALL UpdateWindowAndScrollbar (2)
                        CALL UpdateWindowAndScrollbar (1)
                        FUNCTION = 1 : EXIT FUNCTION
                    CASE  %Form1_EXIT
                        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"End?")
                        IF res&=%IDYES THEN DIALOG END hListForm&
                    CASE  %Form1_FIND
                        CALL FindCellForm(CBHNDL)
                        CONTROL SET FOCUS hListForm&, %HiddenListbox
                END SELECT
            CASE ELSE
        END SELECT
        ' Enable redrawing of listbox
        CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%TRUE,0 TO Result&
    END FUNCTION
    ' --------------------------------------------------
    CALLBACK FUNCTION SubClassKeys
        ' Subclass callback function for processing key messages.
        ' Inspired by Lance Edmonds who provided a fine example in the Source Code Forum
        LOCAL Result&
        '
        SELECT CASE CBMSG
            CASE %WM_KEYDOWN ' Keys at time of pressing
                SELECT CASE CBWPARAM
                    CASE %VK_UP,%VK_LEFT    : DECR siY.nPos
                    CASE %VK_DOWN,%VK_RIGHT : INCR siY.nPos
                    CASE %VK_PGUP  :   siY.nPos = siY.nPos - siY.nPage + 1
                    CASE %VK_PGDN  :   siY.nPos = siY.nPos + siY.nPage - 1
                    CASE %VK_HOME  :   siY.nPos = 0
                    CASE %VK_END   :   siY.nPos = Rows
                    CASE ELSE
                END SELECT
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            CASE %WM_KEYUP ' Keys at time of release (not used)
            CASE %WM_CHAR  ' Any character key at time of pressing (not used)
        END SELECT
        ' Pass the message on to the original window procedure... the DDT engine!
        FUNCTION = CallWindowProc(gOldSubClassProc, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    ' --------------------------------------------------
    SUB UpdateWindowAndScrollbar (BYVAL yPos AS LONG)
        ' Updates the listbox data to be presented after scrolling.
        LOCAL j&,Res&,I&,K&,T$,T2$,T3$
        STATIC yPrevPos AS LONG  ' previous y-position (remember between calls)
        IF yPos<>yPrevPos THEN ' Moved
            CONTROL SEND hListForm&,%ListBox,%WM_SETREDRAW,%FALSE,0 TO Res&
            ' Update vertical scroll bar
            siY.fMask = %SIF_POS
            CONTROL SEND hListForm&, %VertScrollbar, %SBM_SETSCROLLINFO, %TRUE, VARPTR(siY)
            '
            CONTROL SEND hListForm&,%RowHeaderList,%LB_RESETCONTENT,0,0
            CONTROL SEND hListForm&,%ListBox,%LB_RESETCONTENT,0,0
            IF FileStr$<>"" THEN
                FOR j&=yPos TO yPos + PageRows - 1
                    ' Update row header list
                    LISTBOX ADD hListForm&,%RowHeaderList,RIGHT$("         "+STR$((j&-1)*8+1)+"-",8)
                    ' Update window data
                    T2$="": T3$="" : T$=""
                    FOR I& = (j&-1)*8+1 TO j&*8
                        IF I& > LenFileStr& THEN EXIT FOR
                        K& = ASC(MID$(FileStr$,I&,1))
                        T2$ = T2$ + RIGHT$("0"+HEX$(K&),2) + " "
                        T$ = T$ + RIGHT$("    "+STR$(K&),4)
                        IF K& < 32 THEN K& = 46
                        T3$ = T3$ + CHR$(K&)
                    NEXT
                    LISTBOX ADD hListForm&,%ListBox,LEFT$(T2$+SPACE$(24), 24)+ LEFT$(T$+SPACE$(34),34) + T3$
                NEXT
            END IF
        END IF
        ' New "previous" position to be remembered for the next update call
        yPrevPos=yPos
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_ListBox
        IF CBCTLMSG=%LBN_SELCHANGE THEN
            CONTROL SET FOCUS hListForm&, %HiddenListbox
        END IF
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilNameOpen() AS LONG
       LOCAL Path   AS STRING ,FilNum AS LONG
       LOCAL f      AS STRING
       LOCAL Style  AS DWORD
       LOCAL txt AS ASCIIZ *(%MAX_PATH+20)
       Path = FilePath(PathAndFile)
       f = FileNam(PathAndFile)
       Style    = %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY OR %OFN_LONGNAMES
       IF OpenFileDialog(0, "Open File", f, Path, _
         "Text File|*.txt|All Files|*.*", "txt", Style) THEN
          PathAndFile=f
          ' Put file content in FileStr$
          FilNum = FREEFILE
          OPEN PathAndFile FOR BINARY AS #FilNum
          GET$ #FilNum,LOF(FilNum),FileStr$
          CLOSE #FilNum
          LenFileStr& = LEN(FileStr$)
          txt="Inspect File: "+PathAndFile+"     Bytes:"+STR$(LenFileStr&)
          SetWindowText hListForm&,txt
          FUNCTION = 1
       END IF
       CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION TextFromClipboard(Txt AS STRING) AS LONG
        ' Peter Stephensen has provided this function.
        LOCAL hData AS ASCIIZ PTR
        IF OpenClipboard(%NULL) = 0 THEN EXIT FUNCTION
        ' You may change the following line to get clipboard data in other formats
        hData = GetClipboardData (%CF_TEXT)
        CloseClipboard
        Txt = @hData
        SetWindowText hListForm&,"Inspect Clipboard Text Data     Bytes:"+STR$(LEN(txt))
        FUNCTION = 1
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FileNam(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = MID$(Src, x + 1)
    END FUNCTION
    ' ------------------------------------------------
    FUNCTION FilePath(BYVAL Src AS STRING) AS STRING
      LOCAL x AS LONG
      FOR x = LEN(Src) TO 1 STEP -1
        IF (ASC(Src, x) = 92) OR (ASC(Src, x) = 58) THEN EXIT FOR
      NEXT x
      FUNCTION = LEFT$(Src, x)
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Exit
        LOCAL res&
        res&=MSGBOX ("Are you sure?",%MB_YESNO OR %MB_ICONQUESTION ,"Exit Program?")
        IF res&=%IDYES THEN DIALOG END hListForm&
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Header
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    ' Code section for finding a certain byte sequence
    ' ------------------------------------------------
    SUB FindCellForm(BYVAL hListForm&) ' make and display Find form
        LOCAL Style&, ExStyle&, Count&
        Style& = %DS_MODALFRAME OR %WS_CAPTION OR %DS_CENTER
        ExStyle& = 0
        DIALOG NEW hListForm&, "Find byte sequence", 0, 0,  250,  80, Style&, ExStyle& TO hFindForm&
        CONTROL ADD LABEL, hFindForm&,  %FindLabel1,"Characters:", 1, 11, 45, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
        CONTROL ADD TEXTBOX, hFindForm&,%FindText1, Text1$, 50, 10, 190, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_AUTOHSCROLL,%WS_EX_CLIENTEDGE CALL CBF_Text1
        CONTROL SEND hFindForm&,%FindText1,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
        CONTROL ADD LABEL, hFindForm&,  %FindLabel2,"Hex-Code:", 1, 33, 45, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_RIGHT
        CONTROL ADD TEXTBOX, hFindForm&,  %FindText2,  Text2$, 50, 32, 190, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %ES_AUTOHSCROLL OR %ES_UPPERCASE,%WS_EX_CLIENTEDGE CALL CBF_Text2
        CONTROL SEND hFindForm&,%FindText2,%WM_SETFONT,GetStockObject(%ANSI_FIXED_FONT),%TRUE
        CONTROL ADD FRAME, hFindForm&, %Frame, "Direction",11,48,80,24
        CONTROL ADD OPTION, hFindForm&, %OptionUp, "&Up",16,59,20,12 , %WS_GROUP
        CONTROL ADD OPTION, hFindForm&, %OptionDown, "&Down",55,59,30,12
        CONTROL SEND hFindForm&, %OptionDown,%BM_SETCHECK,%BST_CHECKED,0
        CONTROL ADD BUTTON, hFindForm&,  %Find,  "&Find Next", 150, 60, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_Find
        CONTROL ADD BUTTON, hFindForm&,  %FindClose,  "&Close", 200, 60, 40, 12, _
            %WS_CHILD OR %WS_VISIBLE OR %BS_PUSHBUTTON OR %WS_TABSTOP CALL CBF_FindClose
        CONTROL SET FOCUS hFindForm&,%FindText1
        DIALOG SHOW MODELESS hFindForm&
        DO
            DIALOG DOEVENTS TO Count&
        LOOP UNTIL Count&=0
    END SUB
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Find
        LOCAL hCtl&,i&,t$,res&
        STATIC SearchStart&
        IF CBCTL = %Find AND CBCTLMSG = %BN_CLICKED THEN
            CONTROL GET TEXT hFindForm&, %FindText2 TO text2$
            t$="" ' Transform HEX-codes to string format.
            FOR i=1 TO LEN(text2$) STEP 2
                t$=t$+CHR$(VAL("&H0"+MID$(text2$,i,2)))
            NEXT
            CONTROL SEND CBHNDL,%OptionDown,%BM_GETCHECK,0,0 TO res& ' Get search direction
            IF res&=%BST_CHECKED THEN SearchStart&=FilePos&+1 ELSE SearchStart&=FilePos&-LenFileStr&-1
            i = INSTR(SearchStart&,FileStr$,t$)
            IF i>0 THEN ' String found
                FilePos& = i
                CONTROL SET TEXT hListForm&, %SearchResult,"Last Find: """+text2$+""" or """+text1$+""" was found at byte:"+STR$(i)
                ' Scroll to place match on first line if possible
                siY.nPos = CEIL(i/8)
                ' Ensure that positions are within range
                siY.nPos = MAX&(siY.nMin, MIN&(siY.nPos, siY.nMax - siY.nPage + 1))
                CALL UpdateWindowAndScrollbar (siY.nPos)
            ELSE
                MSGBOX "No match found",%MB_ICONINFORMATION,"Search result:"
            END IF
        END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_FindClose
        DIALOG END hFindForm&
        CONTROL SET FOCUS hListForm&, %HiddenListbox
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Text1 ' for first text box
      LOCAL hCtl&,i&
      IF CBCTL = %FindText1 AND CBCTLMSG = %EN_CHANGE THEN
        CONTROL HANDLE CBHNDL, CBCTL TO hCtl&
        '
        ' Set corresponding HEX-code in second text box
        IF hCtl& = GetFocus THEN
            CONTROL GET TEXT CBHNDL, CBCTL TO text1$
            text2$=""
            FOR i=1 TO LEN(text1$)
                text2$=text2$+HEX$(ASC(MID$(text1$,i,1)))
            NEXT
            CONTROL SET TEXT CBHNDL, %FindText2, text2$
            ' The following three statements place caret at end of text and scroll into view.
            CONTROL SEND CBHNDL, %FindText2,%EM_SETSEL,0,-1  ' select all text
            CONTROL SEND CBHNDL, %FindText2,%EM_SETSEL,-1,-1 ' de-select text
            CONTROL SEND CBHNDL, %FindText2,%EM_SCROLLCARET,0,0
        END IF
      END IF
    END FUNCTION
    ' ------------------------------------------------
    CALLBACK FUNCTION CBF_Text2 ' for second text box
      LOCAL hCtl&,i&,x&
      IF CBCTL = %FindText2 AND CBCTLMSG = %EN_CHANGE THEN
        CONTROL HANDLE CBHNDL, CBCTL TO hCtl&
        '
        ' Set corresponding character codes in first text box
        IF hCtl& = GetFocus THEN
            CONTROL GET TEXT CBHNDL, CBCTL TO text2$
            x&=VERIFY(text2$,"0123456789ABCDEF")
            IF x&>0 THEN ' Remove any invalid HEX-code character.
                text2$=LEFT$(text2$,x&-1)
                CONTROL SET TEXT CBHNDL, CBCTL, text2$
                CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,0,-1
                CONTROL SEND CBHNDL, CBCTL,%EM_SETSEL,-1,-1
                CONTROL SEND CBHNDL, CBCTL,%EM_SCROLLCARET,0,0
            ELSEIF LEN(text2$) MOD 2 = 0 THEN ' transform to character code if possible.
                text1$=""
                FOR i=1 TO LEN(text2$) STEP 2
                    x&=VAL("&H0"+MID$(text2$,i,2))
                    IF x&<32 THEN text1$=text1$+"." ELSE text1$=text1$+CHR$(x&)
                NEXT
                CONTROL SET TEXT CBHNDL, %FindText1, text1$
                CONTROL SEND CBHNDL, %FindText1,%EM_SETSEL,0,-1
                CONTROL SEND CBHNDL, %FindText1,%EM_SETSEL,-1,-1
                CONTROL SEND CBHNDL, %FindText1,%EM_SCROLLCARET,0,0
            END IF
        END IF
      END IF
    END FUNCTION
    [This message has been edited by Erik Christensen (edited November 16, 2003).]

    Comment


    • #3
      The two programs above have been updated to work also with
      PBWin 7.0x.

      Furthermore, text-data in the clipboard can now also be inspected.

      ------------------


      [This message has been edited by Erik Christensen (edited April 27, 2003).]

      Comment


      • #4
        FYI both these hex dump or hex wiewer programs have been improved.
        Now you can search both files and clipboard for a certain byte
        sequence. I needed this feature. I'm sure you will like it too.


        ------------------

        Comment

        Working...
        X