'===========================================================================
' Subject: DUMP FILE TO SCREEN                Date: 06-26-93 (18:59)       
'  Author: Jim Giordano                       Code: QB, QBasic, PDS        
'  Origin: FidoNet QUIK_BAS Echo            Packet: TEXT.ABC
'===========================================================================
'Dump by Jim Giordano.  Released for all non-comercial use.
'Note: add DEF SEG commented out below for use with Basic 7.1 PDS

DEFINT A-Z
f$ = COMMAND$
IF f$ = "" THEN
   PRINT : PRINT : INPUT "Enter file name to dump - "; f$
END IF
f$ = LTRIM$(RTRIM$(f$))
IF f$ = "" THEN SYSTEM

OPEN "B", 1, f$, 2048
FLength& = LOF(1)            'Number of bytes to process
IF FLength& = 0 THEN
  PRINT "Error opening filename "; f$; ".  Check for file name error."
  CLOSE #1
  KILL f$ 'eliminate file we just made
  SYSTEM
END IF
TabAmt& = FLength& \ 10      ' 10% tab amount

DIM H$(255), D$(255), aa(255), nn$(255)
FOR i = 0 TO 255
    H$(i) = MID$(HEX$(&H100 + i), 2)
    D$(i) = MID$(STR$(1000 + i), 3)
    IF i < 32 AND (i = 7 OR (i > 8 AND i < 14) OR i > 27) THEN
      aa(i) = -1
    END IF
NEXT i

CLS
ff$ = "Dump of file " + f$
LOCATE 1, (80 - LEN(ff$)) \ 2
PRINT ff$
'FOR I = 1 TO 8: PRINT "....+....|"; : NEXT I
GOSUB BottomStuff

D& = 1 'start at first byte
AddOpt = -1  '-1 for decimal, 0 for hex

LinesOfDump = 16

DmpTyp$ = "Hex"
'DmpTyp$ = "Decimal"
GOSUB SetUp

ssc$ = STRING$(17 * 80, " ")   'screen

DO
   SEEK 1, D&
   a$ = INPUT$(BSize, 1)
's! = TIMER: FOR xxx = 1 TO 80
   pp = 88
   sc$ = ssc$
   Padd& = D&
   IF Padd& > 1000000 THEN  'put millions part above
      TopAmt& = (Padd& \ 1000000) * 1000000
      Padd& = Padd& - TopAmt&
      MID$(sc$, 1) = "Address+" + STR$(TopAmt&)
   END IF
   FOR p = 1 TO LEN(a$) STEP Stp
      IF AddOpt THEN    'decimal
          aaa$ = MID$(STR$(Padd&), 2)
      ELSE
          aaa$ = HEX$(Padd&)
      END IF
      MID$(sc$, pp - LEN(aaa$)) = aaa$
      Padd& = Padd& + Stp
      ppc = pp + 2
      ss$ = MID$(a$, p, Stp)
      ssmax = LEN(ss$) - 1
      FOR i = 0 TO ssmax
         'DEF SEG = SSEG(ss$)    '*****note, add this line for qbx pds
         ppx& = SADD(ss$)
         aa = PEEK(ppx& + i)
         MID$(sc$, ppc) = nn$(aa)
         ppc = ppc + ppcamt
         IF aa(aa) THEN POKE ppx& + i, 32
      NEXT i
      MID$(sc$, pp + ppsamt + 1) = ss$   'ascii characters
      pp = pp + 80
   NEXT p
   LOCATE 3, 1, 0  'turn off cursor for print
   PRINT sc$;
