sacc.pas

将部份信息储存於可执行文档 (.EXE ) 中的技巧

{
Simple AntiCopy Component, version 2.14

Author: Oleg Soubatchev

45A - 11, Zavodskaya St., V-109, Ekaterinburg, 620109, Russia
[e-mail], [e-mail], ICQ 16025691

Version history:
2.00 - initial published version
2.01 - slight improvements
2.10 - the problem with opening running .EXE file to modify it under WIN32
       is solved
2.11 - included new function (FIND_ID_32) with source for finding ID in file
       FIND_ID_32 works only under Win32
       FIND_ID_FROM_END from FIND_ID.DCU works under both Win32 and Win16
2.12 - added FIND_ID.DCU compiled by Delphi 4 (Build 5.33)
2.13 - now FIND_ID.DCU is compiled by Delphi 4.02 (Build 5.104)
2.14 - fixed the bug that caused the protected application not to work with long
       file names containing spaces (thanks to Habib Debs [e-mail])
       source of my Turbo Pascal AntiCopy unit is included
}

{$B-}

{$IFDEF WIN32}
  { $DEFINE USE_FIND_ID_32}                     // define this to use FIND_ID_32
{$ENDIF}

unit SACC;
{ Copyright (C) 1992-99 by Oleg Soubatchev, Ekaterinburg, Russia }

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs;

