home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / jsage / znode3 / uploads / tpatch.lbr / COMTOCHN.PZS / COMTOCHN.PAS
Encoding:
Pascal/Delphi Source File  |  1993-06-07  |  3.8 KB  |  136 lines
  1. {$X-}
  2. PROGRAM ComToChn;
  3. (*
  4. ** Purpose:
  5. ** Cut away the runtime library from a Turbo Pascal COM file
  6. ** thus producing a Turbo Pascal CHN file.
  7. ** Versions 3.00A and 3.01A are supported.
  8. *)
  9.  
  10. CONST
  11.  JumpAdr = $20E2;
  12.  CallAdr = $0364;
  13.  BufSiz = 128;     {16 KByte}
  14.  
  15. TYPE
  16.  FName  = STRING[20];
  17.  Str80  = STRING[80];
  18.  Sector = ARRAY[0..127] OF BYTE;
  19.  PrgT = RECORD
  20.           Start   : ARRAY[1..9] OF BYTE;
  21.           CallOp  : BYTE;
  22.           CallAdr : INTEGER;
  23.           EndOp   : BYTE;
  24.           EndAdr  : INTEGER
  25.         END;
  26.  
  27. VAR
  28.  i, p : INTEGER;
  29.  ziel,
  30.  fni, fno : FName;
  31.  fi, fo : FILE;
  32.  Buffer : ARRAY[0..BufSiz] OF Sector; {1 sector more}
  33.  sec : Sector ABSOLUTE Buffer;
  34.  Jump : RECORD Op : BYTE; Adr : INTEGER END ABSOLUTE sec;
  35.  Prg : ^PrgT;
  36.  Vers, FRead, FSize, FChunk : INTEGER;
  37.  OneMore : BOOLEAN;
  38.  
  39.  
  40. PROCEDURE Help; {no return}
  41. BEGIN
  42.   WriteLn('usage: COMTOCHN program_name <destination_DU:>');
  43.   WriteLn('Cuts away the runtime library from a Turbo Pascal COM file.');
  44.   WriteLn('Creates <programname>.CHN on the given destination drive');
  45.   Write  ('(default = current DU).');
  46.   Halt;
  47. END; {Help}
  48.  
  49.  
  50. PROCEDURE NoTP3(s : Str80); {no return}
  51. BEGIN
  52.   WriteLn(s);
  53.   WriteLn('Either this program is not a Turbo Pascal program');
  54.   WriteLn('or it was not made by version 3.00A or 3.01A');
  55.   Close(fi);
  56.   Halt;
  57. END; {NoTP3}
  58.  
  59.  
  60. BEGIN {ComToChn}
  61. {say hello}
  62.   WriteLn('ComToChn (C) Herbert Oppmann 04-JAN-93');
  63. {get parameters and check them}
  64.   p := ParamCount;
  65.   IF (p =0) OR (p >2) THEN Help;
  66.   fni := ParamStr(1);
  67.   IF (p =1) AND (fni ='//') THEN Help;
  68.   ziel := ParamStr(2);
  69.   IF (p =2) AND (ziel[Length(ziel)] <>':') THEN Help;
  70. {compose filenames}
  71.   i := Pos('.',fni);
  72.   IF (i =0) THEN
  73.     BEGIN {no extension specified}
  74.     fno := fni+'.CHN';
  75.     fni := fni+'.COM';
  76.     END
  77.   ELSE
  78.     BEGIN {extension specified}
  79.     IF (Copy(fni,i+1,3) <>'COM') THEN
  80.       BEGIN
  81.       WriteLn('You don''t need to specify an extension.');
  82.       Write  ('But if you do, it has to be ''COM''. Nothing done.');
  83.       Halt;
  84.       END;
  85.     fno := Copy(fni,1,i)+'CHN';
  86.     END; {IF}
  87.   i := Pos(':', fno);
  88.   IF (i >0) THEN Delete(fno,1,i); {cut away prefix}
  89.   fno := ziel+fno;
  90. {open COM file and check}
  91.   Assign(fi, fni);
  92.   {$I-}
  93.   Reset(fi);
  94.   IF (IOResult <>0) THEN
  95.     BEGIN
  96.     Write('COM file not found!');
  97.     Halt;
  98.     END;
  99.   {$I+}
  100.   FSize := FileSize(fi);
  101.   IF (FSize <64) THEN NoTP3('File smaller than 8 KByte');
  102.   BlockRead(fi, sec, 1);
  103.   IF (Jump.Op <>$C3)
  104.   THEN NoTP3('No jump at the beginning of the runtime library');
  105.   IF (Jump.Adr =JumpAdr) THEN Vers := 0
  106.   ELSE BEGIN
  107.     IF (Jump.Adr =Succ(JumpAdr)) THEN Vers := 1
  108.     ELSE NoTP3('Jump address at the beginning of the runtime library did not match');
  109.     END;
  110.   Prg := Ptr(Addr(sec[(JumpAdr+Vers) AND $7F]));
  111.   Seek(fi,63); {Adresse 2080-2100}
  112.   BlockRead(fi, sec, 1);
  113.   IF (Prg^.CallOp <>$CD) OR (Prg^.CallAdr <>(CallAdr+Vers)) OR (Prg^.EndOp <>$21)
  114.   THEN NoTP3('Can''t match beginning of program');
  115.   IF (((Prg^.EndAdr -$81) SHR 7) <> FSize)
  116.   THEN NoTP3('Error in size');
  117.   FRead := FSize-64; (* that's how much sectors we still got to read *)
  118.   OneMore := FRead <> (((Prg^.EndAdr-JumpAdr-Vers)+$7F) SHR 7);
  119. {create CHN file}
  120.   Write(fni,' (v3.0',Vers,'A) --> ',fno,' ');
  121.   Assign(fo, fno);
  122.   Rewrite(fo);
  123.   WHILE (FRead >0) DO
  124.     BEGIN
  125.     IF (FRead >BufSiz) THEN FChunk := BufSiz ELSE FChunk := FRead;
  126.     BlockRead(fi,Buffer[1],FChunk);
  127.     BlockWrite(fo,Prg^.Start,FChunk);
  128.     Move(Buffer[BufSiz],sec,128);
  129.     FRead := FRead-FChunk;
  130.     END; {WHILE}
  131.   IF OneMore THEN BlockWrite(fo,Prg^.Start,1);
  132.   Close(fi);
  133.   Close(fo);
  134.   Write('- ok');
  135. END. {ComToChn}
  136.