home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / extra18 / pastrick / hexdump / dump.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-12-17  |  3.9 KB  |  157 lines
  1. (* ------------------------------------------------- *)
  2. (*                    DUMP.PAS                       *)
  3. (*         Ausgabe von Dateien als Hexdump           *)
  4. (*            (c) H.Tennert & DMV-Verlag             *)
  5. (* ------------------------------------------------- *)
  6. PROGRAM Dump;
  7.  
  8. USES Dos;
  9.  
  10. VAR
  11.   f          : FILE;
  12.   t          : TEXT;
  13.   s          : STRING;
  14.   i, j, k    : INTEGER;
  15.   Line, Page : INTEGER;
  16.   Segm, Offs : WORD;
  17.   Buffer     : ARRAY [1..16] OF BYTE;
  18.  
  19.   FUNCTION DosVersion : WORD;
  20.   BEGIN
  21.     DosVersion := Swap(Dos.DosVersion);
  22.   END;
  23.  
  24.   FUNCTION ThisProgram : STRING;
  25.   BEGIN
  26.     IF DosVersion >= $0300 THEN
  27.       ThisProgram := ParamStr(0)
  28.     ELSE
  29.       ThisProgram := '';
  30.   END;
  31.  
  32.   PROCEDURE Usage;
  33.   BEGIN
  34.     WriteLn;
  35.     WriteLn(ThisProgram, 'erzeugt einen Hexdump der '+
  36.                          'angegebenen Datei.');
  37.     WriteLn('Der Dump erhält die Erweiterung ».DMP«.');
  38.     WriteLn;
  39.     Halt(1);
  40.   END;
  41.  
  42.   FUNCTION Hex(l : BYTE; x : WORD) : STRING;
  43.   VAR
  44.     a : WORD;
  45.     s : STRING;
  46.   BEGIN
  47.     s := '';
  48.     a := x DIV 4096;
  49.     IF a <= 9 THEN s := Chr($30 + a)
  50.               ELSE s := Chr( 55 + a);
  51.     x := x MOD 4096;
  52.     a := x DIV 256;
  53.     IF a <= 9 THEN s := s + Chr($30 + a)
  54.               ELSE s := s + Chr( 55 + a);
  55.     x := x MOD 256;
  56.     a := x DIV 16;
  57.     IF a<=9 THEN s := s + Chr($30 + a)
  58.             ELSE s := s + Chr( 55 + a);
  59.     x := x MOD 16;
  60.     IF x <= 9 THEN s := s + Chr($30 + x)
  61.               ELSE s := s + Chr( 55 + x);
  62.     s := '0000' + s;
  63.     WHILE Length(s) > l DO Delete (s, 1, 1);
  64.     Hex := s;
  65.   END;
  66.  
  67.   PROCEDURE PrintHeader;
  68.   BEGIN
  69.     WriteLn(t, 'Hexdump von ', ParamStr(1),
  70.                 '       Länge: ',
  71.                 FileSize(f), '(',
  72.                 Hex(5, FileSize(f)),
  73.                 'H) Bytes       Seite ', page:2);
  74.     INC(Line);
  75.     WriteLn(t);
  76.   END;
  77.  
  78. BEGIN
  79.   IF ParamCount <> 1 THEN Usage;
  80.   s := ParamStr(1);
  81.   Assign(f, s);
  82. {$I-}
  83.   Reset(f, 1);
  84. {$I+}
  85.   IF IOResult <> 0 THEN BEGIN
  86.     WriteLn(ThisProgram, ':');
  87.     WriteLn('Datei ', s, ' nicht gefunden! ');
  88.     Halt(1);
  89.   END;
  90.   WHILE Pos('.', s) <> 0 DO
  91.     Delete(s, Length(s), 1);
  92.   s := s + '.DMP';
  93.   Assign(t, s);
  94.   Rewrite(t);
  95.   Segm := 0;  Offs := 0;
  96.   Page := 1;  Line := 1;
  97.   WriteLn;
  98.   WriteLn(ThisProgram, ': Bei der Arbeit...');
  99.   WHILE (FileSize(f)-FilePos(f)) > 16 DO BEGIN
  100.     IF Line = 1 THEN PrintHeader;
  101.     BlockRead(f, Buffer, 16);
  102.     Write(t, Hex(4, Segm), ':', Hex(4, Offs), ' ');
  103.     FOR i := 1 TO 8 DO
  104.       Write (t, ' ', Hex(2, Buffer[i]));
  105.     Write(t, ' !');
  106.     FOR i := 9 TO 16 DO
  107.       Write(t, ' ', Hex(2, Buffer[i]));
  108.     Write(t, ' # ');
  109.     FOR i := 1 TO 16 DO
  110.       IF Buffer[i] < 32 THEN
  111.         Write(t, '.')
  112.       ELSE
  113.         Write(t, Chr(Buffer[i]));
  114.     WriteLn (t);
  115.     INC(Line);
  116.     INC(Offs, 16);
  117.     IF Offs = 0 THEN INC(Segm, 1);
  118.     IF Line = 63 THEN BEGIN
  119.       WriteLn(t, ^L);
  120.       Line := 1;
  121.       INC(Page);
  122.     END;
  123.   END;
  124.   IF Line = 1 THEN PrintHeader;
  125.   j := FileSize(f) - FilePos(f);
  126.   BlockRead(f, Buffer, j);
  127.   Write(t, Hex(4, Segm), ':', Hex(4, Offs), ' ');
  128.   IF j >= 8 THEN
  129.     FOR i := 1 TO 8 DO
  130.       Write(t, ' ', Hex(2, Buffer[i]))
  131.   ELSE
  132.     FOR i := 1 TO j DO
  133.       Write(t, ' ', Hex(2, Buffer[i]));
  134.   IF j < 8 THEN
  135.     FOR i := Succ(j) TO 8 DO Write(t, '   ');   (* 3 *)
  136.   Write(t, ' !');
  137.   IF j > 8 THEN BEGIN
  138.     FOR i := 9 TO j DO
  139.       Write(t, ' ', Hex(2, Buffer[i]));
  140.     FOR i := Succ(j) TO 16 DO Write (t, '   '); (* 3 *)
  141.   END ELSE
  142.     Write(t, '                        ');      (* 24 *)
  143.   Write(t, ' # ');
  144.   FOR i := 1 TO j DO
  145.     IF Buffer[i] < 32 THEN
  146.       Write(t, '.')
  147.     ELSE
  148.       Write(t, Chr(Buffer[i]));
  149.   WriteLn(t);
  150.   WriteLn(t, #13);
  151.   Close(f);
  152.   Close(t);
  153. END.
  154. (* ------------------------------------------------- *)
  155. (*              Ende von DUMP.PAS                    *)
  156.  
  157.