type
  TSACCOption = (
                 START_DR,               { check for application's start drive }
                 FULL_PATH                 { check for application's full path }
                );
  TSACCOptions = set of TSACCOption;

  TSACC = class( TComponent )
  private
    FOptions : TSACCOptions;
    FOnPROTECT : TNotifyEvent;
    procedure SetOptions( Value : TSACCOptions );
    function VSE_OK : boolean;
  protected
    procedure DoOnPROTECT; dynamic;
  public
    constructor Create( AOwner : TComponent ); override;
    procedure GO_SACC;
  published
    property Options : TSACCOptions read FOptions write SetOptions
      default [ FULL_PATH ];
    property OnPROTECT : TNotifyEvent read FOnPROTECT write FOnPROTECT;
  end;                                                                 { TSACC }

procedure Register;

implementation

{$IFNDEF USE_FIND_ID_32}
uses
  FIND_ID;
{$ENDIF}

procedure COPY_RIGHT;
{ because description directive ($D) is allowed only in program or DLL }
{ I use this routine for the same purpose }
var
  sCR : string;
begin
         { this text will appear in .DCU }
  sCR := ' Simple AntiCopy Component ver. 2.14 is Copyright (C)' +
         ' 1992-99 by Oleg Soubatchev, Ekaterinburg, Russia,' +
         ' [e-mail], [e-mail], ICQ 16025691 ';
end;                                                              { COPY_RIGHT }

{$IFDEF WIN32}
  {$IFDEF USE_FIND_ID_32}
function FIND_ID_32( sFN : TFileName; var ID; IdSize : Word ) : LongInt;
var
  sID, sFILE : AnsiString;
begin
  SetLength( sID, IdSize );
  Move( ID, sID[ 1 ], IdSize );
  with TMemoryStream.Create do
    try
      LoadFromFile( sFN );
      SetLength( sFILE, Size );
      Move( Memory^, sFILE[ 1 ], Size );
    finally
      Free;
    end;
  { Pred converts 1-based string offset into 0-based file offset }
  Result := Pred( Pos( sID, sFILE ));
end;                                                               // FIND_ID_32
  {$ENDIF}
{$ENDIF}

constructor TSACC.Create( AOwner : TComponent );
begin
  inherited Create( AOwner );
  FOptions := [ FULL_PATH ];
end;                                                            { TSACC.Create }

procedure TSACC.DoOnPROTECT;
begin
  if Assigned( FOnPROTECT )
    then FOnPROTECT( Self );
end;                                                       { TSACC.DoOnPROTECT }

procedure TSACC.SetOptions( Value : TSACCOptions );
begin
  if FOptions <> Value
    then FOptions := Value;
end;                                                        { TSACC.SetOptions }

procedure Register;
begin
  RegisterComponents( 'POSOl', [ TSACC ] );
end;                                                                { Register }

type
  TSACC_DATA =
    record
      case integer of
        1: ( SACC_ID : string[ 255 ]);           { 256 bytes will be allocated }
        2: (
          EXEC_1 : ByteBool;                         { flag of first execution }
          ac_STRTDR : byte;                { protected .EXE file's start drive }
          ac_FLLPTH : word;                { information about full start path }
                                                      { of protected .EXE file }
           );
    end;                                                          { TSACC_DATA }

const
  SACC_DATA : TSACC_DATA = ( SACC_ID : 'SACC_ID' );

var
  lSIFO : longint;                                       { SACC_ID file offset }
  f : integer;                            { file handle of protected .EXE file }
  bySTRTDR : byte;
  wFLLPTH : word;

procedure DETERMINE;
{ determines information for checking }
var
  I : integer;
  S : string;
begin
  wFLLPTH := 0;
  S := ExtractFilePath( Application.ExeName );
  for I := 1 to Length( S )
    do Inc( wFLLPTH, Ord( S[ I ] ));
  { not is added for "encryption" }
  bySTRTDR := not ( Ord( S[ 1 ] ));
end;                                                               { DETERMINE }

procedure ZAPIS; { <- russian for "writing" }
{ writes information for checking in file f }

var
  lDT : longint;                         { date and time for File(Get-Set)Date }

  procedure SACC_SEEK( const lOFFS : longint );
  { moves current position in f to lOFFS }
  begin
    FileSeek( f, lOFFS, 0 );
  end;                                                           { SACC_SEEK }

  function FASP( var TC ) : longint;
  { returns file offset of typed constant TC }
  begin
    with SACC_DATA do
      FASP := lSIFO +
      {$IFDEF WIN32}
        ( LongInt( Addr( TC )) - LongInt( Addr( SACC_ID[ 0 ])));
      {$ELSE}
        ( Ofs( TC ) - Ofs( SACC_ID[ 0 ]));
      {$ENDIF}
  end;                                                                { FASP }

begin                                                                  { ZAPIS }
  lDT := FileGetDate( f );     { save date and time of the protected .EXE file }
{ writing new values of typed constants into .EXE file }
  with SACC_DATA do
    begin
      EXEC_1 := False;
      SACC_SEEK( FASP( EXEC_1 ));
      FileWrite( f, EXEC_1, SizeOf( EXEC_1 ));
      SACC_SEEK( FASP( ac_FLLPTH ));
      FileWrite( f, wFLLPTH, SizeOf( wFLLPTH ));
      SACC_SEEK( FASP( ac_STRTDR ));
      FileWrite( f, bySTRTDR, SizeOf( bySTRTDR ));
    end;
  FileSetDate( f, lDT );    { restore date and time of the protected .EXE file }
end;                                                                   { ZAPIS }

function TSACC.VSE_OK : boolean;
begin
  with SACC_DATA
    do Result := (not (FULL_PATH in FOptions) or (ac_FLLPTH = wFLLPTH))
             and (not (START_DR in FOptions) or (ac_STRTDR = bySTRTDR));
end;                                                            { TSACC.VSE_OK }

procedure TSACC.GO_SACC;
{ main routine that performs all work }
{$IFDEF WIN32}
var
  sTEN : string;                                          // temporary .EXE name
{$ENDIF}
begin
  if not ( csDesigning in ComponentState ) then
    begin
      DETERMINE;
    {$IFDEF WIN32}
      sTEN := ExtractFilePath( Application.ExeName ) + 'SACCSACC.EXE';
      if ( Application.ExeName <> sTEN ) and FileExists( sTEN )
        then                                     // we are here just after {*2*}
          repeat                    // delete sTEN after modifying original .EXE
            Application.ProcessMessages;
          until DeleteFile( PChar( sTEN ));
    {$ENDIF}
      if SACC_DATA.EXEC_1
        then                                           { it is first execution }
          begin
          {$IFDEF WIN32}
            if Application.ExeName <> sTEN
              then                                   // the very first execution
                begin
                  CopyFile( PChar( Application.ExeName ), PChar( sTEN ), False );
{*1*}             WinExec( PChar( sTEN + ' "' + Application.ExeName + '"' ), {2.14}
                           SW_SHOWNORMAL );
                  Halt;
                end
              else               // we are here in SACCSACC.EXE just after {*1*}
                repeat                                              // get lSIFO
                  Application.ProcessMessages;
                  try
                    with SACC_DATA do
                      lSIFO :=
                    {$IFDEF USE_FIND_ID_32}
                      FIND_ID_32
                    {$ELSE}
                      FIND_ID_FROM_END
                    {$ENDIF}
                      ( ParamStr( 1 ), SACC_ID[ 0 ], Length( SACC_ID ) + 1 );
                  except
                  {$IFDEF USE_FIND_ID_32}
                    on EFOpenError do lSIFO := 0;
                  {$ELSE}
                    on EInOutError do lSIFO := 0;
                  {$ENDIF}
                  end;
                until lSIFO > 0;                           // wait until success
                repeat                  // open original .EXE to modify it later
                  Application.ProcessMessages;
                  f := FileOpen( ParamStr( 1 ), fmOpenReadWrite + fmShareDenyNone );
                until f > 0;                               // wait until success
          {$ELSE}                                                      { WIN16 }
            with SACC_DATA do
              lSIFO := FIND_ID_FROM_END( Application.ExeName,
                       SACC_ID[ 0 ], Length( SACC_ID ) + 1 );
            f := FileOpen( Application.ExeName, fmOpenReadWrite );
          {$ENDIF}
            try
              if f <= 0
                then Halt;
              ZAPIS;
            finally
              FileClose( f );
            end;
          {$IFDEF WIN32}
            // start original .EXE after modification
{*2*}       WinExec( PChar( ParamStr( 1 )), SW_SHOWNORMAL );
            Halt;
          {$ENDIF}
          end
        else                                       { it is not first execution }
          if not VSE_OK
            then DoOnPROTECT;
    end;
end;                                                           { TSACC.GO_SACC }

end.

{
other information that may be checked:
- BIOS date
- IDE HDD controller information
  ( unique for each IDE HDD, but hard to get under Win32 )
- volume serial number
- boot sector of drive C:
- equipment word from BIOS data
- CMOS values
- file length
- control sum of file
- file name
- size of current drive
- current directory
- number of first cluster of file
- partition table
- OS version
- presence of some drivers
- MAC address of LAN card ( very good - unique for each card,
  the only problem is absence of LAN card in the PC 8-)
}