'NEXT xxx: e! = TIMER: LOCATE 21, 1: PRINT "et="; e! - s!: SYSTEM

   LOCATE 23, pcol: PRINT blnk$; : LOCATE 23, pcol, 1
   D$ = ""
   DOld& = D&   'wait for a change of position
   DO
      i$ = INKEY$
      i$ = UCASE$(i$)
      IF LEN(i$) = 2 AND LEFT$(i$, 1) = CHR$(0) THEN 'special key
         i$ = MID$(i$, 2)
         IF i$ = CHR$(73) THEN      'page up
            IF D& > BSize THEN D& = D& - BSize ELSE D& = 1
         ELSEIF i$ = CHR$(81) THEN  'page down
            IF FLength& - D& > BSize THEN D& = D& + BSize
         ELSEIF i$ = CHR$(72) THEN  'up
            IF D& > Stp THEN D& = D& - Stp ELSE D& = 1
         ELSEIF i$ = CHR$(80) THEN  'down
            IF FLength& - D& > Stp THEN D& = D& + Stp
         ELSEIF i$ = CHR$(77) THEN  'right
            IF D& < FLength& THEN D& = D& + 1
         ELSEIF i$ = CHR$(75) THEN  'left
            IF D& > 1 THEN D& = D& - 1
         ELSEIF i$ = CHR$(71) THEN  'home
            D& = 1
         ELSEIF i$ = CHR$(79) THEN  'end
            IF FLength& > BSize THEN D& = FLength& - BSize + 1 ELSE D& = 1
         ELSEIF i$ = CHR$(59) THEN  'f1, help
            GOSUB HelpScreen
            EXIT DO
         ELSEIF i$ = CHR$(67) THEN  'f9, search again
            GOSUB SearchAgain
         ELSEIF i$ = CHR$(92) THEN  'shift f9, search again
            GOSUB SearchBackwards
         ELSEIF i$ = CHR$(15) THEN  'shift tab, back 10%
            IF D& - TabAmt& > 0 THEN D& = D& - TabAmt&
         END IF
      ELSEIF i$ = "A" THEN       'change addressing
         AddOpt = NOT AddOpt
         EXIT DO                 'force exit since address didnt change
      ELSEIF i$ = "D" THEN      'wants decimal
         DmpTyp$ = "Decimal"
         GOSUB SetUp
         EXIT DO
      ELSEIF i$ = "H" THEN      'wants hex
         DmpTyp$ = "Hex"
         GOSUB SetUp
         EXIT DO
      ELSEIF i$ = "S" THEN
         s$ = "": GOSUB SearchAgain    'go get string to search for
      ELSEIF i$ = CHR$(9) THEN 'tab
         IF FLength& > D& + TabAmt& THEN D& = D& + TabAmt&
      ELSEIF i$ = CHR$(13) OR i$ = " " THEN
         IF LEN(D$) = 0 THEN
            IF FLength& - D& > BSize THEN D& = D& + BSize
         ELSE
            IF VAL(D$) <= FLength& THEN
               D& = VAL(D$)
            ELSE
               BEEP
            END IF
         END IF
      ELSEIF i$ = CHR$(27) THEN
         GOTO wrap
      ELSEIF i$ >= "0" AND i$ <= "9" THEN
         D$ = D$ + i$: PRINT i$;
      ELSEIF i$ = CHR$(8) THEN
         IF LEN(D$) > 0 THEN
            D$ = LEFT$(D$, LEN(D$) - 1)
            LOCATE , POS(0) - 1
            PRINT " ";
            LOCATE , POS(0) - 1
         END IF
      END IF
   LOOP WHILE D& = DOld& AND force = 0
   DO  'clear pending keys
   LOOP WHILE LEN(INKEY$)
LOOP WHILE D& > 0
wrap:
SYSTEM

BottomStuff:
LOCATE 22, 1
PRINT FLength&; "characters available on file"
PRINT "Enter starting character number to dump - ";
pcol = POS(0)
blnk$ = SPACE$(80 - pcol)
PRINT : PRINT "Press F1 for commands";
RETURN

HelpScreen:
LOCATE 3, 1
hlpblnk$ = SPACE$(60)
FOR hb = 1 TO 18
   LOCATE , 10: PRINT hlpblnk$
NEXT hb
LOCATE 4, 1
ts = 16
LOCATE , ts: PRINT "    Possible actions are as follows:"
PRINT
LOCATE , ts: PRINT "Escape key = quit program"
LOCATE , ts: PRINT "PgUp = up one page"
LOCATE , ts: PRINT "PgDn, space bar or Enter key = down one page"
LOCATE , ts: PRINT "Home = start of file,  End = end of file"
LOCATE , ts: PRINT "Up or Down = up or down one line"
LOCATE , ts: PRINT "Left or Right = up or down one byte"
LOCATE , ts: PRINT "S = enter string to search for"
LOCATE , ts: PRINT "F9 = search for string"
LOCATE , ts: PRINT "Shift-F9 = search backward for string"
LOCATE , ts: PRINT "Tab = move down file 10%,  Shift-Tab = Up 10%"
LOCATE , ts: PRINT "A = toggle address from Hex to Decimal"
LOCATE , ts: PRINT "D = dump in decimal,  H = dump in hex"
PRINT
LOCATE , 16: PRINT "    Press any key to continue - ";
SLEEP
RETURN

