home *** CD-ROM | disk | FTP | other *** search
/ Computer Installation Guide - Dragon Clan Series / CD2.iso / ZIP / WWPACK / WWP304 / PASCAL / CHK_WWP.PAS next >
Encoding:
Pascal/Delphi Source File  |  1996-01-05  |  3.9 KB  |  120 lines
  1. { Copyright (c) 1994-96 by Piotr Warezak and Rafal Wierzbicki, Lodz, Poland
  2.  
  3.   Check_if_packed function; for Turbo Pascal 5.X, 6.0 and 7.0.
  4.  
  5.   =========================================================================
  6.  
  7.   Incompatibility problems please report to:  awarezak@krysia.uni.lodz.pl
  8.   or to any WWPACK official distribution site.
  9.  
  10.   This program is public domain and may be freely distributed.
  11.  
  12.   =========================================================================
  13.  
  14.   function check_if_packed(var f:file);
  15.        checks if the assigned and opened file is compressed with WWPACK.
  16.  
  17.        Function returns byte:
  18.  
  19.            when the file is compressed with WWPACK function returns
  20.            WWPACK version and compression command:
  21.                         3.00     3.01    3.02    3.03    3.04
  22.                  PR        9        9      14      17      21
  23.                  P        10       12      15      18      22
  24.                  PU       11       13      16      19      23
  25.                  PP      n/a      n/a     n/a      20      24
  26.  
  27.            or:
  28.                  0  -  not packed with WWPACK
  29.                  1  -  not an EXE file
  30.                  2  -  unrecognized WWPACK version
  31.                  3  -  error while reading the file
  32.  
  33.   ========================================================================= }
  34.  
  35. function check_if_packed(var f:file):byte;        { Warning:  'f' must be }
  36. var start,size,old_position:longint;              { assigned and opened   }
  37.     header:array [1..16]of word;                  { EXE file.             }
  38.     buf:array [1..75] of Byte;
  39.     ver:word;
  40. begin
  41. {$I-}
  42.   ver:=0;
  43.  
  44. {***  store old FilePosition  ***}
  45.   old_position:=filepos(f);
  46.   seek(f,0);size:=filesize(f);
  47.   if ioresult<>0 then
  48.   begin
  49.     check_if_packed:=3;seek(f,old_position);ver:=ioresult;exit;
  50.   end;
  51.  
  52. {***  check if EXE file ***}
  53.   if size<32 then
  54.   begin
  55.     check_if_packed:=1;seek(f,old_position);exit;
  56.   end;
  57.   blockread(f,header,32);
  58.   if (header[1]<>ord('M')+256*ord('Z')) and (header[1]<>ord('Z')+256*ord('M')) then
  59.   begin
  60.     check_if_packed:=1;seek(f,old_position);exit;
  61.   end;
  62.   if ioresult<>0 then
  63.   begin
  64.     check_if_packed:=3;seek(f,old_position);ver:=ioresult;exit;
  65.   end;
  66.  
  67. {***  jump to the begin of the code (jump to CS:IP address)  ***}
  68.   start:=longint(header[12])*16+header[11]+header[5]*16;
  69.   if start>=65536*16 then dec(start,65536*16);
  70.   if start+74<size then
  71.   begin
  72.  
  73. {***  read first 75 bytes of the code  ***}
  74.     Seek(f,start-2);BlockRead(f,buf[1],75);
  75.     if ioresult<>0 then
  76.     begin
  77.       check_if_packed:=3;seek(f,old_position);ver:=ioresult;exit;
  78.     end;
  79.  
  80. {***  check if WWPACK 3.00/3.01 PR code  ***}
  81.     if (buf[3]=$be) and (buf[6]=$ba) and (buf[9]=$bf) and (buf[12]=$b9) then
  82.     begin
  83.       if buf[2]=9 then ver:=9
  84.       else
  85.       begin
  86.         check_if_packed:=2;
  87.         seek(f,old_position);
  88.         exit;
  89.       end;
  90.     end;
  91.  
  92. {***  check if WWPACK 3.02/3.03/3.04 PR code  ***}
  93.     if (buf[3]=$be) and (buf[6]=$bf) and (buf[9]=$b9) and (buf[12]=$8c) and
  94.        (buf[13]=$cd) and (buf[14]=$81) and (buf[15]=$ed) and (buf[18]=$8b) and
  95.        (buf[19]=$dd) then
  96.     begin
  97.       buf[2]:=buf[2]+14;ver:=buf[2];
  98.       if (ver<>14) and (ver<>17) and (ver<>21) then
  99.       begin
  100.         check_if_packed:=2;seek(f,old_position);exit;
  101.       end;
  102.     end;
  103.  
  104. {***  check if WWPACK 3.0x P/PU/PP code  ***}
  105.     if (buf[3]=$b8) and (buf[6]=$8c) and (buf[7]=$ca) and (buf[8]=$03) and
  106.        (buf[9]=$d0) and (buf[10]=$8c) and (buf[11]=$c9) and (buf[12]=$81) and
  107.        (buf[16]=$51) then
  108.     begin
  109.       ver:=buf[2];
  110.       if (ver<10) or (ver>24) or (ver=14) or (ver=17) or (ver=21) then
  111.       begin
  112.         check_if_packed:=2;seek(f,old_position);exit;
  113.       end;
  114.     end;
  115.   end;
  116.  
  117. {***  restore old FilePosition and return WWPACK's version  ***}
  118.   check_if_packed:=ver;seek(f,old_position);
  119. {$I+}
  120. end;