home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
MADTRB21.ZIP
/
HEXDUMP.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-06-10
|
6KB
|
183 lines
{--------------------------------------------------------------}
{ HEXDUMP }
{ }
{ Hex dump program for all disk files }
{ }
{ by Jeff Duntemann }
{ Turbo Pascal V2.0 }
{ Last update 12/11/84 }
{ }
{ (c) 1984 by Jeff Duntemann }
{ ALL RIGHTS RESERVED }
{--------------------------------------------------------------}
PROGRAM HEXDUMP;
{$V-} { Relaxes string length type checking on VAR paramaters }
CONST UP = TRUE;
DOWN = FALSE;
TYPE STRING255 = STRING[255];
STRING128 = STRING[128];
STRING80 = STRING[80];
STRING40 = STRING[40];
PARM_ARRAY = ARRAY[1..10] OF STRING40; { Command line }
{ parms are stored here }
BLOCK = ARRAY[0..127] OF BYTE; { One disk sector }
BLOCK_ARRAY = ARRAY[0..15] OF BLOCK; { BLOCKREAD reads }
{ 16 blocks at once }
VAR I,J,K : INTEGER;
PARMS : PARM_ARRAY;
CH : CHAR;
DUMPFILE : FILE;
XBLOCK : BLOCK;
DISKDATA : BLOCK_ARRAY;
IOCODE : INTEGER;
BLOCKS : INTEGER; { Counts blocks within }
{ BLOCK_ARRAY }
BLOCK_COUNT : INTEGER; { Tallies total # blocks read }
BUFFERS : INTEGER;
REMAINS : INTEGER;
DEVICE : TEXT; { Will be either LST: or CON: }
{<<<<LOCATION OF THE COMMAND LINE TAIL>>>>}
{Only ONE of the following two declarations applies to any }
{given version of Turbo Pascal. Choose the one that }
{matches your operating system and un-comment it. Then }
{comment out the other one! }
RAM_TAIL : STRING128 ABSOLUTE CSEG : $80; { MS/PC DOS }
{RAM_TAIL : STRING128 ABSOLUTE $80;} { CP/M }
{$I FRCECASE.SRC } { Contains FORCE_CASE }
{$I STRIPWHT.SRC } { Contains STRIP_WHITE }
{$I PARSTAIL.SRC } { Contains PARSE_TAIL }
{$I YES.SRC } { Contains YES }
{>>>>WRITE_HEX<<<<}
PROCEDURE WRITE_HEX(VAR DEVICE : TEXT; BT : BYTE);
CONST HEXDIGITS : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
VAR BZ : BYTE;
BEGIN
BZ := BT AND $0F;
BT := BT SHR 4;
WRITE(DEVICE,HEXDIGITS[BT],HEXDIGITS[BZ])
END;
{>>>>DUMPBLOCK<<<<}
PROCEDURE DUMPBLOCK(XBLOCK : BLOCK; VAR DEVICE : TEXT);
VAR I,J,K : INTEGER;
CH : CHAR;
BEGIN
FOR I:=0 TO 7 DO { Do a hexdump of 8 lines of 16 chars }
BEGIN
FOR J:=0 TO 15 DO { Show hex values }
BEGIN
WRITE_HEX(DEVICE,ORD(XBLOCK[(I*16)+J]));
WRITE(DEVICE,' ')
END;
WRITE(DEVICE,' |'); { Bar to separate hex & ASCII }
FOR J:=0 TO 15 DO { Show printable chars or '.' }
BEGIN
CH:=CHR(XBLOCK[(I*16)+J]);
IF ((ORD(CH)<127) AND (ORD(CH)>31))
THEN WRITE(DEVICE,CH) ELSE WRITE(DEVICE,'.')
END;
WRITELN(DEVICE,'|')
END;
FOR I:=0 TO 1 DO WRITELN(DEVICE,'')
END; { DUMPBLOCK }
{<<<<SHOW_HELP>>>>}
PROCEDURE SHOW_HELP(HELPNAME : STRING80);
VAR HELPFILE : TEXT;
HELPLINE : STRING80;
I : INTEGER;
BEGIN
WRITELN;
ASSIGN(HELPFILE,HELPNAME);
{$I-} RESET(HELPFILE); {$I+}
IF IORESULT = 0 THEN
FOR I := 1 TO 20 DO
BEGIN
READLN(HELPFILE,HELPLINE);
WRITELN(HELPLINE)
END;
CLOSE(HELPFILE)
END;
BEGIN
CLRSCR; { Clear the CRT }
PARSE_TAIL(I,PARMS); { Parse the command tail }
{ Caps lock printer parameter }
IF I > 1 THEN PARMS[2] := FORCE_CASE(UP,PARMS[2]);
IF I < 1 THEN { Error - no parms given }
BEGIN
WRITELN('<<Error!>> You must enter a filename after invoking');
WRITE (' HEXDUMP.COM. Display help screen? (Y/N): ');
IF YES THEN SHOW_HELP('DUMPHELP.TXT')
END
ELSE
BEGIN
ASSIGN(DUMPFILE,PARMS[1]); { Attempt to open the file }
{$I-} RESET(DUMPFILE); {$I+}
IF IORESULT <> 0 THEN { Error if file won't open }
BEGIN
WRITELN('<<Error!>> File ',PARMS[1],' does not exist.');
WRITE (' Display help screen? (Y/N): ');
IF YES THEN SHOW_HELP('DUMPHELP.TXT');
END
ELSE
BEGIN { See if print parm was entered; }
{ and select output device }
IF (POS('PRINT',PARMS[2]) = 1) OR (POS('P',PARMS[2]) = 1) THEN
ASSIGN(DEVICE,'LST:') ELSE ASSIGN(DEVICE,'CON:');
RESET(DEVICE);
BLOCK_COUNT := FILESIZE(DUMPFILE); { Filesize in 128-byte blocks }
IF BLOCK_COUNT = 0 THEN
WRITELN('File ',PARMS[1],' is empty.')
ELSE
BEGIN
BUFFERS := BLOCK_COUNT DIV 16; { # of 16-block buffers }
REMAINS := BLOCK_COUNT MOD 16; { # of blocks in last buffer }
FOR I := 1 TO BUFFERS DO { Dump full 16-block buffers }
BEGIN
BLOCKREAD(DUMPFILE,DISKDATA,16); { Read 16 disk blocks }
FOR J := 0 TO 15 DO
DUMPBLOCK(DISKDATA[J],DEVICE) { Dump 'em... }
END;
IF REMAINS > 0 THEN { If fractional buffer remains, dump it }
BEGIN
BLOCKREAD(DUMPFILE,DISKDATA,REMAINS); { Read last buffer }
FOR I := 0 TO REMAINS-1 DO
DUMPBLOCK(DISKDATA[I],DEVICE) { Dump it }
END
END;
CLOSE(DUMPFILE)
END
END
END.