PROGRAM NEWDMP; { Konverze binarniho souboru *.SAV do souboru HEX DUMP }
{ (C) LZR Soft, 1991 }
CONST
 DEFNME	='DK:DCD42G ';
 EXTINP	='NEW';
 EXTOUT	='DMP';
VAR
 LEN,ADR,
 PAGE	:INTEGER;
 JMENO	:ARRAY [0..9] OF CHAR;
 POLE	:ARRAY [0..15] OF CHAR;
 INF	:FILE OF CHAR;
 OUF	:FILE OF TEXT;
 SMERTT	:BOOLEAN;
{----------------------------------------------------------------------------}
FUNCTION PJMEN:CHAR;
VAR I:INTEGER;
BEGIN
FOR I:=0 TO 9 DO IF JMENO[I]>' ' THEN WRITE(JMENO[I]);
PJMEN:='.';
END;
{----------------------------------------------------------------------------}
FUNCTION PREVOD(NUM:INTEGER;FORM:BOOLEAN):CHAR;
VAR
 ZAKL,CIS:INTEGER;
 PREV:REAL;
 PROCEDURE DIGIT(CO:REAL);
 VAR
  ZBYT:INTEGER;
  DELI:REAL;
 BEGIN
 CIS:=CIS-1;
  DELI:=TRUNC(CO/ZAKL);
 ZBYT:=ROUND(CO-DELI*ZAKL);
 IF CIS>0 THEN DIGIT(DELI);
 IF ZBYT<10 THEN ZBYT:=ZBYT+48
            ELSE ZBYT:=ZBYT+55;
 IF SMERTT THEN
  WRITE(CHR(ZBYT))
 ELSE
  WRITE(OUF,CHR(ZBYT));
 END;
BEGIN
ZAKL:=16;CIS:=04;
IF NOT(FORM) THEN CIS:=(CIS+1) DIV 2;
PREV:=NUM;
IF NUM<0 THEN PREV:=65536.0+PREV;
DIGIT(PREV);
PREVOD:=' ';
END;
{----------------------------------------------------------------------------}
FUNCTION ASC(CON:CHAR):INTEGER;
VAR I:INTEGER;
BEGIN
 I:=ORD(CON);
 IF I<0 THEN I:=256+I;
 ASC:=I
END;
{----------------------------------------------------------------------------}
FUNCTION VYBERZNAK:INTEGER;
VAR ZN:CHAR;
BEGIN
ZN:=INF^;
IF ADR<(LEN*512) THEN GET(INF);
VYBERZNAK:=ASC(ZN);
END;
{----------------------------------------------------------------------------}
PROCEDURE ONEPAGE;
VAR COD:INTEGER;
BEGIN
IF ADR>0 THEN WRITELN(OUF,CHR(12));
PAGE:=PAGE+1;
WRITELN(OUF,'Page ',PAGE:2,' of ',JMENO,'.',EXTOUT);
WRITELN(OUF);
REPEAT
 IF (ADR MOD 16)=0 THEN
  BEGIN
  WRITE(OUF,PREVOD(ADR,TRUE),': ');
  SMERTT:=TRUE;
  WRITE('	',CHR(13),'Adresa:',PREVOD(ADR,TRUE),'H	');
  SMERTT:=FALSE;
  END;
 COD:=VYBERZNAK;
 WRITE(OUF,PREVOD(COD,FALSE));
 COD:=COD MOD 128;
 IF (COD=127) OR (COD<32) THEN COD:=ORD('.');
 POLE[ADR MOD 16]:=CHR(COD);
 ADR:=ADR+1;
 IF (ADR MOD 16)=0 THEN WRITELN(OUF,'*',POLE,'*');
UNTIL ((ADR MOD 1024)=0) OR (ADR=LEN*512);
END;
PROCEDURE DUMP;
VAR M:INTEGER;
BEGIN
RESET(INF,JMENO,EXTINP,LEN);
IF (LEN<1) THEN
 WRITELN('Nenalezen vstupni soubor                 : ',PJMEN,EXTINP)
ELSE
 BEGIN
 M:=LEN*6;
 REWRITE(OUF,JMENO,EXTOUT,M);
 IF (M<1) THEN
  WRITELN('Neni misto vystupni soubor               : ',PJMEN,EXTOUT)
 ELSE
  BEGIN
  WRITELN(OUF,CHR(27),'[4w',CHR(27),'[2z',CHR(27),'[96t',
             'HEX dump from ',JMENO,'.',EXTINP,' to ',JMENO,'.',EXTOUT);
  PAGE:=0;
  ADR:=0;
  SMERTT:=FALSE;
  REPEAT
   ONEPAGE;
  UNTIL (ADR=LEN*512);
  WRITELN(OUF);
  WRITELN(OUF,'END of ',JMENO,'.',EXTOUT);
  WRITE(OUF,CHR(12));
  CLOSE(OUF);
  END;
 CLOSE(INF);
 END;
END;
{----------------------------------------------------------------------------}
BEGIN
WRITELN('Prevod binarniho souboru na hex dump');
WRITELN('====================================');
WRITE('Jmeno binarniho souboru [',DEFNME,'.',EXTINP,'] : ');
READLN(JMENO);IF JMENO='          ' THEN JMENO:=DEFNME;
FOR LEN:=0 TO 8 DO
 IF (JMENO[LEN]=':') AND (JMENO[LEN+1]=' ') THEN JMENO:=DEFNME;
WRITELN;
WRITELN('Je pouzit vstupni soubor                 : ',PJMEN,EXTINP);
WRITELN('Generuje se vystupni soubor              : ',PJMEN,EXTOUT);
WRITELN;
DUMP;
WRITELN;
WRITELN(CHR(10),'Konec prace. (C) 1991, LZR Soft, POLDI Kladno');
END.
{----------------------------------------------------------------------------}