'===========================================================================
' Subject: HEX VIEWER                         Date: 04-25-96 (21:10)       
'  Author: Rob Smetana                        Code: QB, QBasic, PDS        
'  Origin: Calvin French                    Packet: BINARY.ABC
'===========================================================================
'>I guess I'll have to use QB to write a hex viewer to look at my
'>directory listings.  Then I'll be able to see if the first

'    Calvin French has a hex viewer he posted here.  This is the
'    optimized code reposted by Rob Smetana.

' Look for <rws> for some of the major changes.  A challenge to you:
'
' * Replace "Print" with a "quickprint" routine (Victor's FastPrint?).
' * Adapt this so one could "page" through huge files.
' * Add ScrollUp/ScrollDown options to this needn't re-paint
'   the entire screen each line down/up.  BIOS function 10h
'   services 6h/7h are easy to implement using Call Interrupt.

DEFINT A-Z
DECLARE FUNCTION HexLine$ (Bytes$, FPtr%)  'replaces hvGetLinHex$
DECLARE FUNCTION YesOrNo% (Text$)
DECLARE FUNCTION CheckFile% (File$)
DECLARE SUB HexView (File$)
DECLARE SUB hvDrawScreen (File$)
DECLARE SUB hvInfoLine (Text$)
DECLARE FUNCTION hvCheckFile (File$)
DIM SHARED FLen AS LONG
DIM SHARED FPtr AS LONG         '...Use a long Calvin.  We don't
                                '   need this here, but ...

c$ = COMMAND$                   '...QBASIC users remove this

COLOR 15, 1: CLS
IF LEN(c$) = 0 THEN
  PRINT "HexView 1.0 by Calvin French"
  LINE INPUT "View which file:  "; File$
  IF LEN(File$) = 0 THEN END
ELSE
  File$ = c$
END IF
IF CheckFile(File$) = 0 THEN PRINT File$; " not found!": END
HexView File$

FUNCTION CheckFile (File$)
    OPEN File$ FOR BINARY AS #1
    IF LOF(1) = 0 THEN
        CLOSE : KILL File$
    ELSE
    CLOSE : CheckFile = -1
    END IF
END FUNCTION

FUNCTION HexLine$ (Bytes$, FPtr)
    SHARED FLen AS LONG
    '...<rws> Eliminate string creation/concatenation.
    DIM Lin AS STRING * 78, ThisChar AS STRING * 2, Temp AS STRING * 1
    LSET Lin = ""                   '...always start clean
    Offset = 2
    FOR x = 1 TO 16
        IF FPtr + x > FLen THEN EXIT FOR
        LSET Temp = MID$(Bytes$, FPtr + x - 1, 1)
        Tmp = ASC(Temp)
        '...<rws> If we use an ASM "QuickPrint" routine, the following
        '   wouldn't be necessary and we could display ALL chars.
        SELECT CASE Tmp
            CASE 7, 9 TO 13, 28 TO 31: LSET Temp = "."
        END SELECT
        MID$(Lin, 60 + x, 1) = Temp
        IF Tmp < 16 THEN            '...insist on 2-byte values
            LSET ThisChar = "0" + HEX$(Tmp)
        ELSE
            LSET ThisChar = HEX$(Tmp)
        END IF
        MID$(Lin, Offset, 2) = ThisChar
        IF x = 8 THEN
            Offset = Offset + 7
        ELSE
            Offset = Offset + 3
        IF (x MOD 2) = 0 THEN Offset = Offset + 1
        END IF
NEXT
HexLine$ = Lin
END FUNCTION

SUB HexView (File$)
    FPtr = 1
    DIM LastFPtr AS LONG     '...you'll need LONG for large files
    '...<rws> Eliminate Keys$, etc.; use faster integer compares below.
    hvDrawScreen File$
    '...<rws> Calvin, "Len = 1" has no affect in Binary mode
    OPEN File$ FOR BINARY AS #1
    FLen = LOF(1)
    IF FLen > 32000 THEN FLen = 32000    '...keep it small here
    '...<rws> Eliminate slow, 2-byte GETs.  Do it in 1 gulp.
    Bytes$ = SPACE$(FLen): GET #1, , Bytes$: CLOSE
    '...<rws> No need to DIM Lines$(); just print HexLine$.
