Contributor: LARRY HADLEY             

{
Hi !

   Here is some source code I acquired from a Pascal echo some time
   ago. It shows one method of detecting which TP compiler created
   an .EXE:

-------------------------------------------------------------------
{ to compile type: tpc foo.pas }
{ exe: 9776 bytes by TP5.5 }

{$A+,B-,E-,F-,I+,N-,O-,V+}
{$M 4500,0,0}
{$ifndef debug}
{$D-,L-,R-,S-}
{$else}
{$D+,L+,R+,S+}
{$endif}

Program foo;

Uses
   DOS;  { dos unit from turbo pascal }

TYPE              { normal exe file header }
    EXEH = RECORD
          id,            { exe signature }
          Lpage,         { exe file size mod 512 bytes; < 512 bytes }
          Fpages,        { exe file size div 512 bytes; + 1 if Lpage > 0 }
          relocitems,    { number of relocation table items }
          size,          { exe header size in 16-byte paragraphs }
          minalloc,      { min mem. required in additional to exe image }
          maxalloc,      { extra max. mem. desired beyond that required
                           to hold exe's image }
          ss,            { displacement of stack segment }
          sp,            { initial SP register value }
          chk_sum,       { complemented checksum }
          ip,            { initial IP register value }
          cs,            { displacement of code segment }
          ofs_rtbl,      { offset to first relocation item }
          ovr_num : word; { overlay numbers }
       END;
                { window exe file header }
    WINH = RECORD
          id : word;     { ignore the rest of data structures }
       END;

    str2  = string [2];
    str4  = string [4];
    str10 = string [10];

CONST
    no_error  = 0;        { no system error }
    t         = #9;       { ascii: hortizon tab }
    dt        = t+t;
    tt        = t+t+t;
    qt        = t+t+t+t;
    cr        = #13#10;   { ascii: carriage return and line feed }

VAR
    f        : file;      { source file, untyped }
    exehdr   : exeh;      { exe header contents }
    winhdr   : winh;      { window exe header contents }
    blocks_r : word;      { number of blocks actually read }

    exe_size ,            { exe file length }
    hdr_size ,            { exe header size }
    img_size ,            { load module or exe image size }
    min_xmem ,            { min. extra memory needed }
    max_xmem ,            { max. extra memory wanted }
    o_starup : longint;   { offset to start up code }

    dirfile    : searchrec;
    compressed : boolean;

function Hex(B :byte) :str2;
 CONST  strdex :array [0..$F] of char = '0123456789ABCDEF';
 BEGIN  Hex := concat(strdex[B shr 4], strdex[B and $F]); END;

function HexW(W :word) :str4;
 VAR    byt :array [0..1] of byte absolute W;
 BEGIN  HexW := Hex(byt[1])+Hex(byt[0]); END;

function HexL(L :longint) :str10;
 TYPE   Cast = RECORD
                Lo :word;
                Hi :word;
         END;
 BEGIN  HexL := HexW(Cast(L).Hi)+' '+HexW(Cast(L).Lo); END;

procedure print_info;
   CONST
      psp_size = $100; { size of psp, bytes }
   VAR   i : byte;
   BEGIN
      hdr_size := longint(exehdr.size) shl 4;       { exe header size, bytes }
      img_size := longint(exe_size) - hdr_size;     { exe image size, bytes }
      min_xmem := longint(exehdr.minalloc) shl 4;   { mim xtra mem, bytes }
      max_xmem := longint(exehdr.maxalloc) shl 4;   { max xtra mem, bytes }
      o_starup := hdr_size + longint(exehdr.cs) shl 4
                  +longint(exehdr.ip);              { ofs to start up code  }
      writeln(
         qt, 'Dec':8, '':6, 'Hex', cr,
         'EXE file size:', tt, exe_size:8, '':3, hexl(exe_size), cr,
         'EXE header size:', dt, hdr_size:8, '':3, hexl(hdr_size), cr,
         'Code + initialized data size:', t, img_size:8, '':3, hexl(img_size)
             );

      writeln(
         'Pre-relocated SS:SP', tt, '':3, hexw(exehdr.ss), ':', hexw(exehdr.sp)
         , cr,
         'Pre-relocated CS:IP', tt, '':3, hexw(exehdr.cs), ':', hexw(exehdr.ip)
             );

      writeln(
         'Min. extra memory required:', t, min_xmem:8, '':3, hexl(min_xmem), cr,
         'Max. extra memory wanted:', t, max_xmem:8, '':3, hexl(max_xmem), cr,
         'Offset to start up code:', dt, '':3, hexl(o_starup), cr,
         'Offset to relocation table:', dt, '':3, hexw(exehdr.ofs_rtbl):9
             );

     writeln(
         'Number of relocation pointers:', t, exehdr.relocitems:8, cr,
         'Number of MS overlays:', dt, exehdr.ovr_num:8, cr,
         'File checksum value:', tt, '':3, hexw(exehdr.chk_sum):9, cr,
         'Memory needed to start:', dt, img_size+min_xmem+psp_size:8
            );
END; { print_info }

procedure id_signature;    { the core of this program }
   CONST
      o_01    =  14;        { relative offset from cstr0 to cstr1 }
      o_02    =  16;        {   "        "      "  cstr0 to cstr2 }
      o_03    =  47;        {   "        "      "  cstr0 to cstr3 }
      cstr0   = 'ntime';    { constant string existed in v4-6 }
      cstr1   = 'at '#0'.'; { constant string existed in v4-6 }
      cstr2   = '$4567';    { constant string existed in v5-6 }
      cstr3   = '83,90';    { constant string existed in v6 only }
      strlen  =   5;        { length of cstr? }
      ar_itm  =   3;        { items+1 of string array }

   { the following figures have been turn-up explicitly and
     should not be changed }

      ofs_rte =  25 shl 4;  { get close to 'run time error' str contants }
      maxchar =  11 shl 4;  { max. size of buffer; for scanning }

   TYPE
      arstr  = array [0..ar_itm] of string[strlen];
      arbuf  = array [0..maxchar] of char;

   VAR
      i, j, k : word;    { index counter for array buffer }
      cstr    : arstr;   { signatures generated by tp compiler }
      o_fseg  : word;    { to hold segment value of any far call }
      o_sysseg: longint; { offset to tp system_unit_segment }
      buffer  : arbuf;   { searching for target strings }

   BEGIN
{d}   Seek(f, o_starup + 3);                       { move file pointer 
forward 3 bytes }
{d}   BlockRead(f, o_fseg, sizeof(o_fseg));        { get far call segment 
value }
      o_sysseg := longint(o_fseg) shl 4 +hdr_size; { ofs to system obj code }
      if (o_sysseg + ofs_rte <= dirfile.size) then
      BEGIN
{d}      Seek(f, o_sysseg+ofs_rte);                { offset nearby tp 
signatures }
{d}      BlockRead(f, buffer, sizeof(buffer), blocks_r);
         for i := 0 to ar_itm do
         BEGIN
             cstr[i][0] := char(strlen);
             fillchar(cstr[i][1], strlen, '*');
         END;
         i := 1; j := 1; k := 0;
         repeat
            if buffer[i] in ['n','t','i','m','e'] then
            BEGIN
               if (k > 0) and (k = i - 1) then
                  inc(j);
               cstr[0][j] := buffer[i];
               k := i;
            END;
            inc(i);
         until (cstr[0] = cstr0) or (i > maxchar) or (j > strlen);
         if (i+o_03 <= maxchar) then
         BEGIN
            dec(i, strlen);
            move(buffer[i+o_01], cstr[1][1], strlen);
            if (cstr[1] = cstr1) then
            BEGIN
               writeln(
                    cr, 'Offset to TP system code:', dt, '':3,
                    hexl(o_sysseg):9
                      );

               write('Compiled by Borland TP v');

               move(buffer[i-o_02], cstr[2][1], strlen);

               if (cstr[2] = cstr2) then
               BEGIN
                  move(buffer[i+o_03], cstr[3][1], strlen);
                  if (cstr[3] = cstr3) THEN
                     writeln('6.0')
                  ELSE
                     writeln('5.0/5.5');
               END
               ELSE
                  writeln('4.0');
            END;
         END;
      END;
   END; {procedure}

procedure process_exefile;
   CONST
      ofs_whdr  = $3C;      { offset to MS-Window exe file id }
      exwid     = $454E;    { MS-Window exe file id }
   VAR
      o_sign,
      fsize   :longint;
   BEGIN
      if (exe_size = dirfile.size) then
      BEGIN
         print_info;
         if not compressed then
            id_signature;
         writeln;
      END
      else
      BEGIN
{d}      Seek(f, ofs_whdr);        { offset to 'offset to window exe 
signature' }
{d}      BlockRead(f, hdr_size, sizeof(hdr_size));
{d}      if (hdr_size <= dirfile.size) then
         BEGIN
            Seek(f, hdr_size);     { offset to new exe signature }
{d}         BlockRead(f, winhdr, sizeof(winhdr));
         END;
         if (winhdr.id = exwid) then
         BEGIN
            writeln('Dos/MS-Window EXE or DLL file');
            print_info;
            EXIT;
         END
         else
         BEGIN
            print_info;
            writeln(
               cr,
               'file size (', exe_size, ') calculated from EXE header ',
               '(load by DOS upon exec)', cr,
               'doesn''t match with file size (', dirfile.size, ') ',
               'recorded on file directory.', cr, cr,
               '* EXE file saved with extra bytes at eof (e.g. debug info)', cr,
               '* EXE file may contain overlays', cr,
               '* possible a corrupted EXE file', cr
                   );

            EXIT;
         END;
      END;
   END;

procedure id_file;
   CONST
      exeid = $5A4D;    { MS-DOS exe file id }

   VAR
      zero : str2;

   BEGIN
      if (exehdr.id = exeid) then
      BEGIN
         if (exehdr.cs = $FFF0) and
            (exehdr.ip = $0100) and
            (exehdr.ofs_rtbl = $50) or
            (exehdr.ofs_rtbl = $52) then
          BEGIN
             writeln('Compressed by PKLITE');
             compressed := true;
          END;
          if (exehdr.size = 2) and (exehdr.chk_sum = $899D) then
          BEGIN
             writeln( 'Compressed by DIET');
             compressed := true;
          END;
          if (exehdr.Lpage > 0) then
             exe_size := longint(exehdr.Fpages - 1) shl 9+exehdr.Lpage
          else
             exe_size := longint(exehdr.Fpages) shl 9;
          process_exefile;
      END
      else
         writeln('Not EXE file');
   END; {procedure}

CONST
   blocksize = 1; { file r/w block size in one-byte unit }

VAR
   path : dirstr;
   name : namestr;
   ext  : extstr;
   fstr : string[48];
   n    : byte;

BEGIN
   if paramcount < 1 then
      n := 0
   else
      n := 1;

   fsplit(paramstr(n), path, name, ext);
   if (name+ext = '*.*') or (name+ext = '.' ) or (name+ext = '' ) then
      fstr := path+'*.exe'
   else
      if (path+ext = '') then
         fstr := paramstr(n)+'.exe'
      else
         if not boolean(pos('.', ext)) then
         BEGIN
            path := path+name+'\';
            fstr := path+'*.exe';
         END
         else
            fstr := paramstr(n);

    n := 0;
{d} findfirst(fstr, anyfile, dirfile);
    while (doserror = no_error) do
    BEGIN
       if (dirfile.attr and volumeid <> volumeid) and
          (dirfile.attr and directory <> directory) and
          (dirfile.attr and sysfile <> sysfile) then
       BEGIN
          compressed := false;
          Assign(f, path+dirfile.name); {$I-}
{d}       Reset(f, blocksize); {$I+}
          if (IOResult = no_error) then
          BEGIN
             writeln(cr, dirfile.name);
{d}          BlockRead(f, exehdr, sizeof(exehdr), blocks_r);
             if (blocks_r = sizeof(exehdr)) then
                id_file
             else
                writeln('err:main');
             close(f);
             inc(n);
          END;
       END;
{d}    findnext(dirfile);
    END;

    if (n = 0) then
       if doserror = 3 then
          writeln('path not found')
       else
          writeln('file not found')
       else
          writeln(n,' files found');
END.