ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/MAGAZINE/MISC/PCR815.ZIP/LIST.BAS

BASIC Source File | 1988-07-08 | 4.8 KB | 195 lines

'*****************************************************************
' DOS-level file lister.
' Invoke:  LIST filespec [option]
'       Options:  /H list in hex format
'                 /T text only (discard non-printable characters)
'
' Written in QuickBasic 4.0
'******************************************************************

DEFINT A-Z
DECLARE SUB GetArgs ()
DECLARE SUB ParseArgs ()
DECLARE SUB Help ()
DECLARE SUB HexPrint ()
DECLARE SUB TextPrint ()
DECLARE FUNCTION Hex8$ (ByteCount&)

CONST FALSE = 0
CONST TRUE = NOT FALSE

DIM SHARED Arg$(5)                   'Command-line arguments
COMMON SHARED HexFlag, TextFlag
COMMON SHARED ArgCount, FileName$

HexFlag = FALSE
TextFlag = FALSE

'****************************************************************
'  Main Program Starts Here
'****************************************************************

GetArgs
ParseArgs
ON ERROR GOTO ErrTrap
OPEN FileName$ FOR BINARY AS 1
ON ERROR GOTO 0
IF HexFlag THEN
   HexPrint
ELSE
   TextPrint
END IF
CLOSE 1
END

ErrTrap:                             'If file not found
CLOSE
Help
END

SUB GetArgs STATIC

'***************************************************************
' Collect arguments from command line
' Based on Microsoft's code in QuickBasic 4.0 manuals
'***************************************************************

MaxArgs = UBOUND(Arg$)
ArgCount = 0
Cmd$ = COMMAND$
CmdLen = LEN(Cmd$)
InWord = FALSE

FOR Lp = 1 TO LEN(Cmd$)
   C$ = MID$(Cmd$, Lp, 1)
   IF C$ <> " " AND C$ <> CHR$(9) THEN
      IF NOT InWord THEN
         IF ArgCount >= MaxArgs THEN EXIT FOR
         ArgCount = ArgCount + 1
         InWord = TRUE
      END IF
      Arg$(ArgCount) = Arg$(ArgCount) + C$
   ELSE
      InWord = FALSE
   END IF
NEXT Lp

END SUB

SUB ParseArgs STATIC

'******************************************************************
' Parse command-line arguments, set argument flags, and check
' that only valid arguments are received.
'******************************************************************

FileName$ = ""
FOR Lp = 1 TO ArgCount
   IF LEFT$(Arg$(Lp), 1) = "/" OR LEFT$(Arg$(Lp), 1) = "-" THEN
      SELECT CASE MID$(Arg$(Lp), 2, 1)
         CASE "H"
            HexFlag = TRUE
         CASE "T"
            TextFlag = TRUE
         CASE ELSE
            Help
      END SELECT
   ELSE
      IF FileName$ = "" THEN
         FileName$ = Arg$(Lp)
      ELSE
         Help
      END IF
   END IF
NEXT Lp
IF FileName$ = "" THEN Help
IF HexFlag AND TextFlag THEN Help

END SUB

SUB Help

'******************************************************************
' The user is confused!  Display program syntax and exit.
'******************************************************************

   PRINT "List is a file lister."
   PRINT "  Syntax:  LIST FileName [option]"
   PRINT "  Options: /H Use Hex Mode"
   PRINT "           /T Display text characters only"
   PRINT "  Both options may NOT be used at the same time"
   END
END SUB

SUB TextPrint STATIC

'******************************************************************
' Print the file, a byte at a time, in ASCII or Text-Only format
'******************************************************************

NextCh$ = INPUT$(1, #1)
DO UNTIL EOF(1)
   Ch$ = NextCh$
   NextCh$ = INPUT$(1, #1)

   IF Ch$ >= " " AND Ch$ <= CHR$(127) THEN
      PRINT Ch$;
   ELSEIF Ch$ = CHR$(13) AND NextCh$ = CHR$(10) THEN
      PRINT
      NextCh$ = INPUT$(1, 1)
   ELSE
      IF NOT TextFlag THEN
         PRINT ".";
      END IF
   END IF
LOOP
PRINT

END SUB

SUB HexPrint STATIC

'******************************************************************
' Print the file in hex-dump format.  Work with one line (16 bytes)
' at a time.
'******************************************************************

ByteCount& = 0
DO UNTIL EOF(1)
   HexLine$ = ""
   AscLine$ = ""
   InLine$ = INPUT$(16, #1)
   ByteCount& = ByteCount& + 16

   FOR Lp = 1 TO LEN(InLine$)
      Ch$ = MID$(InLine$, Lp, 1)

      Hx$ = HEX$(ASC(Ch$))
      Hx$ = STRING$(2 - LEN(Hx$), "0") + Hx$
      HexLine$ = HexLine$ + Hx$ + " "

      IF Ch$ < " " OR Ch$ > CHR$(127) THEN
         Ch$ = "."
      END IF
      AscLine$ = AscLine$ + Ch$
   NEXT Lp

   PRINT Hex8$(ByteCount&); TAB(14); HexLine$; TAB(64); AscLine$
LOOP
PRINT

END SUB

FUNCTION Hex8$ (LongInt&) STATIC

'******************************************************************
' Change a long integer (the file address) into standard hhhh:hhhh
' hexadecimal format and return as a string.
'******************************************************************

   Temp$ = HEX$(LongInt&)
   Temp$ = STRING$(8 - LEN(Temp$), "0") + Temp$
   Hex8 = LEFT$(Temp$, 4) + ":" + MID$(Temp$, 5)
END FUNCTION