The World of Computer Software/World_Of_Computer_Software-02-385-Vol-1of3.iso/t/tcsel003.zip/SELFMOD.PAS

Pascal/Delphi Source File | 1992-10-17 | 8KB | 223 lines

{$X+}
unit selfmod;

 { Author Trevor J Carlsen - released into the public domain 1991            }
 {        PO Box 568                                                         }
 {        Port Hedland                                                       }
 {        Western Australia 6721                                             }
 {        Voice [phone]  Data [phone]                         }
 {        FidoNet 3:690/644                                                  }
 { Allows a program to self modify a typed constant in the .exe file.  It    }
 { also performs an automatic checksum type .exe file integrity check.       }
 { A longint value is added to the end of the exe file.  This can be read by }
 { a separate configuration program to enable it to determine the start of   }
 { the programs configuration data area.  To use this the configuration      }
 { typed constant should be added immediately following the declaration of   }
 { ExeData.                                                                  }

 { Where this unit is used, it should always be the FIRST unit listed in the }
 { uses declaration area of the main program.                                }

 { Requires DOS 3.3 or later.  Program must not be used with PKLite or LZExe }
 { or any similar exe file compression programs. It may also cause           }
 { difficulties on a network or virus detection programs.                    }

 { The stack size needed is at least 9,000 bytes.                            }

interface

uses
  globals;

type
  ExeDatatype    = record
                     IDStr      : str7;
                     UserName   : str35;
                     FirstTime  : boolean;
                     NumbExecs  : shortint;
                     Hsize      : word;
                     ExeSize    : longint;
                     CheckSum   : longint;
                     StartConst : longint;
                     RegCode    : longint;
                   end;
const
  ExeData : ExeDatatype = (IDStr     : 'ID-AREA';
                           UserName  : '';
                           FirstTime : true;
                           NumbExecs : -1;
                           Hsize     : 0;
                           ExeSize   : 0;
                           CheckSum  : 0;
                           StartConst: 0;
                           RegCode   : 0);


{$I p:\prog\freeload.inc} { Creates CodeStr that MUST match RegStr }

{$I p:\prog\registed.inc} { Creates CodeChkStr that MUST hash to RegCode}

const
  mark  : byte = 0;

var
  first : boolean;

procedure Hash(p : pointer; numb : byte; var result: longint);

function Write2Exec(var data; size: word): boolean;

implementation


procedure Hash(p : pointer; numb : byte; var result: longint);
  { When originally called numb must be equal to sizeof    }
  { whatever p is pointing at.  If that is a string numb   }
  { should be equal to length(the_string) and p should be  }
  { ptr(seg(the_string),ofs(the_string)+1)                 }
  var
    temp,
    w    : longint;
    x    : byte;

  begin
    temp := longint(p^);  RandSeed := temp;
    for x := 0 to (numb - 4) do begin
      w := random(maxint) * random(maxint) * random(maxint);
      temp := ((temp shr random(16)) shl random(16)) +
                w + MemL[seg(p^):ofs(p^)+x];
    end;
    result := result xor temp;
  end;  { Hash }


procedure InitConstants;
  var
    f           : file;
    tbuff       : array[0..1] of word;

  function GetCheckSum : longint;
    { Performs a checksum calculation on the exe file }
    var
      finished  : boolean;
      x,
      CSum      : longint;
      BytesRead : word;
      buffer    : array[0..4095] of word;
    begin
      {$I-}
      seek(f,0);
      finished := false;  CSum := 0;  x := 0;
      BlockRead(f,buffer,sizeof(buffer),BytesRead);
      while not finished do begin             { do the checksum calculations }
        repeat         { until file has been read up to start of config area }
          inc(CSum,buffer[x mod 4096]);
          inc(x);
          finished := ((x shl 1) >= ExeData.StartConst);
        until ((x mod 4096) = 0) or finished;
        if not finished then                { data area has not been reached }
          BlockRead(f,buffer,sizeof(buffer),BytesRead);
      end;
      GetCheckSum := CSum;
    end; { GetCheckSum }


  begin
    assign(f, ParamStr(0));
    {$I-} Reset(f,1);
    with ExeData do begin
      first := FirstTime;
      if FirstTime and (IOResult = 0) then begin
        Seek(f,2);                   { this location has the executable size }
        BlockRead(f,tbuff,4);
        ExeSize := tbuff[0]+(pred(tbuff[1]) shl 9);
        seek(f,8);                                    {  get the header size }
        BlockRead(f,hsize,2);
        FirstTime := false;
        StartConst := longint(hsize+Seg(ExeData)-PrefixSeg) shl 4 +
                      Ofs(ExeData) - 256;
        CheckSum := GetCheckSum;
        Seek(f,StartConst);
        BlockWrite(f,ExeData,sizeof(ExeData));
        seek(f,FileSize(f));
        BlockWrite(f,StartConst,4);
      end
      else
        if GetCheckSum <> CheckSum then begin
          writeln('File has been tampered with.  Checksum incorrect');
          halt;
        end;
    end;  { with }
    Close(f); {$I+}
    if IOResult <> 0 then begin
      writeln('Unable to initialise program');
      halt;
    end;
  end; { InitConstants }


function Write2Exec(var data; size: word): boolean;
 { Writes a new typed constant into the executable file after first checking }
 { that it is safe to do so.  It does this by ensuring that the IDString is  }
 { at the file offset expected.                                              }
  const
    FName : str40 = '';
  var
     f          : file;
     st         : str8;
     BytesRead  : word;
  begin
    if UseCfg then begin
      if length(FName) = 0 then begin
        TempStr    := ParamStr(0);
        TempStrLen := pos('.',TempStr) - 2;
        FName      := TempStr + ' .   ';
        {                        │ │││                                       }
        {                        │ ││└────»» #255                            }
        {                        │ │└─────»» #32                             }
        {                        │ └──────»» #255                            }
        {                        └────────»» #255                            }
        { Using the above file name for the configuration file makes the     }
        { deletion of the file difficult for the average user.               }
      end; { if length }
      assign(f, FName);
      if exist(FName) then begin
        {$I-}
        reset(f,1);
        if first then begin
          first := false;
          BlockRead(f, ExeData, ofs(mark)-ofs(ExeData),BytesRead)
        end else
          BlockWrite(f,data,size);
      end else begin
        rewrite(f,1);
        BlockWrite(f,Data,size);
      end;
      close(f);
      {$I+}
      Write2Exec := IOResult = 0;
    end else begin
      assign(f, ParamStr(0));
      {$I-} Reset(f,1);
      Seek(f,longint(ExeData.Hsize+Seg(ExeData)-PrefixSeg) shl 4
                     + Ofs(ExeData)- 256);
      BlockRead(f,st,9);
      if st = ExeData.IDStr then { all Ok to proceed } begin
        Seek(f,longint(ExeData.Hsize+Seg(data)-PrefixSeg) shl 4
                       + Ofs(data)- 256);
        BlockWrite(f,data,size);
        Close(f); {$I+}
        Write2Exec := IOResult = 0;
      end else
        Write2Exec := false;
    end;
  end; { Write2Exec }

begin
  first :=  true;
  if not UseCfg then
    InitConstants
  else
    Write2Exec(ExeData,ofs(mark)-ofs(ExeData));
end.