kcpmtk/dump.pas

114 lines
2.0 KiB
Plaintext

program dump;
{
dump emulates the version of DUMP.COM that comes with some
CP/M distributions.
}
{$I 'binary.pas'}
{$I 'common.pas'}
type
FileChunk = Array [1 .. 16] of Byte;
procedure PrnHelp;
begin
WriteLn('DUMP V1.0');
WriteLn('Hexadecimal dump binary files.');
WriteLn('');
WriteLn('Usage:');
WriteLn(' DUMP.COM SOURCE [DEST]');
WriteLn(' If only one argument is provided, DUMP will');
WriteLn(' output to the console.');
WriteLn('');
end;
procedure DumpChunk(
var Dest : Text;
var Addr : Integer;
Buffer : FileChunk;
Chunk : Byte);
var
I : Byte;
begin
Write(Dest, WriteWord(Addr));
for I := 1 to Chunk do
begin
Write(Dest, ' ');
Write(Dest, WriteByte(Buffer[I]));
end;
WriteLn(Dest, '');
Addr := Addr + Chunk;
end;
procedure DumpFile(var Source : BinFile; var Dest : Text);
label finished;
const Chunk = 16;
var
Address : Integer;
Size : Integer;
Buffer : FileChunk;
Cursor : Byte;
begin
Address := 0;
Cursor := 0;
FillChar(Buffer, $10, $0);
while not EOF(Source) do
begin
Cursor := Cursor + 1;
Read(Source, Buffer[Cursor]);
if EOF(Source) then goto finished;
if Cursor = Chunk then
begin
DumpChunk(Dest, Address, Buffer, Chunk);
Cursor := 0;
end;
end;
finished:
if Cursor > 0 then
DumpChunk(Dest, Address, Buffer, Chunk);
Close(Dest);
end;
var
IName : FilePath;
OName : FilePath;
Source : BinFile;
Dest : Text;
begin
IName := '';
OName := '';
case ParamCount of
0 : PrnHelp;
1 : IName := ParamStr(1);
2 : begin
IName := ParamStr(1);
OName := ParamStr(2);
end;
end;
Assign(Source, IName);
Reset(Source);
if OName <> '' then
begin
Assign(Dest, OName);
Rewrite(Dest);
end else Assign(Dest, Output);
DumpFile(inf, Output);
end.