home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
magazine
/
pcresour
/
1981_05
/
list.bas
< prev
next >
Wrap
BASIC Source File
|
1988-07-08
|
5KB
|
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