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

File viewer

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

    File viewer

    Code:
    'Requirements - PB9.0, PBforms.inc
    'This program will examine a file and show each byte as hex and ascii.
    'It is similar in appearance to the old PC Tools DOS program
    'It covers 100 bytes at a time. This can be screen by screen in 100 increments,
    'or it can scan through at 1 sec intervals (cannot see how to stop this - the
    'Stop button is there in case anyone else can!
    'It will search for a string and display this at the location (only once).
    'It is not possible to alter values in the file, as you are not actually
    'looking at the file, but a copy in memory.
    'The slide bar can be used for crude positioning, but jumps in 1% of the file
    'size.
    'It does what I wanted it to do, but no doubt others will improve on this -
    'please post your developments (so that I can learn).
    '
    'Iain Johnstone
    'iain at mstdrain dot co dot uk
    
    
    #PBFORMS CREATED V1.51
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    ' The first line in this file is a PB/Forms metastatement.
    ' It should ALWAYS be the first line of the file. Other
    ' PB/Forms metastatements are placed at the beginning and
    ' end of "Named Blocks" of code that should be edited
    ' with PBForms only. Do not manually edit or delete these
    ' metastatements or PB/Forms will not be able to reread
    ' the file correctly.  See the PB/Forms documentation for
    ' more information.
    ' Named blocks begin like this:    #PBFORMS BEGIN ...
    ' Named blocks end like this:      #PBFORMS END ...
    ' Other PB/Forms metastatements such as:
    '     #PBFORMS DECLARATIONS
    ' are used by PB/Forms to insert additional code.
    ' Feel free to make changes anywhere else in the file.
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    #COMPILE EXE
    #DIM ALL
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** Includes **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    #PBFORMS BEGIN INCLUDES
    #IF NOT %DEF(%WINAPI)
        #INCLUDE "WIN32API.INC"
    #ENDIF
    #IF NOT %DEF(%COMMCTRL_INC)
        #INCLUDE "COMMCTRL.INC"
    #ENDIF
    #INCLUDE "PBForms.INC"
    #PBFORMS END INCLUDES
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** Constants **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    #PBFORMS BEGIN CONSTANTS
    %IDC_BUTTON1             = 1003
    %IDC_BUTTON2             = 1004
    %IDC_BUTTON3             = 1005
    %IDC_BUTTON4             = 1008
    %IDC_BUTTON5             = 1009
    %IDC_BUTTON6             = 1013
    %IDC_FRAME1              = 1010
    %IDC_FRAME2              = 1011
    %IDC_GRAPHIC1            = 1001
    %IDC_GRAPHIC2            = 1002
    %IDC_LABEL1              = 1006
    %IDC_LABEL10             = 1022
    %IDC_LABEL11             = 1023
    %IDC_LABEL12             = 1024
    %IDC_LABEL13             = 1025
    %IDC_LABEL2              = 1007
    %IDC_LABEL3              = 1015
    %IDC_LABEL4              = 1016
    %IDC_LABEL5              = 1017
    %IDC_LABEL6              = 1018
    %IDC_LABEL7              = 1019
    %IDC_LABEL8              = 1020
    %IDC_LABEL9              = 1021
    %IDC_MSCTLS_TRACKBAR32_1 = 1027
    %IDC_TEXTBOX1            = 1014
    %IDD_DIALOG1             =  101
    #PBFORMS END CONSTANTS
    GLOBAL wholefile AS STRING
    GLOBAL counter, fonthndl, filesize AS LONG
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** Declarations **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    DECLARE CALLBACK FUNCTION ShowDIALOG1Proc()
    DECLARE FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD,NameOfFile AS STRING,filesize AS LONG) AS LONG
    #PBFORMS DECLARATIONS
    DECLARE SUB FillHex (hDlg AS LONG)
    DECLARE SUB FillAscii(hDlg AS LONG)
    DECLARE SUB FillLabels (hDlg AS LONG)
    DECLARE FUNCTION RangeTrack(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
    DECLARE FUNCTION GetTrack(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** Main Application Entry Point **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    FUNCTION PBMAIN()
        PBFormsInitComCtls (%ICC_WIN95_CLASSES OR %ICC_DATE_CLASSES OR %ICC_INTERNET_CLASSES)
        LOCAL Filter, Dext, zfile, NameOfFile AS STRING
        LOCAL flags AS DWORD
        LOCAL templong AS LONG
    
            FONT NEW "Courier New" ,10, 0, 1, 0, 0 TO fonthndl
    
            NameOfFile=""
            DExt=""
            Filter="All files" + CHR$(0) + "*.*" + CHR$(0)
            flags=0
    
            DISPLAY OPENFILE 0, , ,"Select file","",Filter,"",Dext,Flags TO NameOfFile     '%hwnd_desktop
    
            OPEN NameOfFile FOR BINARY AS #6
                filesize=LOF(#6)
                GET$ #6, filesize, wholefile   'copy file into string
            CLOSE #6
    
            ShowDIALOG1 %HWND_DESKTOP,NameOfFile,filesize
    
    END FUNCTION
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** CallBacks **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    CALLBACK FUNCTION ShowDIALOG1Proc()
        LOCAL stopflag, n, newpos AS LONG
        LOCAL tempstring AS STRING
    
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' Initialization handler
                counter=1
                FillHex CB.HNDL
                FillAscii CB.HNDL
                FillLabels CB.HNDL
                counter=counter+100
    
            CASE %WM_NCACTIVATE
                STATIC hWndSaveFocus AS DWORD
                IF ISFALSE CBWPARAM THEN
                    ' Save control focus
                    hWndSaveFocus = GetFocus()
                ELSEIF hWndSaveFocus THEN
                    ' Restore control focus
                    SetFocus(hWndSaveFocus)
                    hWndSaveFocus = 0
                END IF
    
            CASE %WM_HSCROLL
                IF CB.LPARAM = GetDlgItem(CBHNDL, %IDC_MSCTLS_TRACKBAR32_1) THEN
                     newpos=GetTrack (CBHNDL, %IDC_MSCTLS_TRACKBAR32_1)
                     counter= (NewPos/100)*filesize
                     FillHex CB.HNDL
                     FillAscii CB.HNDL
                     FillLabels CB.HNDL
                END IF
    
    
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CB.CTL
    
                    CASE %IDC_BUTTON1 'next
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            FillHex CB.HNDL
                            FillAscii CB.HNDL
                            FillLabels CB.HNDL
                            IF counter<LEN(wholefile) THEN  counter=counter+100
                        END IF
    
                    CASE %IDC_BUTTON2 'back
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            counter=counter-100:IF counter<1 THEN counter=1
                            FillHex CB.HNDL
                            FillAscii CB.HNDL
                            FillLabels CB.HNDL
                        END IF
    
                    CASE %IDC_BUTTON3 'quit
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            DIALOG END CB.HNDL
                        END IF
    
                    CASE %IDC_BUTTON4 'scan
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                             FOR counter=1 TO LEN(wholefile) STEP 100
                                FillHex CB.HNDL
                                FillAscii CB.HNDL
                                FillLabels CB.HNDL
                                SLEEP 1000
                                IF stopflag=1 THEN EXIT FOR
                             NEXT
                        END IF
    
                    CASE %IDC_BUTTON5 'stop
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                            stopflag=1
                        END IF
    
    
                    CASE %IDC_BUTTON6  'search
                        IF CB.CTLMSG = %BN_CLICKED OR CB.CTLMSG = 1 THEN
                               CONTROL GET TEXT CB.HNDL,%IDC_TEXTBOX1 TO tempstring
                               n=INSTR(wholefile,tempstring)
                               counter=n
                               FillHex CB.HNDL
                               FillAscii CB.HNDL
                               FillLabels CB.HNDL
                        END IF
    
                END SELECT
        END SELECT
    END FUNCTION
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    '   ** Dialogs **
    '------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD,NameOfFile AS STRING,filesize AS LONG) AS LONG
        LOCAL lRslt AS LONG
        LOCAL labels AS STRING
    
        labels="File -  "+NameOfFile+"("+STR$(filesize)+" bytes)."
    #PBFORMS BEGIN DIALOG %IDD_DIALOG1->->
        LOCAL hDlg  AS DWORD
    
        DIALOG NEW hParent, labels, 343, 223, 475, 227, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR %DS_NOFAILCREATE _
            OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC1, "", 50, 15, 180, 160
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC1
        GRAPHIC COLOR -1, %BLACK
        GRAPHIC CLEAR
        CONTROL ADD GRAPHIC, hDlg, %IDC_GRAPHIC2, "", 235, 15, 180, 160
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC2
        GRAPHIC COLOR -1, %BLACK
        GRAPHIC CLEAR
        CONTROL ADD FRAME,   hDlg, %IDC_FRAME1, "", 420, 9, 48, 54
        CONTROL SET COLOR    hDlg, %IDC_FRAME1, %BLACK, %BLACK
        CONTROL ADD FRAME,   hDlg, %IDC_FRAME2, "", 420, 66, 48, 54
        CONTROL SET COLOR    hDlg, %IDC_FRAME2, %BLACK, %BLACK
        CONTROL ADD TEXTBOX, hDlg, %IDC_TEXTBOX1, "", 156, 201, 243, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL1, "Hexadecimal", 51, 3, 177, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL SET COLOR    hDlg, %IDC_LABEL1, %BLUE, -1
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL2, "ASCII", 234, 3, 177, 12, %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        CONTROL SET COLOR    hDlg, %IDC_LABEL2, %BLUE, -1
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL3, "Search string (case sensitive)", 57, 201, 96, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL4, "", 3, 18, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL5, "", 3, 32, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL6, "", 3, 48, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL7, "", 3, 64, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL8, "", 3, 80, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL9, "", 3, 96, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL10, "", 3, 112, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL11, "", 3, 128, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL12, "", 3, 144, 45, 12
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL13, "", 3, 160, 45, 12
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "Next", 426, 18, 36, 18
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON2, "Back", 426, 39, 36, 18
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON3, "Quit", 426, 156, 36, 18
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON4, "Scan", 426, 75, 36, 18
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON5, "Stop", 426, 96, 36, 18
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON6, "Search", 426, 126, 36, 18
        CONTROL ADD "msctls_trackbar32", hDlg, %IDC_MSCTLS_TRACKBAR32_1, "msctls_trackbar32_1", 51, 183, 363, 12, %WS_CHILD OR %WS_VISIBLE OR %TBS_HORZ OR %TBS_BOTTOM OR %TBS_AUTOTICKS
    #PBFORMS END DIALOG
        RangeTrack hDlg, %IDC_MSCTLS_TRACKBAR32_1
    
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
    
    #PBFORMS BEGIN CLEANUP %IDD_DIALOG1
    #PBFORMS END CLEANUP
    
        FUNCTION = lRslt
    END FUNCTION
    '------------------------------------------------------------------------------
    SUB FillLabels (hDlg AS LONG)
        LOCAL w, n, t AS LONG
        w=counter
        t=16
        FOR n=1 TO 160 STEP 16
                CONTROL SET TEXT hDlg, 1000+t,FORMAT$(w,"0000000000"): w =w+10:INCR t
                GRAPHIC SET POS (3,n)
        NEXT
    END SUB
    '==============================================================================
    SUB FillHex (hDlg AS LONG)
        LOCAL n, q, w AS LONG
        LOCAL a AS STRING
    
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC1, REDRAW
        GRAPHIC SET POS (0,0)
        GRAPHIC CLEAR %BLACK,0
        GRAPHIC SET FONT fonthndl
        GRAPHIC COLOR %GREEN, %BLACK
    
        w=counter
        FOR n=1 TO 160 STEP 16      '160=width of graphic window
            FOR q=1 TO 180 STEP 18  '180=height of graphic window
                GRAPHIC SET POS (q,n)
                a=HEX$(ASC(wholefile,w)):IF LEN(a)=1 THEN a="0"+a
                GRAPHIC PRINT a:INCR w
            NEXT
        NEXT
        GRAPHIC REDRAW
        GRAPHIC DETACH
    END SUB
    '==============================================================================
    SUB FillASCII (hDlg AS LONG)
        LOCAL n, q, w, z AS LONG
        LOCAL a AS STRING
    
        GRAPHIC ATTACH hDlg, %IDC_GRAPHIC2, REDRAW
        GRAPHIC SET POS (0,0)
        GRAPHIC CLEAR %BLACK,0
        GRAPHIC SET FONT fonthndl
        GRAPHIC COLOR %GREEN, %BLACK
    
        w=counter
        FOR n=1 TO 160 STEP 16
            FOR q=1 TO 180 STEP 18
            z=(ASC(wholefile,w)):INCR w
                GRAPHIC SET POS (q,n)
                IF z < 32 THEN
                    GRAPHIC PRINT  "."
                ELSE
                    GRAPHIC PRINT  CHR$(z)
                END IF
            NEXT
        NEXT
        GRAPHIC REDRAW
        GRAPHIC DETACH
    END SUB
    '==============================================================================
    FUNCTION RangeTrack(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
        CONTROL SEND hDlg,lID, %PBM_SETSTEP,1,0
        CONTROL SEND hDlg,lID, %TBM_SETRANGE,0, MAKDWD(1,100)
        CONTROL SEND hDlg,lID, %TBM_SETTICFREQ, 10, 1
        CONTROL SEND hDlg,lID, %TBM_SETPOS,1, 1
    END FUNCTION
    '------------------------------------------------------------------------------
    FUNCTION GetTrack(BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG
    LOCAL ThumbPos AS LONG
        CONTROL SEND hDlg, lID, %TBM_GETPOS, 0, 0 TO ThumbPos
        ThumbPos = LOWRD(ThumbPos)
        FUNCTION=ThumbPos
    END FUNCTION
    '------------------------------------------------------------------------------
    “None but those who have experienced them can conceive of the enticements of science” - Mary Shelley
Working...
X
😀
🥰
🤢
😎
😡
👍
👎