DO
    LOCATE , , 0: COLOR 15, 1
    '...<rws> Replace 3 loops with 1.
    '   Instead of checking LastFPtr <> FPtr inside For/Next,
    '   skip the entire loop and speed up the process.
    IF LastFPtr <> FPtr THEN
        FOR n = 0 TO 20
            LOCATE n + 3, 2
            PRINT HexLine$(Bytes$, FPtr + n * 16);
            LOCATE , 80:  PRINT CHR$(176);
        NEXT
    END IF
    LastFPtr = FPtr
    LOCATE 3 + (FPtr / FLen) * 21, 80: PRINT CHR$(178);
    LOCATE 24, 3: PRINT USING "*###########,*"; FPtr;
    LOCATE 2, 1, 1  '(distracting?) LOCATE 2, 1, 1, 0, 15
    DO: Key$ = INKEY$: LOOP UNTIL LEN(Key$)
    '...<rws> Use numeric compares for speed (since we thrash a lot).
    Ky = ASC(RIGHT$(Key$, 1)): IF LEN(Key$) = 2 THEN Ky = -Ky
    SELECT CASE Ky
    CASE -80, -77       '...Down/Right
        FPtr = FPtr + 16
    CASE -72, -75       '...Up/Left
        FPtr = FPtr - 16
    CASE 43, 61         '...plus/=
        FPtr = FPtr + 1
        IF FPtr > FLen - 1 THEN FPtr = FLen - 1
    CASE 45             '...minus
        FPtr = FPtr - 1
    CASE -73            '...PgUp
        FPtr = FPtr - 346
    CASE -81            '...PgDn
        FPtr = FPtr + 346
    CASE -79            '...End
        FPtr = FLen - 346
    CASE -71            '...Home
        FPtr = 1
    CASE 27, 113, 81    '...Esc, Q/q
        IF YesOrNo(" Exit program to DOS? ") THEN COLOR 7, 0: CLS : END
    END SELECT
    '...<rws> Do once instead of several times above.
    IF FPtr > FLen - 320 THEN FPtr = FLen - 320
    IF FPtr < 1 THEN FPtr = 1
LOOP
END SUB

SUB hvDrawScreen (File$)    ' note line concantenation below!
COLOR 15, 4
PRINT " HexView v1.0 Hex Viewer                                 " + ""+"    Calvin French 1993 "
'...<rws>  Why print this in the main loop?
hvInfoLine "[Q]uit  [+,-]byte  [Up,Dn]line  [PgUp,PgDn]pages " + ""+" [Home,End]file"
COLOR 15, 1: LOCATE 2, 1: PRINT CHR$(254);
COLOR 15, 1: PRINT STRING$(77, 196); CHR$(180)
LOCATE 2, 40 - (LEN(File$) + 2) \ 2: PRINT CHR$(180);
COLOR 15, 3: PRINT " "; UCASE$(LTRIM$(RTRIM$(File$))); " ";
COLOR 15, 1: PRINT CHR$(195)
'...<rws> Needn't print chr$(176); we'll do it later.
FOR n = 3 TO 23: PRINT CHR$(179): NEXT
PRINT CHR$(192); STRING$(77, 196); CHR$(180);
'...<rws> Eliminate DEG SEG approach (why limit to color monitors?)
COLOR 0, 7
LOCATE 2, 80: PRINT CHR$(24);
LOCATE 24, 80: PRINT CHR$(25);
END SUB

SUB hvInfoLine (Text$)
    LOCATE 25, 1: COLOR 15, 3: PRINT SPACE$(80);
    LOCATE 25, 40 - LEN(Text$) \ 2: PRINT Text$;
END SUB

FUNCTION YesOrNo (Text$)
    PCOPY 0, 1
    x1 = 40 - LEN(Text$) \ 2: x2 = 40 + LEN(Text$) \ 2
    a$ = SPACE$(x2 - x1 + 8)
    COLOR 14, 4: LOCATE 9, x1 - 4
    PRINT CHR$(218); STRING$(x2 - x1 + 8, 196); CHR$(191)
    LOCATE , x1 - 4: PRINT CHR$(179); a$; CHR$(179)
    LOCATE , x1 - 4: PRINT CHR$(179); a$; CHR$(179)
    LOCATE , x1 - 4: PRINT CHR$(179); a$; CHR$(179)
    LOCATE , x1 - 4
    PRINT CHR$(192); STRING$(x2 - x1 + 8, 196); CHR$(217);
    COLOR 8, 0
    FOR n = x1 - 2 TO x2 + 7
        LOCATE 14, n: PRINT CHR$(SCREEN(14, n));
    NEXT
    FOR n = 10 TO 14
        LOCATE n, x2 + 6: PRINT CHR$(SCREEN(n, x2 + 6));
        LOCATE , x2 + 7: PRINT CHR$(SCREEN(n, x2 + 7));
    NEXT
    COLOR 15, 4: LOCATE 11, x1: PRINT Text$; " ";
    COLOR 14, 0: PRINT "N"; CHR$(29);
    LOCATE , , 1, 14, 15: DO: Key$ = INKEY$: LOOP UNTIL LEN(Key$)
    '...<rws> Eliminate duplicitous & unneeded code.
    IF UCASE$(Key$) = "Y" THEN YesOrNo = -1
    PCOPY 1, 0
END FUNCTION