home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 June / SIMTEL_0692.cdr / msdos / turbopas / exeutil.arc / INFO.PAS next >
Pascal/Delphi Source File  |  1987-11-17  |  11KB  |  345 lines
  1. {
  2.  INFO reports various information about a Turbo Pascal 4.0 EXE
  3.  file, and optionally offers the ability to patch stack and heap
  4.  sizes without recompiling.
  5.  
  6.  After compiling, just enter INFO to get directions for usage.
  7.  
  8.  Version 1.0.
  9.  Written 11/87, Kim Kokkonen, TurboPower Software.
  10.  Compuserve 72457,2131.
  11.  Released to the public domain.
  12. }
  13. {$R-,S-,I-}
  14.  
  15. program Info;
  16.   {-Write information about a Turbo Pascal 4.0 EXE file}
  17.   {-Offer quick patches to heap and stack size}
  18.  
  19. type
  20.   ExeHeaderRec =             {Information describing EXE file}
  21.   record
  22.     Signature : Word;        {EXE file signature}
  23.     LengthRem : Word;        {Number of bytes in last page of EXE image}
  24.     LengthPages : Word;      {Number of 512 byte pages in EXE image}
  25.     NumReloc : Word;         {Number of relocation items}
  26.     HeaderSize : Word;       {Number of paragraphs in EXE header}
  27.     MinHeap, MaxHeap : Word; {Paragraphs to keep beyond end of image}
  28.     StackSeg, StackPtr : Word; {Initial SS:SP, StackSeg relative to image base}
  29.     CheckSum : Word;         {EXE file check sum, not used}
  30.     IpInit, CodeSeg : Word;  {Initial CS:IP, CodeSeg relative to image base}
  31.     RelocOfs : Word;         {Bytes into EXE for first relocation item}
  32.     OverlayNum : Word;       {Overlay number, not used here}
  33.   end;
  34.  
  35.   RelocRec =
  36.   record
  37.     Offset : Word;
  38.     Segment : Word;
  39.   end;
  40.  
  41. var
  42.   Patch : Boolean;
  43.   ShowFixups : Boolean;
  44.   ExeName : string[64];
  45.  
  46. const
  47.   Digits : array[0..$F] of Char = '0123456789ABCDEF';
  48.  
  49.   function HexW(W : Word) : string;
  50.     {-Return hex string for word}
  51.   begin
  52.     HexW[0] := #4;
  53.     HexW[1] := Digits[hi(W) shr 4];
  54.     HexW[2] := Digits[hi(W) and $F];
  55.     HexW[3] := Digits[lo(W) shr 4];
  56.     HexW[4] := Digits[lo(W) and $F];
  57.   end;
  58.  
  59.   function StUpcase(S : string) : string;
  60.     {-Return uppercase of string}
  61.   var
  62.     I : integer;
  63.   begin
  64.     for I := 1 to length(S) do
  65.       S[I] := upcase(S[I]);
  66.     StUpcase := S;
  67.   end;
  68.  
  69.   function HasExtension(Name : string; var DotPos : Word) : Boolean;
  70.     {-Return whether and position of extension separator dot in a pathname}
  71.   var
  72.     I : Word;
  73.   begin
  74.     DotPos := 0;
  75.     for I := Length(Name) downto 1 do
  76.       if (Name[I] = '.') and (DotPos = 0) then
  77.         DotPos := I;
  78.     HasExtension := (DotPos > 0) and (Pos('\', Copy(Name, Succ(DotPos), 64)) = 0);
  79.   end;
  80.  
  81.   function ForceExtension(Name, Ext : string) : string;
  82.     {-Return a pathname with the specified extension attached}
  83.   var
  84.     DotPos : Word;
  85.   begin
  86.     if HasExtension(Name, DotPos) then
  87.       ForceExtension := Copy(Name, 1, DotPos)+Ext
  88.     else
  89.       ForceExtension := Name+'.'+Ext;
  90.   end;
  91.  
  92.   procedure Error(Msg : string);
  93.     {-Report error and halt}
  94.   begin
  95.     if Msg <> '' then
  96.       WriteLn(^M^J, Msg);
  97.     Halt(1);
  98.   end;
  99.  
  100.   procedure WriteHelp;
  101.     {-Show a brief help screen}
  102.   begin
  103.     WriteLn;
  104.     WriteLn('Usage: INFO [Options] ExeName');
  105.     WriteLn('Options:');
  106.     WriteLn('  /P    Prompt for new stack and heap sizes');
  107.     WriteLn('  /F    Show a detailed list of relocation fixups');
  108.     Halt(1);
  109.   end;
  110.  
  111.   procedure ParseCommandLine;
  112.     {-Analyze the command line from DOS}
  113.   var
  114.     I : Integer;
  115.     Arg : string;
  116.   begin
  117.     Patch := False;
  118.     ShowFixups := False;
  119.     ExeName := '';
  120.     I := 1;
  121.     while I <= ParamCount do begin
  122.       Arg := stupcase(ParamStr(I));
  123.       if (Arg = '/P') or (Arg = '-P') then
  124.         Patch := True
  125.       else if (Arg = '/F') or (Arg = '-F') then
  126.         ShowFixups := True
  127.       else if Length(ExeName) = 0 then
  128.         ExeName := ForceExtension(Arg, 'EXE')
  129.       else
  130.         Error('Invalid command line');
  131.       Inc(I);
  132.     end;
  133.     if Length(ExeName) = 0 then
  134.       WriteHelp;
  135.   end;
  136.  
  137.   function PtrDiff(HiPt, LoPt : Pointer) : LongInt;
  138.     {-Return the number of bytes between point HiPt^ and point LoPt^}
  139.   var
  140.     HiVal, LoVal : LongInt;
  141.   begin
  142.     HiVal := LongInt(Seg(HiPt^)) shl 4+LongInt(Ofs(HiPt^));
  143.     LoVal := LongInt(Seg(LoPt^)) shl 4+LongInt(Ofs(LoPt^));
  144.     PtrDiff := HiVal-LoVal;
  145.   end;
  146.  
  147.   function BlkRead(var F : file; var Buffer; Size : Word) : Boolean;
  148.     {-Convenient shell around BlockRead}
  149.   var
  150.     BytesRead : Word;
  151.   begin
  152.     BlockRead(F, Buffer, Size, BytesRead);
  153.     BlkRead := (IoResult = 0) and (BytesRead = Size);
  154.   end;
  155.  
  156.   function BlkWrite(var F : file; var Buffer; Size : Word) : Boolean;
  157.     {-Convenient shell around BlockWrite}
  158.   var
  159.     BytesWritten : Word;
  160.   begin
  161.     BlockWrite(F, Buffer, Size, BytesWritten);
  162.     BlkWrite := (IoResult = 0) and (BytesWritten = Size);
  163.   end;
  164.  
  165.   function GetDataSeg(var ExeF : file; ExeHeader : ExeHeaderRec) : Word;
  166.     {-Return the data segment of a Turbo EXE file}
  167.   type
  168.     FirstCallRec =
  169.     record
  170.       CallInstr : Byte;
  171.       Offset : Word;
  172.       Segment : Word;
  173.     end;
  174.     SetupDsRec =
  175.     record
  176.       MovInstr : Byte;
  177.       Segment : Word;
  178.     end;
  179.   var
  180.     Fcall : FirstCallRec;
  181.     SetupDs : SetupDsRec;
  182.     BaseCodeSeg : LongInt;
  183.     BytesRead : Word;
  184.   begin
  185.     Reset(ExeF, 1);
  186.  
  187.     with ExeHeader do begin
  188.       BaseCodeSeg := (LongInt(HeaderSize)+LongInt(CodeSeg)) shl 4;
  189.       Seek(ExeF, BaseCodeSeg+IpInit);
  190.       if IoResult <> 0 then
  191.         Error('Error during file seek');
  192.     end;
  193.     if not BlkRead(ExeF, Fcall, SizeOf(FirstCallRec)) then
  194.       Error('Error reading EXE file');
  195.  
  196.     {Interpret the first far call to the SYSTEM library initialization block}
  197.     with Fcall do begin
  198.       if CallInstr <> $9A then
  199.         Error('Not a Turbo Pascal 4.0 EXE file');
  200.       Seek(ExeF, BaseCodeSeg+(LongInt(Segment) shl 4)+LongInt(Offset));
  201.       if IoResult <> 0 then
  202.         Error('Error during file seek');
  203.     end;
  204.     if not BlkRead(ExeF, SetupDs, SizeOf(SetupDsRec)) then
  205.       Error('Error reading EXE file');
  206.  
  207.     {Interpret a MOV DX,dataseg instruction}
  208.     with SetupDs do begin
  209.       if MovInstr <> $BA then
  210.         Error('Not a Turbo Pascal 4.0 EXE file');
  211.       GetDataSeg := Segment;
  212.     end;
  213.   end;
  214.  
  215.   function ReadLongInt(Msg : string; default, min, max : LongInt) : LongInt;
  216.     {-Prompt for and get a long integer value}
  217.   var
  218.     s : string;
  219.     value : LongInt;
  220.     code : Word;
  221.   begin
  222.     repeat
  223.       Write(Msg, ' [', default, '] ');
  224.       ReadLn(s);
  225.       if s = '' then begin
  226.         ReadLongInt := default;
  227.         Exit;
  228.       end;
  229.       Val(s, value, code);
  230.       if code <> 0 then
  231.         WriteLn('Invalid integer')
  232.       else if (value < min) or (value > max) then
  233.         WriteLn('Value must be in range ', min, ' to ', max)
  234.       else begin
  235.         ReadLongInt := value;
  236.         Exit;
  237.       end;
  238.     until False;
  239.   end;
  240.  
  241.   procedure DumpExeHeader(ExeName : string);
  242.     {-Dump the EXE file header and relocation records}
  243.   var
  244.     ExeF : file;
  245.     ExeHeader : ExeHeaderRec;
  246.     BytesRead, I, LastSeg, ItemCount, DataSeg,
  247.     InitDataParas, UninitDataParas, StackAndStatic : Word;
  248.     ExeSize : LongInt;
  249.     MnHeap : LongInt;
  250.     MxHeap : LongInt;
  251.     L : LongInt;
  252.     Rel : RelocRec;
  253.   begin
  254.  
  255.     Assign(ExeF, ExeName);
  256.     Reset(ExeF, 1);
  257.     if IoResult <> 0 then
  258.       Error(ExeName+' not found');
  259.  
  260.     if not BlkRead(ExeF, ExeHeader, SizeOf(ExeHeaderRec)) then
  261.       Error('Error reading EXE file');
  262.  
  263.     with ExeHeader do begin
  264.  
  265.       if Signature <> $5A4D then
  266.         Error('File is not in EXE format');
  267.  
  268.       if LengthRem = 0 then
  269.         ExeSize := LongInt(LengthPages) shl 9
  270.       else
  271.         ExeSize := (LongInt(Pred(LengthPages)) shl 9)+LongInt(LengthRem);
  272.  
  273.       DataSeg := GetDataSeg(ExeF, ExeHeader);
  274.       InitDataParas := (ExeSize shr 4)-HeaderSize-DataSeg;
  275.       UninitDataParas := StackSeg-DataSeg-InitDataParas;
  276.       StackAndStatic := (StackPtr shr 4)+UninitDataParas;
  277.       MnHeap := LongInt(MinHeap-StackAndStatic) shl 4;
  278.       MxHeap := LongInt(MaxHeap-StackAndStatic) shl 4;
  279.  
  280.       WriteLn;
  281.       WriteLn('Code size:        ', PtrDiff(Ptr(DataSeg, 0), Ptr(CodeSeg, 0)), ' bytes');
  282.       WriteLn('Init data:        ', LongInt(InitDataParas) shl 4, ' bytes');
  283.       WriteLn('Uninit data:      ', LongInt(UninitDataParas) shl 4, ' bytes');
  284.       WriteLn('Stack:            ', StackPtr, ' bytes');
  285.       WriteLn('Min heap:         ', MnHeap, ' bytes');
  286.       WriteLn('Max heap:         ', MxHeap, ' bytes');
  287.       WriteLn;
  288.       WriteLn('EXE file size:    ', ExeSize, ' bytes');
  289.       WriteLn('Size of header:   ', 16*HeaderSize, ' bytes');
  290.       WriteLn('Number of fixups: ', NumReloc);
  291.       WriteLn('Code start:       ', HexW(CodeSeg), ':', HexW(IpInit));
  292.       WriteLn('Data segment:     ', HexW(DataSeg), ':', HexW(0));
  293.       WriteLn('Initial stack:    ', HexW(StackSeg), ':', HexW(StackPtr));
  294.  
  295.       if Patch then begin
  296.         WriteLn;
  297.         StackPtr := ReadLongInt('Enter stack size in bytes', StackPtr, 0, 65500);
  298.         L := ReadLongInt('Enter minimum heap size in bytes', MnHeap, 0, 1048576);
  299.         StackAndStatic := (StackPtr shr 4)+UninitDataParas;
  300.         MinHeap := StackAndStatic+(L shr 4);
  301.         L := ReadLongInt('Enter maximum heap size in bytes', MxHeap, MnHeap, 1048576);
  302.         MaxHeap := StackAndStatic+(L shr 4);
  303.         Reset(ExeF, 1);
  304.         if not BlkWrite(ExeF, ExeHeader, SizeOf(ExeHeaderRec)) then
  305.           Error('Error writing EXE file');
  306.       end else if ShowFixups then begin
  307.         {Provide a detailed dump of segment fixups}
  308.         WriteLn;
  309.         {        123456789012345678901234567890}
  310.         {        ssss     nnnn   }
  311.         WriteLn('Segment  Fixups');
  312.  
  313.         Seek(ExeF, RelocOfs);
  314.         if IoResult <> 0 then
  315.           Error('Error during file seek');
  316.  
  317.         LastSeg := $FFFF;
  318.         ItemCount := 0;
  319.  
  320.         for I := 1 to NumReloc do begin
  321.           if not BlkRead(ExeF, Rel, SizeOf(RelocRec)) then
  322.             Error('Error reading EXE file');
  323.           with Rel do begin
  324.             if Segment <> LastSeg then begin
  325.               if ItemCount <> 0 then
  326.                 WriteLn('     ', ItemCount);
  327.               Write(HexW(Segment));
  328.               LastSeg := Segment;
  329.               ItemCount := 0;
  330.             end;
  331.             Inc(ItemCount);
  332.           end;
  333.         end;
  334.         WriteLn('     ', ItemCount);
  335.       end;
  336.     end;
  337.     Close(ExeF);
  338.   end;
  339.  
  340. begin
  341.   Writeln('INFO 1.0, by TurboPower Software');
  342.   ParseCommandLine;
  343.   DumpExeHeader(ExeName);
  344. end.
  345.