[Back to DOS SWAG index] [Back to Main SWAG index] [Original]

    {
    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.

[Back to DOS SWAG index] [Back to Main SWAG index] [Original]