|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 10386 (0x2892)
Types: TextFile
Names: »FILEDUMP.PAS«
└─⟦e2123b2a1⟧ Bits:30010498 DVBS1.SW2103.src.1.8-1 Pascal TOOLS JTAS 1989-04-26 LEIF NIELSEN E.d.
└─⟦this⟧ »FILEDUMP.PAS«
{[A=20,I=2,L=4,E=3,W=1-100] PASCFORM directive }\r
PROGRAM filedump;\r
{ Dump contenth of file\r
\r
----------------------------------------------------------------------------\r
Date. Init. Vers. Explanation.\r
\r
1988-12-21 LEI 0.1 Original version by Leif Nielsen\r
1989-01-27 LEI 1.1 New param TPU format\r
----------------------------------------------------------------------------}\r
\r
USES\r
Dos,\r
DosUtil,\r
Help,\r
Param;\r
\r
CONST\r
Version = ('1.1' );\r
MaxParam = 2;\r
MaxOption = 5;\r
Max_Line = 15;\r
\r
ParamList : ARRAY[1..MaxParam] OF ParamRec =\r
((Kind:KnownFile; Defined:FALSE; KeyWord:'I'; NumVal:0; TextVal:''),\r
(Kind:FileType; Defined:FALSE; KeyWord:'O'; NumVal:0; TextVal:''));\r
\r
OptionList : ARRAY[1..MaxOption] OF ParamRec =\r
((Kind:Numeric; Defined:FALSE ;KeyWord:'NUMBER'; NumVal: Max_Line*10;\r
TextVal:''), (*number of bytes*)\r
(Kind:Numeric; Defined:FALSE ;KeyWord:'SKIP'; NumVal:0; TextVal:''), (*bytes to skip*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'CHARS'; NumVal:0; TextVal:'ON'), (*chars*)\r
(Kind:TextType; Defined:FALSE ;KeyWord:'FORMAT'; NumVal:0; TextVal:'HEX'), (*format*)\r
(Kind:OnOff; Defined:FALSE ;KeyWord:'TEST'; NumVal:0; TextVal:'OFF') ); (*test*)\r
\r
\r
VAR\r
Source: FILE;\r
\r
CONST\r
RecSize = 128;\r
BufSize = 160;\r
BufPos: word = RecSize;\r
BufNo: word = BufSize;\r
RecsRead: word = 1;\r
BytePos: longint = 0;\r
Lgt_source_file: longint = -2;\r
\r
VAR\r
InputBuffer: ARRAY [1..BufSize, 1..RecSize] OF byte;\r
\r
name: STRING[80]; { xxx Indtil videre her, selv om det ikke er kЏnt }\r
\r
\r
FUNCTION GetFileSize( name: STRING): longint;\r
VAR\r
f: FILE OF byte;\r
\r
BEGIN\r
Assign(f, name);\r
{$I-}\r
Reset(f);\r
{$I+}\r
IF IOResult <> 0 THEN\r
GetFileSize := -1\r
ELSE BEGIN\r
GetFileSize := FileSize(f);\r
Close(f);\r
END {if};\r
END (* GetFileSize *);\r
\r
PROCEDURE OpenByteFile(name: STRING);\r
BEGIN\r
assign(source, name);\r
reset(source, RecSize);\r
\r
Lgt_Source_file := GetFileSize(name);\r
BufPos := 1;\r
BufNo := 1;\r
BlockRead(Source, InputBuffer, BufSize, RecsRead);\r
BytePos := 0;\r
\r
END; (* OpenByteFile *)\r
\r
FUNCTION GetByte(VAR Byt: byte): boolean;\r
BEGIN\r
Byt := InputBuffer[ BufNo, BufPos ];\r
BytePos := BytePos + 1;\r
GetByte := Lgt_Source_file >= BytePos;\r
BufPos := BufPos + 1;\r
IF BufPos > RecSize THEN\r
BEGIN\r
BufPos := 1;\r
BufNo := BufNo + 1;\r
IF BufNo > BufSize THEN\r
BEGIN\r
BufNo := 1;\r
IF RecsRead > 0 THEN\r
BlockRead(Source, InputBuffer, BufSize, RecsRead);\r
END;\r
END;\r
END; (* GetByte *)\r
\r
FUNCTION LookAhead(VAR Byt: byte): boolean;\r
BEGIN\r
IF Lgt_Source_file >= BytePos THEN\r
BEGIN\r
LookAhead := true;\r
Byt := InputBuffer[ BufNo, BufPos ];\r
END\r
ELSE\r
BEGIN\r
lookAhead := false;\r
byt := 0;\r
END;\r
END; (* LookAhead *)\r
\r
\r
FUNCTION strwzero( i: longint; size, base: integer ): STRING;\r
VAR\r
k, l, m, low : longint;\r
temp: STRING[34];\r
CONST\r
digit: ARRAY [ 0..15 ] OF char =\r
( '0', '1', '2', '3', '4', '5', '6', '7', '8', '9',\r
'A', 'B', 'C', 'D', 'E', 'F' );\r
BEGIN\r
temp[0] := chr(size);\r
FOR k := 1 TO size DO\r
temp[k] := '0';\r
\r
k := abs(i);\r
IF i < 0 THEN\r
BEGIN\r
low := 2;\r
temp[1] := '-';\r
END\r
ELSE\r
low := 1;\r
\r
l := size + 1;\r
WHILE ( k <> 0 ) AND ( l > low ) DO\r
BEGIN\r
l := l - 1;\r
temp[l] := digit[ k MOD base ];\r
k := k DIV base;\r
END;\r
IF k <> 0 THEN { overflow }\r
temp[low] := '*';\r
strwzero := temp;\r
END;\r
\r
PROCEDURE PrintDate(VAR f: text);\r
VAR\r
d, m, y, dow: word;\r
\r
BEGIN\r
GetDate(y, m, d, dow);\r
write(f, strwzero( y, 4, 10), '-', strwzero( m, 2, 10) );\r
write(f, '-', strwzero( d, 2, 10) );\r
\r
END {PrintDate};\r
\r
PROCEDURE PrintTime(VAR f: text);\r
VAR\r
h, m, s, ds: word;\r
\r
BEGIN\r
GetTime(h, m, s, ds);\r
write(f, strwzero( h, 2, 10), ':', strwzero( m, 2, 10) );\r
{ write(f, ':', strwzero( d, 2, 10) ); }\r
END {PrintTime};\r
\r
\r
\r
CONST\r
nl = 10;\r
hex_digit: ARRAY [0..15] OF char =\r
( '0', '1', '2', '3', '4', '5', '6', '7', '8',\r
'9', 'A', 'B', 'C', 'D', 'E', 'F' );\r
\r
VAR\r
unique, skipped, not_eof: boolean;\r
next_line, prev_line: ARRAY [1..max_line] OF byte;\r
byt: byte;\r
i, j, result, par_count: integer;\r
adr, first_adr: longint;\r
par_str: STRING[40];\r
P_str: PathStr;\r
D_str: DirStr;\r
N_str: NameStr;\r
E_str: ExtStr;\r
ch_name: ARRAY [0..255] OF STRING[3];\r
\r
byte_count, skip_count: longint;\r
Show_char, Test_requested: boolean;\r
num_mode: integer;\r
outpfile: STRING[60];\r
O_buff: ARRAY[1..4096] OF byte;\r
\r
PROCEDURE write_hex(b: byte);\r
VAR\r
i, j: integer;\r
BEGIN\r
i := b DIV 16;\r
j := b MOD 16;\r
write(hex_digit[i]:1, hex_digit[j]:1);\r
END {write_hex};\r
\r
PROCEDURE param_error(str: STRING);\r
BEGIN\r
writeln('*** ERROR *** ', str);\r
halt;\r
END;\r
\r
PROCEDURE read_callparameters;\r
VAR\r
i, k: integer;\r
key_text: STRING;\r
dir_st: DirStr;\r
name_st: NameStr;\r
ext_st: ExtStr;\r
\r
BEGIN\r
\r
IF ParamCount = 0 THEN\r
BEGIN { The user must give at least the input file as parameter }\r
Showhelp;\r
Halt;\r
END;\r
\r
GetParams( Paramlist, MaxParam, OptionList, MaxOption);\r
\r
byte_count := OptionList[1].NumVal;\r
\r
skip_count := OptionList[2].NumVal;\r
\r
show_char := OptionList[3].TextVal = 'ON';\r
\r
IF ( NOT show_char ) AND ( NOT OptionList[1].Defined ) THEN\r
byte_count := byte_count * 2;\r
\r
CASE\r
MatchOptionStr( OptionList[4].TextVal, 4, 'HEX OCT DEC ') OF\r
\r
-1: Param_Error(' Option not unique ');\r
\r
0: Param_Error(' Option not valid ');\r
\r
1: num_mode := 16;\r
\r
2: num_mode := 8;\r
\r
3: num_mode := 10;\r
\r
END (*case *);\r
\r
test_requested := OptionList[5].TextVal = 'ON';\r
\r
\r
name := ParamList[1].TextVal;\r
\r
IF ParamList[2].Defined THEN\r
outpfile := ParamList[2].TextVal\r
ELSE\r
outpfile := '';\r
\r
FileMode := FM_ReadOnly;\r
OpenByteFile( name);\r
\r
FileMode := FM_ReadWrite;\r
assign(output, outpfile);\r
SetTextBuf(Output, O_buff);\r
rewrite(output);\r
\r
END (* READ_CALLPARAMS *);\r
\r
\r
PROCEDURE write_line(nch: integer);\r
VAR\r
i: integer;\r
\r
BEGIN\r
prev_line := next_line;\r
IF skipped THEN\r
writeln(' - Above line repeated - ');\r
\r
write(adr:8, ':');\r
IF num_mode <= 10 THEN write(' ');\r
\r
FOR i := 1 TO nch DO\r
CASE num_mode OF\r
8, 10:\r
BEGIN\r
write(' ', strwzero( next_line[i], 3, num_mode) );\r
END;\r
\r
16:\r
BEGIN\r
write(' ');\r
write_hex( next_line[i] );\r
END;\r
\r
END {case };\r
writeln;\r
\r
IF Show_char THEN\r
BEGIN\r
write(' ');\r
FOR i := 1 TO nch DO\r
write(ch_name[next_line[i]]:4);\r
writeln;\r
END;\r
\r
END {write_line};\r
\r
BEGIN\r
read_callParameters;\r
\r
write(' FILEDUMP v. ', Version, ' At: ');\r
PrintDate(output); write(' '); PrintTime(output); writeln;\r
writeln(' Of file: ', FExpand(name) );\r
\r
FOR i := 0 TO 255 DO\r
BEGIN\r
ch_name[i] := chr(i) + ' ';\r
END;\r
ch_name[ 0] := 'NUL';\r
ch_name[ 1] := 'SOH';\r
ch_name[ 2] := 'STX';\r
ch_name[ 3] := 'ETX';\r
ch_name[ 4] := 'EOT';\r
ch_name[ 5] := 'ENQ';\r
ch_name[ 6] := 'ACK';\r
ch_name[ 7] := 'BEL';\r
ch_name[ 8] := 'BS ';\r
ch_name[ 9] := 'HT ';\r
ch_name[ 10] := 'LF ';\r
ch_name[ 11] := 'VT ';\r
ch_name[ 12] := 'FF ';\r
ch_name[ 13] := 'CR ';\r
ch_name[ 14] := 'SO ';\r
ch_name[ 15] := 'SI ';\r
ch_name[ 16] := 'DLE';\r
ch_name[ 17] := 'DC1';\r
ch_name[ 18] := 'DC2';\r
ch_name[ 19] := 'DC3';\r
ch_name[ 20] := 'DC4';\r
ch_name[ 21] := 'NAK';\r
ch_name[ 22] := 'SYN';\r
ch_name[ 23] := 'ETB';\r
ch_name[ 24] := 'CAN';\r
ch_name[ 25] := 'EM ';\r
ch_name[ 26] := 'SUB';\r
ch_name[ 27] := 'ESC';\r
ch_name[ 28] := 'FS ';\r
ch_name[ 29] := 'GS ';\r
ch_name[ 30] := 'RS ';\r
ch_name[ 31] := 'US ';\r
ch_name[ 32] := 'SP ';\r
ch_name[127] := 'DEL';\r
\r
i := 0;\r
first_adr := skip_count + 1;\r
adr := first_adr;\r
skipped := false;\r
not_eof := true;\r
\r
WHILE ( not_eof ) AND ( skip_count > 0 ) DO\r
BEGIN\r
not_eof := GetByte(byt);\r
skip_count := skip_count - 1;\r
END;\r
\r
WHILE ( GetByte(byt) ) AND ( byte_count > 0 ) DO\r
BEGIN\r
i := i + 1;\r
next_line[i] := byt;\r
IF i >= max_line THEN\r
BEGIN\r
byte_count := byte_count - max_line;\r
unique := adr = first_adr; { Always print first line }\r
j := 0;\r
WHILE ( NOT unique ) AND ( j < max_line) DO\r
BEGIN\r
j := j + 1;\r
unique := prev_line[j] <> next_line[j];\r
END;\r
\r
IF unique THEN\r
BEGIN\r
write_line(max_line);\r
skipped := false;\r
END\r
ELSE\r
skipped := true;\r
adr := adr + max_line;\r
i := 0;\r
END;\r
END;\r
\r
IF byte_count > 0 THEN\r
BEGIN\r
IF i > 0 THEN\r
write_line(i);\r
writeln(' --- EOF --- ');\r
END\r
ELSE\r
IF skipped THEN\r
writeln(' - Above line repeated - ');\r
\r
close(Source);\r
\r
END.\r
\r