Search:
   LOCATE 20, 1, 0
   FOR bb = 1 TO 4: PRINT SPACE$(80): NEXT bb
   LOCATE 20, 1
   PRINT "Enter string to search for, left arrow to backspace, press F9 when done"
   s$ = ""
   PRINT "ASCII   = "
   PRINT "Decimal = "
   PRINT "Hex     = "
   DO
      DO
         Sx$ = INKEY$
      LOOP WHILE Sx$ = ""
      IF LEN(Sx$) > 1 THEN  'possible function key
         IF ASC(MID$(Sx$, 2)) = 75 THEN 'left arrow key, backspace
             IF LEN(s$) > 0 THEN
                s$ = LEFT$(s$, LEN(s$) - 1)
                FOR bb = 21 TO 23
                    LOCATE bb, LEN(s$) * 4 + 13: PRINT "    "
                NEXT bb
             END IF
         ELSEIF ASC(MID$(Sx$, 2)) = 67 THEN 'f9, wrap up
             EXIT DO
         END IF
      ELSEIF LEN(s$) * 4 + 14 < 80 THEN
         LOCATE 21, LEN(s$) * 4 + 14
         aa = ASC(Sx$)
         IF aa < 32 AND (aa = 7 OR (aa > 8 AND aa < 14) OR aa > 27) THEN
              'dont PRINT
         ELSE
               PRINT Sx$
         END IF
         LOCATE 22, LEN(s$) * 4 + 13
         PRINT D$(aa)
         LOCATE 23, LEN(s$) * 4 + 13
         PRINT H$(aa)
         s$ = s$ + Sx$
      END IF
   LOOP
         
   LOCATE 20, 1, 0:
   FOR bb = 1 TO 4: PRINT SPACE$(80): NEXT bb
   GOSUB BottomStuff
   RETURN

SearchAgain:

   IF s$ = "" THEN
      GOSUB Search
      IF s$ = "" THEN RETURN  'no change
   END IF
   DO: LOOP WHILE LEN(INKEY$) > 0       'clear key board
   DOld& = D&
   DO
      Sx = INSTR(2, a$, s$)
      IF Sx > 0 THEN
         D& = D& + Sx - 1   'new start of page
         RETURN
      END IF
      IF FLength& - D& > BSize THEN
          D& = D& + BSize
          SEEK 1, D&
          a$ = INPUT$(BSize, 1)
      ELSE
          BEEP
          RETURN   'stay at last found d&
      END IF
      GOSUB SeeIfAbort
      IF AbortSearch THEN D& = DOld&: RETURN
   LOOP

SearchBackwards:

   IF s$ = "" THEN
      GOSUB Search
      IF s$ = "" THEN RETURN  'no change
   END IF
   DO: LOOP WHILE LEN(INKEY$) > 0       'clear key board
   DOld& = D&
   DO
      IF D& = 1 THEN
          BEEP
          RETURN  'at beginning of file
      END IF
      IF D& > BSize THEN D& = D& - BSize ELSE D& = 1
      SEEK 1, D&
      a$ = INPUT$(BSize, 1)
      Sx = INSTR(a$, s$) 'find first occurance this page
      IF Sx > 0 AND Sx < DOld& THEN 'found one
        DO
         nxsx = INSTR(Sx + 1, a$, s$)
         IF nxsx = 0 OR nxsx >= DOld& THEN
            D& = D& + Sx - 1   'new start of page
            RETURN
         END IF
         Sx = nxsx   'use later one
        LOOP
      END IF
      GOSUB SeeIfAbort
      IF AbortSearch THEN D& = DOld&: RETURN
   LOOP
STOP 'will never get here

SeeIfAbort:
   AbortSearch = 0 'preset false
   IF INKEY$ <> "" THEN
      LOCATE 25, 1: PRINT "Abort Search ? <N>";
      DO
        qs$ = INKEY$
      LOOP WHILE qs$ = ""
      LOCATE 25, 1: PRINT "                   ";
      qs$ = UCASE$(qs$)
      IF qs$ = "Y" THEN AbortSearch = -1
   END IF
   RETURN


SetUp:
IF DmpTyp$ = "Decimal" THEN
  Stp = 14            'number of items per line
  BSize = Stp * LinesOfDump    'block size to read
  qq$ = STRING$(Stp * 4 + 2, " ")  'string to hold dump values
  ppsamt = 65 - 8
  ppcamt = 4
  nnamt = 1
  FOR i = 0 TO 255: nn$(i) = D$(i): NEXT i
ELSEIF DmpTyp$ = "Hex" THEN
  Stp = 16
  BSize = Stp * LinesOfDump
  qq$ = STRING$(Stp * 3 + 8, " ")
  ppsamt = 60 - 8
  ppcamt = 3
  nnamt = 2
  FOR i = 0 TO 255: nn$(i) = H$(i): NEXT i
END IF
RETURN