Solved

How to use  demo project with primar unit and explanation about demo tasks

Posted on 2011-02-17
13
1,214 Views
Last Modified: 2012-05-11
Am using registerHW from demo aplication from mxprotector component from:
http://delphi.about.com/od/productreviews/l/aa022503a.htm
Download link;
http://www.o-delphi.narod.ru/down/komp/mxProtector.zip


And my question is about:
If i have project made in way as on a picture Unit1 will not start.
and if i put Unit 1 as first in project tree - registrationHW won't show up.
how to enable them together?

And maybe is better if at first we clear options of registrationHW window:
Username?
Hardware ID?
Serial number?
Get serial?
Go?
Quit?
Register?
Reset?

hw2.JPG
0
Comment
Question by:pr2501
  • 5
  • 3
  • 3
  • +1
13 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
without some code, it's like asking a blind man for directions to the nearest train station ... :)
0
 
LVL 2

Assisted Solution

by:LelikInside
LelikInside earned 50 total points
Comment Utility
program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm2, Form2);

  Form1.Show;
  Form2.ShowModal;

  Application.Run;
end.

Open in new window

0
 
LVL 2

Expert Comment

by:LelikInside
Comment Utility
Form1 - your main application form and Form2 - your login/password form
0
 

Author Comment

by:pr2501
Comment Utility
 Form1.Show;
  Form2.ShowModal;

Helps.

I have attached code, can you help me now pleas?
// ****************************************************************************
// * mxProtector component for Delphi.
// ****************************************************************************
// * Copyright 2001-2003, Bitvadász Kft. All Rights Reserved.
// ****************************************************************************
// * Feel free to contact me if you have any questions, comments or suggestions
// * at support@maxcomponents.net
// ****************************************************************************
// * Web page: www.maxcomponents.net
// ****************************************************************************
// * Date last modified: 18.06.2003
// ****************************************************************************
// * TmxProtector v1.30
// ****************************************************************************
// * Description:
// *
// * You can add protection to your applications.
// *
// ****************************************************************************

Unit mxProtector;

Interface

// *************************************************************************************
// ** List of used units
// *************************************************************************************

Uses
     Windows,
     SysUtils,
     Dialogs,
     ActiveX,
     ComObj,
     Classes;

{$I MAX.INC}

Const
     mxProtectorVersion = $011E; // ** 1.30 **

Type
     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TmxRegistryRootKey = ( rkCurrentUser, rkLocalMachine );

     TmxProtectionType = ( stDayTrial, stPassword, stRegister, stStartTrial, stTimeTrial );
     TmxProtectionTypeSet = Set Of TmxProtectionType;

     TmxProtectionOption = ( poAutoInit, poCheckSytemTime, poPasswordOnce, poUseHardwareKey, poUniqueHardwareID, poWorkAfterExpiration );
     TmxProtectionOptionSet = Set Of TmxProtectionOption;

     TmxRegistrationType = ( rtUnknown, rtRegistered, rtUnRegistered );

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TEventOnCodeData = Procedure( Sender: TObject; Var ACode: String ) Of Object;
     TEventOnReset = Procedure( Sender: TObject; Var Handled: Boolean ) Of Object;
     TEventOnGetRegistryPath = Procedure( Sender: TObject; Var APath: String ) Of Object;
     TEventOnGetString = Procedure( Sender: TObject; Var APath: String; Var AKey: String; Var AResult: String; Var Handled: Boolean ) Of Object;
     TEventOnGetBoolean = Procedure( Sender: TObject; Var APath: String; Var AKey: String; Var AResult: Boolean; Var Handled: Boolean ) Of Object;
     TEventOnPutString = Procedure( Sender: TObject; Var APath: String; Var AKey: String; Var ASavedData: String; Var Handled: Boolean ) Of Object;
     TEventOnPutBoolean = Procedure( Sender: TObject; Var APath: String; Var AKey: String; Var ASavedData: Boolean; Var Handled: Boolean ) Of Object;

     TEventOnGetPassword = Procedure( Sender: TObject; Var Password: String ) Of Object;
     TEventOnWrongPassword = Procedure( Sender: TObject; WrongPassword: String ) Of Object;
     TEventOnStartTrial = Procedure( Sender: TObject; StartsRemained: Integer ) Of Object;
     TEventOnTimeTrial = Procedure( Sender: TObject; DaysRemained: Integer ) Of Object;
     TEventOnDayTrial = Procedure( Sender: TObject; DaysRemained: Integer ) Of Object;
     TEventOnInvalidTimeTrial = Procedure( Sender: TObject; DaysRemained: Integer ) Of Object;
     TEventOnGetSerialNumber = Procedure( Sender: TObject; Var UserName, SerialNumber: String ) Of Object;
     TEventOnGetHardwareID = Procedure( Sender: TObject; Var HardwareID: String ) Of Object;
     TEventOnRegister = Procedure( Sender: TObject; UserName, SerialNumber: String ) Of Object;
     TEventOnCheckRegistration = Procedure( Sender: TObject; Var UserName, SerialNumber: String; Var Registered: Boolean ) Of Object;

     // ************************************************************************
     // ************************************************************************
     // ************************************************************************

     TmxProtector = Class( TComponent )
     Private

          FVersion: Integer;
          FRegistryRootKey: TmxRegistryRootKey;

          FOnCodeData: TEventOnCodeData;
          FOnDeCodeData: TEventOnCodeData;
          FOnReset: TEventOnReset;
          FOnGetRegistryPath: TEventOnGetRegistryPath;
          FOnGetString: TEventOnGetString;
          FOnGetBoolean: TEventOnGetBoolean;
          FOnPutString: TEventOnPutString;
          FOnPutBoolean: TEventOnPutBoolean;

          FPassword: String;
          FCodeKey: String;
          FExpiration: TDateTime;
          FMaxStartNumber: Integer;
          FMaxDayNumber: Integer;
          FUniqueID: String;
          FInternalStrPassword: String;
          FProtectionTypes: TmxProtectionTypeSet;
          FOptions: TmxProtectionOptionSet;
          FUserName: String;

          FRegistration: TmxRegistrationType;

          FOnGetPassword: TEventOnGetPassword;
          FOnWrongPassword: TEventOnWrongPassword;
          FOnValidPassword: TNotifyEvent;
          FOnExpiration: TNotifyEvent;
          FOnStartTrial: TEventOnStartTrial;
          FOnTimeTrial: TEventOnTimeTrial;
          FOnDayTrial: TEventOnDayTrial;
          FOnInvalidSystemTime: TNotifyEvent;
          FOnInvalidSerialNumber: TNotifyEvent;
          FOnInitialization: TNotifyEvent;
          FOnUnknownHardware: TNotifyEvent;
          FOnInvalidHardwareID: TNotifyEvent;
          FOnGetHardwareID: TEventOnGetHardwareID;

          FOnBeforeRegister: TNotifyEvent;
          FOnRegister: TEventOnRegister;
          FOnAfterRegister: TNotifyEvent;
          FOnCheckRegistration: TEventOnCheckRegistration;

          FOnGetSerialNumber: TEventOnGetSerialNumber;
          FOnRegisteredVersion: TNotifyEvent;
          FOnUnRegisteredVersion: TNotifyEvent;

          FFirstAfterStart: Boolean;

          Procedure SetVersion( Value: String );
          Function GetVersion: String;

          Procedure SetProtectionTypes( Value: TmxProtectionTypeSet );
          Procedure SetOptions( Value: TmxProtectionOptionSet );
          Procedure SetPassword( Value: String );
          Procedure SetUserName( Value: String );
          Procedure SetCodeKey( Value: String );
          Procedure SetExpiration( Value: TDateTime );
          Procedure SetMaxStartNumber( Value: Integer );
          Procedure SetMaxDayNumber( Value: Integer );

          Procedure ReadUniqueID( Reader: TReader );
          Procedure WriteUniqueID( Writer: TWriter );
          Procedure ReadUniqueCodeID( Reader: TReader );
          Procedure WriteUniqueCodeID( Writer: TWriter );

          Function Delete_Key: Boolean;
          Function Get_String( AKey, ADefval: String ): String;
          Function Get_Boolean( AKey: String; ADefval: Boolean ): Boolean;
          Procedure Put_String( AKey, AVal: String );
          Procedure Put_Boolean( AKey: String; AVal: Boolean );

          Function InternalGetHardwareID: String;

     Protected

          Function CodePassword( Value: String; Internal: Boolean ): String;
          Function DeCodePassword( Value: String; Internal: Boolean ): String;
          Function IncreaseDate( AValue: TDateTime; ADays, AMonths, AYears: Integer ): TDateTime;
          Procedure DefineProperties( Filer: TFiler ); Override;
          Procedure Loaded; Override;
          Function GetRegistryPath: String;
          Function GetRegistryKey: String;

     Public

          Constructor Create( AOwner: TComponent ); Override;
          Destructor Destroy; Override;

          Procedure Init;
          Procedure Reset;

          Procedure CheckPassword;
          Procedure CheckStartTrial;
          Procedure CheckTimeTrial;
          Procedure CheckDayTrial;
          Procedure CheckRegistration;
          Procedure Registration;
          Function IsRegistered: Boolean;
          Function GetRegisteredUserName: String;

          Function GetDayNumber: Longint;
          Function GetLicencedDayNumber: Longint;
          Function GetHardwareID: String;

          Function GenerateSerialNumber( AUserName: String ): String;

     Published

          Property CodeKey: String Read FCodeKey Write SetCodeKey;
          Property Password: String Read FPassword Write SetPassword;
          Property ProtectionTypes: TmxProtectionTypeSet Read FProtectionTypes Write SetProtectionTypes;
          Property Options: TmxProtectionOptionSet Read FOptions Write SetOptions;
          Property RegistryRootKey: TmxRegistryRootKey Read FRegistryRootKey Write FRegistryRootKey;

          Property Expiration: TDateTime Read FExpiration Write SetExpiration;
          Property MaxStartNumber: Integer Read FMaxStartNumber Write SetMaxStartNumber;
          Property MaxDayNumber: Integer Read FMaxDayNumber Write SetMaxDayNumber;
          Property UserName: String Read FUserName Write SetUserName;

          Property Version: String Read GetVersion Write SetVersion;

          Property OnBeforeRegister: TNotifyEvent Read FOnBeforeRegister Write FOnBeforeRegister;
          Property OnRegister: TEventOnRegister Read FOnRegister Write FOnRegister;
          Property OnAfterRegister: TNotifyEvent Read FOnAfterRegister Write FOnAfterRegister;
          Property OnCheckRegistration: TEventOnCheckRegistration Read FOnCheckRegistration Write FOnCheckRegistration;

          Property OnInitialization: TNotifyEvent Read FOnInitialization Write FOnInitialization;
          Property OnGetPassword: TEventOnGetPassword Read FOnGetPassword Write FOnGetPassword;
          Property OnValidPassword: TNotifyEvent Read FOnValidPassword Write FOnValidPassword;
          Property OnWrongPassword: TEventOnWrongPassword Read FOnWrongPassword Write FOnWrongPassword;
          Property OnExpiration: TNotifyEvent Read FOnExpiration Write FOnExpiration;
          Property OnStartTrial: TEventOnStartTrial Read FOnStartTrial Write FOnStartTrial;
          Property OnTimeTrial: TEventOnTimeTrial Read FOnTimeTrial Write FOnTimeTrial;
          Property OnDayTrial: TEventOnDayTrial Read FOnDayTrial Write FOnDayTrial;
          Property OnInvalidSystemTime: TNotifyEvent Read FOnInvalidSystemTime Write FOnInvalidSystemTime;
          Property OnInvalidSerialNumber: TNotifyEvent Read FOnInvalidSerialNumber Write FOnInvalidSerialNumber;
          Property OnGetSerialNumber: TEventOnGetSerialNumber Read FOnGetSerialNumber Write FOnGetSerialNumber;
          Property OnGetHardwareID: TEventOnGetHardwareID Read FOnGetHardwareID Write FOnGetHardwareID;
          Property OnRegisteredVersion: TNotifyEvent Read FOnRegisteredVersion Write FOnRegisteredVersion;
          Property OnInvalidHardwareID: TNotifyEvent Read FOnInvalidHardwareID Write FOnInvalidHardwareID;
          Property OnUnRegisteredVersion: TNotifyEvent Read FOnUnRegisteredVersion Write FOnUnRegisteredVersion;
          Property OnUnknownHardware: TNotifyEvent Read FOnUnknownHardware Write FOnUnknownHardware;

          Property OnCodeData: TEventOnCodeData Read FOnCodeData Write FOnCodeData;
          Property OnDeCodeData: TEventOnCodeData Read FOnDeCodeData Write FOnDeCodeData;
          Property OnReset: TEventOnReset Read FOnReset Write FOnReset;
          Property OnGetRegistryPath: TEventOnGetRegistryPath Read FOnGetRegistryPath Write FOnGetRegistryPath;
          Property OnGetString: TEventOnGetString Read FOnGetString Write FOnGetString;
          Property OnGetBoolean: TEventOnGetBoolean Read FOnGetBoolean Write FOnGetBoolean;
          Property OnPutString: TEventOnPutString Read FOnPutString Write FOnPutString;
          Property OnPutBoolean: TEventOnPutBoolean Read FOnPutBoolean Write FOnPutBoolean;
     End;

Implementation

Uses Registry;

Const
     mxInternalPassword = 'mxProtector';
     mxRegistryPath = '5C534F4654574152455C436C61737365735C434C5349445C';
     //mxRegistryPath = '\SOFTWARE\Classes\CLSID\';

// *************************************************************************************
// *************************************************************************************
// *************************************************************************************
// ** TmxProtector.Create, 5/21/01 9:30:49 AM
// *************************************************************************************
// *************************************************************************************
// *************************************************************************************

Constructor TmxProtector.Create( AOwner: TComponent );
Var
     I: Integer;
     TempStr: String;
     FGUID: TGUID;
Begin
     Inherited Create( AOwner );

     FProtectionTypes := [ stPassword ];
     FOptions := [ poAutoInit, poCheckSytemTime, poPasswordOnce ];
     FCodeKey := 'Ignore';
     FPassword := '';

     CoCreateGuid( FGUID );
     FUniqueID := GUIDToString( FGUID );
     CoCreateGuid( FGUID );
     TempStr := GUIDToString( FGUID );
     FInternalStrPassword := '';
     FUserName := '';

     For I := 1 To Length( TempStr ) Do FInternalStrPassword := FInternalStrPassword + IntToHex( ( Ord( TempStr[ I ] ) Xor I ), 2 );

     FMaxStartNumber := 0;
     FExpiration := IncreaseDate( Now, 0, 1, 0 );
     FVersion := mxProtectorVersion;

     FFirstAfterStart := TRUE;

     FRegistration := rtUnknown;

     FRegistryRootKey:=rkLocalMachine;
End;

// *************************************************************************************
// ** TmxProtector.Destroy, 5/21/01 9:30:56 AM
// *************************************************************************************

Destructor TmxProtector.Destroy;
Begin
     Inherited Destroy;
End;

// *************************************************************************************
// ** TmxProtector.SetVersion, 5/21/01 9:30:38 AM
// *************************************************************************************

Procedure TmxProtector.SetVersion( Value: String );
Begin
        // *** Does nothing ***
End;

// *************************************************************************************
// ** TmxProtector.GetVersion, 5/21/01 9:30:34 AM
// *************************************************************************************

Function TmxProtector.GetVersion: String;
Begin
     Result := Format( '%d.%d', [ Hi( FVersion ), Lo( FVersion ) ] );
End;

// *************************************************************************************
// ** TmxProtector.SetProtectionTypes, 8/21/01 12:38:52 PM
// *************************************************************************************

Procedure TmxProtector.SetProtectionTypes( Value: TmxProtectionTypeSet );
Begin
     If ( csLoading In ComponentState ) Or ( csDesigning In ComponentState ) Then FProtectionTypes := Value Else
          MessageDlg( 'ProtectionTypes is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.SetOptions, 8/21/01 1:39:37 PM
// *************************************************************************************

Procedure TmxProtector.SetOptions( Value: TmxProtectionOptionSet );
Begin
     If ( csLoading In ComponentState ) Or ( csDesigning In ComponentState ) Then FOptions := Value Else
          MessageDlg( 'Options is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.CodePassword, 8/21/01 12:50:41 PM
// *************************************************************************************

Function TmxProtector.CodePassword( Value: String; Internal: Boolean ): String;
Var
     I: Integer;
     S: String;
     CodeKeyStr: String;
     Index: Integer;
     IntIndex: Integer;
Begin
     S := '';
     Index := 1;
     IntIndex := 1;

     If Internal Then
          CodeKeyStr := FInternalStrPassword Else
          CodeKeyStr := FCodeKey;

     If CodeKeyStr <> '' Then
     Begin
          For I := 1 To Length( Value ) Do
          Begin
               S := S + IntToHex( ( ( Ord( Value[ I ] ) Xor Ord( CodeKeyStr[ Index ] ) ) Xor Ord( mxInternalPassword[ IntIndex ] ) ), 2 );
               Inc( Index );
               Inc( IntIndex );
               If Index > Length( CodeKeyStr ) Then Index := 1;
               If IntIndex > Length( mxInternalPassword ) Then IntIndex := 1;
          End
     End
     Else S := Value;

     Result := S;

     If Assigned( FOnCodeData ) Then
      FOnCodeData( Self, Result );
End;

// *************************************************************************************
// ** TmxProtector.DeCodePassword, 8/21/01 12:50:44 PM
// *************************************************************************************

Function TmxProtector.DeCodePassword( Value: String; Internal: Boolean ): String;
Var
     I: Integer;
     S: String;
     CodeKeyStr: String;
     Index: Integer;
     IntIndex: Integer;
Begin
     S := '';
     Index := 1;
     IntIndex := 1;
     I := 1;

     If Internal Then
          CodeKeyStr := FInternalStrPassword Else
          CodeKeyStr := FCodeKey;

     If CodeKeyStr <> '' Then
     Begin
          While I < Length( Value ) Do
          Begin
               S := S + Chr( ( StrToIntDef( '$' + Copy( Value, I, 2 ), 0 ) Xor Ord( mxInternalPassword[ IntIndex ] ) ) Xor Ord( CodeKeyStr[ Index ] ) );
               Inc( I, 2 );
               Inc( Index );
               Inc( IntIndex );
               If Index > Length( CodeKeyStr ) Then Index := 1;
               If IntIndex > Length( mxInternalPassword ) Then IntIndex := 1;
          End
     End
     Else S := Value;

     Result := S;

     If Assigned( FOnDeCodeData ) Then
      FOnDeCodeData( Self, Result );
End;

// *************************************************************************************
// ** TmxProtector.SetPassword, 8/21/01 12:45:50 PM
// *************************************************************************************

Procedure TmxProtector.SetPassword( Value: String );
Begin
     If ( csLoading In ComponentState ) Then FPassword := Value Else
          If ( csDesigning In ComponentState ) Then FPassword := CodePassword( Value, False ) Else
               MessageDlg( 'Password is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.SetUserName, 8/30/01 10:12:09 AM
// *************************************************************************************

Procedure TmxProtector.SetUserName( Value: String );
Begin
     If ( csLoading In ComponentState ) Then FUserName := Value Else
          If ( csDesigning In ComponentState ) Then FUserName := Value Else
               MessageDlg( 'UserName is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.SetCodeKey, 8/21/01 12:57:35 PM
// *************************************************************************************

Procedure TmxProtector.SetCodeKey( Value: String );
Var
     S: String;
Begin
     If ( csLoading In ComponentState ) Then FCodeKey := Value Else
          If ( csDesigning In ComponentState ) Then
          Begin
               If FPassword = '' Then FCodeKey := Value Else
               Begin
                    S := DeCodePassword( FPassword, False );
                    FCodeKey := Value;
                    FPassword := CodePassword( S, False );
               End;
          End
          Else
               MessageDlg( 'CodeKey is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.SetExpiration, 8/21/01 2:03:12 PM
// *************************************************************************************

Procedure TmxProtector.SetExpiration( Value: TDateTime );
Begin
     If ( csLoading In ComponentState ) Or ( csDesigning In ComponentState ) Then FExpiration := Value Else
          MessageDlg( 'Expiration is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// *** TmxProtector.SetMaxStartNumber, 2001.10.16. 9:46:30
// *************************************************************************************

Procedure TmxProtector.SetMaxStartNumber( Value: Integer );
Begin
     If ( csLoading In ComponentState ) Or ( csDesigning In ComponentState ) Then FMaxStartNumber := Value Else
          MessageDlg( 'StartNumber is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// *** TmxProtector.SetMaxDayNumber, 2001.10.16. 9:46:36
// *************************************************************************************

Procedure TmxProtector.SetMaxDayNumber( Value: Integer );
Begin
     If ( csLoading In ComponentState ) Or ( csDesigning In ComponentState ) Then FMaxDayNumber := Value Else
          MessageDlg( 'DayNumber is read-only. ' + #13 + #10 + 'You cannot modify it in run-time.', mtWarning, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** TmxProtector.IncDate, 8/21/01 2:10:36 PM
// *************************************************************************************

Function TmxProtector.IncreaseDate( AValue: TDateTime; ADays, AMonths, AYears: Integer ): TDateTime;
Const
     DaysInMonth: Array[ 1..12 ] Of Integer = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
Var
     DaysPerMonth: Byte;
     Day, Month, Year: Word;
Begin
     DecodeDate( AValue, Year, Month, Day );

     Inc( Year, AYears );
     Inc( Year, AMonths Div 12 );
     Inc( Month, AMonths Mod 12 );

     If Month < 1 Then
     Begin
          Inc( Month, 12 );
          Dec( Year );
     End Else
          If Month > 12 Then
          Begin
               Dec( Month, 12 );
               Inc( Year );
          End;

     DaysPerMonth := DaysInMonth[ Month ];
     If ( Month = 2 ) And ( ( Year Mod 4 = 0 ) And ( ( Year Mod 100 <> 0 ) Or ( Year Mod 400 = 0 ) ) ) Then Inc( DaysPerMonth );
     If Day > DaysPerMonth Then Day := DaysPerMonth;
     Result := EncodeDate( Year, Month, Day ) + ADays + Frac( AValue );
End;

// *************************************************************************************
// ** TmxProtector.ReadUniqueID, 8/28/01 9:27:12 AM
// *************************************************************************************

Procedure TmxProtector.ReadUniqueID( Reader: TReader );
Begin
     FUniqueID := DecodePassword( Reader.ReadString, TRUE );
End;

// *************************************************************************************
// ** TmxProtector.WriteUniqueID, 8/28/01 9:27:15 AM
// *************************************************************************************

Procedure TmxProtector.WriteUniqueID( Writer: TWriter );
Begin
     Writer.WriteString( CodePassword( FUniqueID, TRUE ) );
End;

// *************************************************************************************
// ** TmxProtector.ReadUniqueCodeID, 8/28/01 9:27:12 AM
// *************************************************************************************

Procedure TmxProtector.ReadUniqueCodeID( Reader: TReader );
Begin
     FInternalStrPassword := Reader.ReadString;
End;

// *************************************************************************************
// ** TmxProtector.WriteUniqueCodeID, 8/28/01 9:27:15 AM
// *************************************************************************************

Procedure TmxProtector.WriteUniqueCodeID( Writer: TWriter );
Begin
     Writer.WriteString( FInternalStrPassword );
End;

// *************************************************************************************
// ** TmxProtector.DefineProperties, 8/21/01 2:56:42 PM
// *************************************************************************************

Procedure TmxProtector.DefineProperties( Filer: TFiler );
Begin
     Inherited DefineProperties( Filer );
     Filer.DefineProperty( 'UniqueCodeID', ReadUniqueCodeID, WriteUniqueCodeID, TRUE );
     Filer.DefineProperty( 'UniqueID', ReadUniqueID, WriteUniqueID, TRUE );
End;

Function TmxProtector.GetRegistryKey: String;
Begin
  Result:=Format( GetRegistryPath + '%s\Info', [ FUniqueID ] );
  If Assigned( OnGetRegistryPath ) Then
    FOnGetRegistryPath( Self, Result ); 
End;

// *************************************************************************************
// ** TmxProtector.Get_String, 8/21/01 3:43:38 PM
// *************************************************************************************

Function TmxProtector.Get_String( AKey, ADefval: String ): String;
Var
  Reg: TRegistry;
  sKey, sPath, sValue: String;
  Handled: Boolean;
Begin
     sPath:=GetRegistryKey;
     sKey:=AKey;
     sValue:=ADefVal;
     Handled:=False;

     If Assigned( FOnGetString ) Then
      FOnGetString( Self, sPath, sKey, sValue, Handled );

     If Not Handled Then
     Begin
      Reg := TRegistry.Create;
      Try
          If FRegistryRootKey = rkCurrentUser Then
            Reg.RootKey := HKEY_CURRENT_USER Else
            Reg.RootKey := HKEY_LOCAL_MACHINE;

          Try
               If Reg.OpenKey( sPath, True ) Then
                    Result := Reg.ReadString( sKey ) Else
                    Result := sValue;
          Except
               Result := sValue;
          End;

      Finally
          Reg.CloseKey;
          Reg.Free;
      End;
     End
      Else Result:=sValue;
End;

// *************************************************************************************
// ** TmxProtector.Get_Boolean, 8/21/01 3:43:40 PM
// *************************************************************************************

Function TmxProtector.Get_Boolean( AKey: String; ADefval: Boolean ): Boolean;
Var
  Reg: TRegistry;
  sKey, sPath: String;
  sValue: Boolean;
  Handled: Boolean;
Begin
     sPath:=GetRegistryKey;
     sKey:=AKey;
     sValue:=ADefVal;
     Handled:=False;

     If Assigned( FOnGetBoolean ) Then
      FOnGetBoolean( Self, sPath, sKey, sValue, Handled );

     If Not Handled Then
     Begin
      Reg := TRegistry.Create;
      Try
          If FRegistryRootKey = rkCurrentUser Then
            Reg.RootKey := HKEY_CURRENT_USER Else
            Reg.RootKey := HKEY_LOCAL_MACHINE;

          Try
               If Reg.OpenKey( sPath, False ) Then
                    Result := Reg.ReadBool( sKey ) Else
                    Result := sValue;
          Except
               Result := sValue;
          End;

      Finally
          Reg.CloseKey;
          Reg.Free;
      End;
     End
      Else Result:=SValue;
End;

// *************************************************************************************
// ** TmxProtector.Put_String, 8/21/01 3:43:44 PM
// *************************************************************************************

Procedure TmxProtector.Put_String( AKey, AVal: String );
Var
  Reg: TRegistry;
  sKey, sPath, sValue: String;
  Handled: Boolean;
Begin
     sPath:=GetRegistryKey;
     sKey:=AKey;
     sValue:=AVal;
     Handled:=False;

     If Assigned( FOnPutString ) Then
      FOnPutString( Self, sPath, sKey, sValue, Handled );

     If Not Handled Then
     Begin
      Reg := TRegistry.Create;
      Try
          If FRegistryRootKey = rkCurrentUser Then
            Reg.RootKey := HKEY_CURRENT_USER Else
            Reg.RootKey := HKEY_LOCAL_MACHINE;

          Reg.OpenKey( sPath, True );
          Reg.WriteString( sKey, sValue );
      Finally
          Reg.CloseKey;
          Reg.Free;
      End;
     End;
End;

// *************************************************************************************
// ** TmxProtector.Put_Boolean, 8/21/01 3:43:47 PM
// *************************************************************************************

Procedure TmxProtector.Put_Boolean( AKey: String; AVal: Boolean );
Var
  Reg: TRegistry;
  sKey, sPath: String;
  sValue: Boolean;
  Handled: Boolean;
Begin
     sPath:=GetRegistryKey;
     sKey:=AKey;
     sValue:=AVal;
     Handled:=False;

     If Assigned( FOnPutBoolean ) Then
      FOnPutBoolean( Self, sPath, sKey, sValue, Handled );

     If Not Handled Then
     Begin
      Reg := TRegistry.Create;
      Try
          If FRegistryRootKey = rkCurrentUser Then
            Reg.RootKey := HKEY_CURRENT_USER Else
            Reg.RootKey := HKEY_LOCAL_MACHINE;

          Reg.OpenKey( sPath, True );
          Reg.WriteBool( sKey, sValue );
      Finally
          Reg.CloseKey;
          Reg.Free;
      End;
     End;
End;

// *************************************************************************************
// ** TmxProtector.Del_Key, 8/21/01 4:38:58 PM
// *************************************************************************************

Function TmxProtector.Delete_Key: Boolean;
Var
     Reg: TRegistry;
     sPath: String;
Begin
     sPath:=GetRegistryKey;

     Reg := TRegistry.Create;
     Try
          If FRegistryRootKey = rkCurrentUser Then
            Reg.RootKey := HKEY_CURRENT_USER Else
            Reg.RootKey := HKEY_LOCAL_MACHINE;

          Result := Reg.DeleteKey( sPath );
     Finally
          Reg.Free;
     End;
End;

// *************************************************************************************
// ** TmxProtector.Loaded, 8/21/01 3:28:57 PM
// *************************************************************************************

Procedure TmxProtector.Loaded;
Begin
     Inherited Loaded;

     If poAutoInit In FOptions Then Init;
End;

// *************************************************************************************
// ** TmxProtector.CheckPassword, 8/21/01 4:14:00 PM
// *************************************************************************************

Procedure TmxProtector.CheckPassword;
Var
     NeedPassword: Boolean;
     Password: String;
Begin
     If stPassword In FProtectionTypes Then
     Begin
          NeedPassword := TRUE;

          If poPasswordOnce In FOptions Then
               NeedPassword := Not Get_Boolean( 'P1', False );

          If NeedPassword Then
          Begin
               Password := '';
               If Assigned( FOnGetPassword ) Then FOnGetPassword( Self, Password );

               If CodePassword( Password, False ) = FPassword Then
               Begin
                    If poPasswordOnce In FOptions Then Put_Boolean( 'P1', True );
                    If Assigned( FOnValidPassword ) Then FOnValidPassword( Self );
               End
               Else If Assigned( FOnWrongPassword ) Then FOnWrongPassword( Self, Password );
          End
          Else If Assigned( FOnValidPassword ) Then FOnValidPassword( Self );
     End;
End;

// *************************************************************************************
// ** TmxProtector.CheckStartTrial, 8/21/01 5:26:05 PM
// *************************************************************************************

Procedure TmxProtector.CheckStartTrial;
Var
     Counter: Integer;
     FirstStart: Boolean;
Begin
     If stStartTrial In FProtectionTypes Then
     Begin
          FirstStart := Not Get_Boolean( 'S1', False );

          If FirstStart Then
          Begin
               Put_Boolean( 'S1', True );
               Put_String( 'S2', CodePassword( IntToHex( FMaxStartNumber, 5 ), TRUE ) );
          End;

          Counter := StrToIntDef( '$' + DeCodePassword( Get_String( 'S2', '01' ), TRUE ), 1 );

          Dec( Counter );
          Put_String( 'S2', CodePassword( IntToHex( Counter, 5 ), TRUE ) );

          If Counter <= 0 Then
          Begin
               If Assigned( FOnExpiration ) Then FOnExpiration( Self );

               If poWorkAfterExpiration In Options Then
                    If Assigned( FOnStartTrial ) Then FOnStartTrial( Self, Counter );
          End
          Else If Assigned( FOnStartTrial ) Then FOnStartTrial( Self, Counter );
     End;
End;

// *************************************************************************************
// ** TmxProtector.CheckTimeTrial, 8/27/01 4:09:58 PM
// *************************************************************************************

Procedure TmxProtector.CheckTimeTrial;
Var
     Year, Month, Day: Word;
     LastYear, LastMonth, LastDay: Word;
     LastStart: TDateTime;
     ValidSystemTime: Boolean;
     FirstStart: Boolean;
     DateStr: String;
Begin
     If stTimeTrial In FProtectionTypes Then
     Begin
          FirstStart := Not Get_Boolean( 'T1', False );

          DecodeDate( Now, Year, Month, Day );
          ValidSystemTime := TRUE;

          If FirstStart Then
          Begin
               Put_Boolean( 'T1', True );
               Put_String( 'T2', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
          End
          Else
          Begin
               If poCheckSytemTime In FOptions Then
               Begin
                    DateStr := Get_String( 'T3', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
                    DateStr := DecodePassword( DateStr, TRUE );

                    LastYear := StrToIntDef( '$' + Copy( DateStr, 1, 4 ), Year );
                    LastMonth := StrToIntDef( '$' + Copy( DateStr, 5, 2 ), Month );
                    LastDay := StrToIntDef( '$' + Copy( DateStr, 7, 2 ), Day );

                    LastStart := EncodeDate( LastYear, LastMonth, LastDay );

                    If LastStart > Now Then
                    Begin
                         If Assigned( FOnInvalidSystemTime ) Then FOnInvalidSystemTime( Self );
                         ValidSystemTime := FALSE;

                         If Assigned( FOnExpiration ) Then FOnExpiration( Self );

                         If poWorkAfterExpiration In Options Then
                              If Assigned( FOnTimeTrial ) Then FOnTimeTrial( Self, GetDayNumber );
                    End;
               End;
          End;

          If ValidSystemTime Then
          Begin
               Put_String( 'T3', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );

               If GetDayNumber = 0 Then
               Begin
                    If Assigned( FOnExpiration ) Then FOnExpiration( Self );

                    If poWorkAfterExpiration In Options Then
                         If Assigned( FOnTimeTrial ) Then FOnTimeTrial( Self, GetDayNumber );
               End
               Else If Assigned( FOnTimeTrial ) Then FOnTimeTrial( Self, GetDayNumber );
          End;
     End;
End;

// *************************************************************************************
// *** TmxProtector.CheckDayTrial, 2001.10.16. 9:48:13
// *************************************************************************************

Procedure TmxProtector.CheckDayTrial;
Var
     Year, Month, Day: Word;
     LastYear, LastMonth, LastDay: Word;
     FirstStartDate: TDateTime;
     FirstStart: Boolean;
     LastStart: TDateTime;
     ValidSystemTime: Boolean;
     DateStr: String;
     LicencedDays: Integer;
Begin
     If stDayTrial In FProtectionTypes Then
     Begin
          FirstStart := Not Get_Boolean( 'D1', False );

          DecodeDate( Now, Year, Month, Day );
          ValidSystemTime := TRUE;

          If FirstStart Then
          Begin
               Put_Boolean( 'D1', True );
               Put_String( 'D2', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
               LicencedDays := FMaxDayNumber - 1;
          End
          Else
          Begin
               DateStr := Get_String( 'D2', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
               DateStr := DecodePassword( DateStr, TRUE );

               LastYear := StrToIntDef( '$' + Copy( DateStr, 1, 4 ), Year );
               LastMonth := StrToIntDef( '$' + Copy( DateStr, 5, 2 ), Month );
               LastDay := StrToIntDef( '$' + Copy( DateStr, 7, 2 ), Day );

               FirstStartDate := EncodeDate( LastYear, LastMonth, LastDay );

               // ******************************************************

               LicencedDays := Trunc( Now ) - Trunc( FirstStartDate ) + 1;
               If LicencedDays < 0 Then LicencedDays := 0;

               LicencedDays := FMaxDayNumber - LicencedDays;
               If LicencedDays < 0 Then LicencedDays := 0;

               // ******************************************************

               If poCheckSytemTime In FOptions Then
               Begin
                    DateStr := Get_String( 'D3', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
                    DateStr := DecodePassword( DateStr, TRUE );

                    LastYear := StrToIntDef( '$' + Copy( DateStr, 1, 4 ), Year );
                    LastMonth := StrToIntDef( '$' + Copy( DateStr, 5, 2 ), Month );
                    LastDay := StrToIntDef( '$' + Copy( DateStr, 7, 2 ), Day );

                    LastStart := EncodeDate( LastYear, LastMonth, LastDay );

                    If LastStart > Now Then
                    Begin
                         If Assigned( FOnInvalidSystemTime ) Then FOnInvalidSystemTime( Self );
                         ValidSystemTime := FALSE;

                         If Assigned( FOnExpiration ) Then FOnExpiration( Self );

                         If poWorkAfterExpiration In Options Then
                              If Assigned( FOnDayTrial ) Then FOnDayTrial( Self, LicencedDays );
                    End;
               End;
          End;

          If ValidSystemTime Then
          Begin
               Put_String( 'D3', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );

               If LicencedDays = 0 Then
               Begin
                    If Assigned( FOnExpiration ) Then FOnExpiration( Self );

                    If poWorkAfterExpiration In Options Then
                         If Assigned( FOnDayTrial ) Then FOnDayTrial( Self, LicencedDays );
               End
               Else If Assigned( FOnDayTrial ) Then FOnDayTrial( Self, LicencedDays );
          End;
     End;
End;

// *************************************************************************************
// ** TmxProtector.CheckRegistration, 8/28/01 10:31:50 AM
// *************************************************************************************

Procedure TmxProtector.CheckRegistration;
Var
     SerialNumber: String;
     GenSerialNumber: String;
     UserName: String;
     Registered: Boolean;
Begin
     If stRegister In FProtectionTypes Then
     Begin
          Registered := FALSE;

          UserName := DeCodePassword( Get_String( 'R1', '' ), TRUE );
          SerialNumber := DeCodePassword( Get_String( 'R2', '' ), TRUE );

          If UserName <> '' Then
          Begin
               GenSerialNumber := GenerateSerialNumber( UserName );
               Registered := AnsiCompareText( GenSerialNumber, SerialNumber ) = 0;
          End;

          If Assigned( FOnCheckRegistration ) Then FOnCheckRegistration( Self, UserName, SerialNumber, Registered );

          If Registered Then
          Begin
               If Assigned( FOnRegisteredVersion ) Then FOnRegisteredVersion( Self );
               FUserName := UserName;
               FRegistration := rtRegistered;
          End
          Else
          Begin
               If Assigned( FOnUnRegisteredVersion ) Then FOnUnRegisteredVersion( Self );
               FUserName := '';
               FRegistration := rtUnRegistered;
          End;
     End;
End;

// *************************************************************************************
// ** TmxProtector.Registration, 8/30/01 8:41:50 AM
// *************************************************************************************

Procedure TmxProtector.Registration;
Var
     SerialNumber: String;
     GenSerialNumber: String;
     UserName: String;
     Registered: Boolean;
Begin
     If stRegister In FProtectionTypes Then
     Begin
          Registered := FALSE;

          // *************************************************************

          If Assigned( FOnBeforeRegister ) Then FOnBeforeRegister( Self );

          // *************************************************************

          If Assigned( FOnGetSerialNumber ) Then
          Begin
               FOnGetSerialNumber( Self, UserName, SerialNumber );
               FUserName := UserName;
               GenSerialNumber := GenerateSerialNumber( FUserName );

               If GenSerialNumber <> '' Then
               Begin
                    Registered := AnsiCompareText( GenSerialNumber, SerialNumber ) = 0;

                    If Not Registered Then
                         If Assigned( FOnInvalidSerialNumber ) Then FOnInvalidSerialNumber( Self );
               End;
          End;

          If Registered Then
          Begin
               Put_String( 'R1', CodePassword( FUserName, TRUE ) );
               Put_String( 'R2', CodePassword( UpperCase( SerialNumber ), TRUE ) );

               // *************************************************************

               If Assigned( FOnRegister ) Then FOnRegister( Self, FUserName, SerialNumber );

               // *************************************************************

               If Assigned( FOnRegisteredVersion ) Then FOnRegisteredVersion( Self );
               FUserName := UserName;
               FRegistration := rtRegistered;
          End
          Else
          Begin
               If Assigned( FOnUnRegisteredVersion ) Then FOnUnRegisteredVersion( Self );
               FUserName := '';
               FRegistration := rtUnRegistered;
          End;

          // *************************************************************

          If Assigned( FOnAfterRegister ) Then FOnAfterRegister( Self );

          // *************************************************************
     End;
End;

// *************************************************************************************
// ** TmxProtector.Reset, 8/21/01 4:36:09 PM
// *************************************************************************************

Procedure TmxProtector.Reset;
Var
  Handled: Boolean;
Begin
  Handled:=False;

  If Assigned( FOnReset ) Then FOnReset( Self, Handled );

  If Not Handled Then Delete_Key;

  CheckRegistration;
  FRegistration := rtUnknown;
End;

// *************************************************************************************
// ** TmxProtector.Init, 8/21/01 4:34:51 PM
// *************************************************************************************

Procedure TmxProtector.Init;
Begin
     If Not FFirstAfterStart Then Exit;
     If Assigned( FOnInitialization ) Then FOnInitialization( Self );

     CheckPassword;
     CheckStartTrial;
     CheckTimeTrial;
     CheckDayTrial;
     CheckRegistration;

     FFirstAfterStart := TRUE;
End;

// *************************************************************************************
// ** TmxProtector.GetDayNumber, 8/27/01 4:15:08 PM
// *************************************************************************************

Function TmxProtector.GetDayNumber: Longint;
Begin
     Result := Trunc( Expiration ) - Trunc( Now ) + 1;
     If Result < 0 Then Result := 0;
End;

// *************************************************************************************
// ** TmxProtector.GetLicencedDayNumber, 8/28/01 8:50:23 AM
// *************************************************************************************

Function TmxProtector.GetLicencedDayNumber: Longint;
Var
     FirstStart: TDateTime;
     DateStr: String;
     Year, Month, Day: Word;
Begin
     Result := 0;

     If Get_Boolean( 'T1', False ) Then
     Begin
          DecodeDate( Now, Year, Month, Day );
          DateStr := Get_String( 'T2', CodePassword( IntToHex( Year, 4 ) + IntToHex( Month, 2 ) + IntToHex( Day, 2 ), True ) );
          DateStr := DecodePassword( DateStr, TRUE );

          Year := StrToIntDef( '$' + Copy( DateStr, 1, 4 ), Year );
          Month := StrToIntDef( '$' + Copy( DateStr, 5, 2 ), Month );
          Day := StrToIntDef( '$' + Copy( DateStr, 7, 2 ), Day );

          FirstStart := EncodeDate( Year, Month, Day );

          Result := Trunc( Expiration ) - Trunc( FirstStart ) + 1;
          If Result < 0 Then Result := 0;
     End;
End;

// *************************************************************************************
// ** TmxProtector.GenerateSerialNumber, 8/28/01 2:47:29 PM
// *************************************************************************************

Function TmxProtector.GenerateSerialNumber( AUserName: String ): String;
Var
     I: Integer;
     Index: Integer;
     IntIndex: Integer;
     Serial: String;
     TempStr: String;
     TempStr1: String;
     Addon: Integer;
Begin
     Result := '';

     If AUserName = '' Then
     Begin
          MessageDlg( 'User name is empty. Please set this propery before!', mtInformation, [ mbOK ], 0 );
          Exit;
     End;

     AUserName := UpperCase( AUserName );

     Index := 1;
     IntIndex := 1;
     Addon := 0;

     For I := 1 To Length( AUserName ) Do
     Begin
          Inc( AddOn, ( Ord( AUserName[ I ] ) * I ) );
     End;

     If poUseHardwareKey In FOptions Then
     Begin
          TempStr := InternalGetHardwareID;

          If Assigned( FOnGetHardwareID ) Then FOnGetHardwareID( Self, TempStr );

          TempStr1 := '';
          For I := 1 To Length( TempStr ) Do
               If TempStr[ I ] <> '-' Then TempStr1 := TempStr1 + TempStr[ I ];

          TempStr := TempStr1;

          If Length( TempStr ) <> 16 Then
          Begin
               Result := '';
               If Assigned( FOnInvalidHardwareID ) Then FOnInvalidHardwareID( Self );
               Exit;
          End;

          For I := 1 To Length( TempStr ) Do
          Begin
               Inc( AddOn, ( Ord( TempStr[ I ] ) * I ) );
          End;
     End;

     For I := 1 To 12 Do
     Begin
          Serial := Serial +
               IntToHex(

               ( (
               Ord( FUniqueID[ I * 2 ] ) Xor Ord( FUniqueID[ I ] )
               )
               Xor Ord( AUserName[ Index ] )
               )
               Xor
               (
               ( Addon + I ) Mod 200
               )
               , 2 );

          Inc( Addon, Ord( AUserName[ Index ] ) Xor I );

          If poUseHardwareKey In FOptions Then Inc( Addon, Ord( TempStr[ I ] ) Xor I );

          Inc( Index );
          Inc( IntIndex );
          If Index > Length( AUserName ) Then Index := 1;
          If IntIndex > Length( mxInternalPassword ) Then IntIndex := 1;
     End;

     If Length( Serial ) > 24 Then Serial := Copy( Serial, 1, 24 );
     Result := Copy( Serial, 1, 8 ) + '-' + Copy( Serial, 9, 8 ) + '-' + Copy( Serial, 17, 8 );
End;

// *************************************************************************************
// ** TmxProtector.GetRegistryPath, 8/30/01 7:37:50 AM
// *************************************************************************************

Function TmxProtector.GetRegistryPath: String;
Var
     I: Integer;
     S: String;
Begin
     S := '';

     I := 1;
     While I < Length( mxRegistryPath ) Do
     Begin
          S := S + Chr( StrToIntDef( '$' + Copy( mxRegistryPath, I, 2 ), 0 ) );
          Inc( I, 2 );
     End;
     Result:=S;
End;

// *************************************************************************************
// ** TmxProtector.IsRegistered, 8/30/01 9:08:28 AM
// *************************************************************************************

Function TmxProtector.IsRegistered: Boolean;
Begin
     If FRegistration = rtUnknown Then CheckRegistration;
     Result := FRegistration = rtRegistered;
End;

// *************************************************************************************
// ** TmxProtector.GetRegisteredUserName, 8/30/01 10:11:26 AM
// *************************************************************************************

Function TmxProtector.GetRegisteredUserName: String;
Begin
     Result := FUserName;
End;

// *************************************************************************************
// ** IsCPUIDAvailable, 10/12/01 2:04:15 PM
// *************************************************************************************

Const
     ID_BIT = $200000;

Type
     TCPUID = Array[ 1..4 ] Of Longint;
     TVendor = Array[ 0..11 ] Of char;

Function IsCPUIDAvailable: Boolean; Register;
Asm
  PUSHFD
  POP     EAX
  MOV     EDX,EAX
  XOR     EAX,ID_BIT
  PUSH    EAX
  POPFD
  PUSHFD
  POP     EAX
  XOR     EAX,EDX
  JZ      @exit
  MOV     AL,True
@exit:
End;

// *************************************************************************************
// ** GetCPUID, 10/12/01 2:04:09 PM
// *************************************************************************************

Function GetCPUID: TCPUID; Assembler; Register;
Asm
  PUSH    EBX
  PUSH    EDI
  MOV     EDI,EAX
  MOV     EAX,1
  DW      $A20F
  STOSD
  MOV     EAX,EBX
  STOSD
  MOV     EAX,ECX
  STOSD
  MOV     EAX,EDX
  STOSD
  POP     EDI
  POP     EBX
End;

// *************************************************************************************
// ** GetCPUVendor, 10/12/01 2:04:06 PM
// *************************************************************************************

Function GetCPUVendor: TVendor; Assembler; Register;
Asm
  PUSH    EBX
  PUSH    EDI
  MOV     EDI,EAX
  MOV     EAX,0
  DW      $A20F
  MOV     EAX,EBX
  XCHG	  EBX,ECX
  MOV	  ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV	  ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV	  ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI
  POP     EBX
End;

// *************************************************************************************
// ** TmxProtector.InternalGetHardwareID, 10/12/01 2:04:03 PM
// *************************************************************************************

Function TmxProtector.InternalGetHardwareID: String;
Var
     pdw: pDWord;
     mc, fl: dword;
     ID_1: String;
     ID_1L: dword;
     ID_2: Longint;
     ID_3: Longint;
     ID_5: String;
     CPUID: TCPUID;
     I: Integer;
     AddOn: Longword;
     TempStr: String;
     TempByte: Byte;
     Index: Integer;
Begin
     Result := '';

     Try
          New( pdw );
          GetVolumeInformation( PChar( 'C:\' ), Nil, 0, pdw, mc, fl, Nil, 0 );
          ID_1L := pdw^;
          ID_1 := IntToHex( pdw^, 8 );
          Dispose( pdw );
     Except
          If Assigned( FOnUnknownHardware ) Then FOnUnknownHardware( Self );
          Exit;
     End;

     For I := Low( CPUID ) To High( CPUID ) Do CPUID[ I ] := -1;

     If IsCPUIDAvailable Then
     Begin
          CPUID := GetCPUID;
          ID_2 := CPUID[ 1 ] + CPUID[ 2 ] + CPUID[ 3 ] + CPUID[ 4 ];
          ID_3 := ( CPUID[ 1 ] Shr 12 And 3 ) * ( CPUID[ 1 ] Shr 8 And $F ) * ( CPUID[ 1 ] Shr 4 And $F ) * ( CPUID[ 1 ] And $F );
          ID_5 := GetCPUVendor;

{$WARNINGS OFF}
          AddOn := Longword( ID_1L + ID_2 * ID_3 );
          For I := 1 To Length( ID_5 ) Do AddOn := ( AddOn Xor Ord( ID_5[ I ] ) );

          TempStr := IntToHex( AddOn, 8 );

          Index := 1;

          For I := 1 To Length( TempStr ) Do
          Begin
{$R-}
               TempByte :=
                    (
                    (
                    Ord( TempStr[ I ] ) Xor ( AddOn Div I )
                    ) +
                    Ord( ID_1[ I ] )
                    ) Div 5;

{$R+}
{$WARNINGS ON}

               If poUniqueHardwareID In Options Then
               Begin
                    TempByte := Ord( FUniqueID[ Index ] ) Xor TempByte;
                    Inc( Index );
                    If Index > Length( FUniqueID ) Then Index := 1;
               End;

               Result := Result + IntToHex( TempByte, 2 );
          End;

          If Length( Result ) > 16 Then Result := Copy( Result, 1, 16 );
          If Length( Result ) < 16 Then
               For I := Length( Result ) + 1 To 16 Do Result := '0' + Result;
     End
     Else
     Begin
          If Assigned( FOnUnknownHardware ) Then FOnUnknownHardware( Self );
     End;
End;

// *************************************************************************************
// ** TmxProtector.GetHardwareID, 10/12/01 2:02:19 PM
// *************************************************************************************

Function TmxProtector.GetHardwareID: String;
Var
     TempStr: String;
Begin
     TempStr := InternalGetHardwareID;
     If TempStr <> '' Then
          Result := Format( '%s-%s-%s-%s', [ Copy( TempStr, 1, 4 ), Copy( TempStr, 5, 4 ), Copy( TempStr, 9, 4 ), Copy( TempStr, 13, 4 ) ] ) Else
          Result := '';
End;

End.

Open in new window

Unit Form_Main;

Interface

Uses
     Windows,
     Messages,
     SysUtils,
     Classes,
     Graphics,
     Controls,
     Forms,
     Dialogs,
     mxProtector,
     StdCtrls;
                                            

Type
     Tfrm_MainWindow = Class( TForm )
          btn_Go: TButton;
          btn_Cancel: TButton;
          Label1: TLabel;
          btn_Register: TButton;
          Label5: TLabel;
          grp_Reg: TGroupBox;
          Edit_UserName: TEdit;
          Edit_Serial: TEdit;
          Label2: TLabel;
          lbl_Serial: TLabel;
          btn_GetSer: TButton;
          btn_Reset: TButton;
          btn_About: TButton;
          Edit_HWID: TEdit;
          Label3: TLabel;
          mxProtector: TmxProtector;
          Label4: TLabel;
          Procedure FormCreate( Sender: TObject );
          Procedure btn_CancelClick( Sender: TObject );
          Procedure btn_GoClick( Sender: TObject );
          Procedure btn_ResetClick( Sender: TObject );
          Procedure btn_RegisterClick( Sender: TObject );
          Procedure Edit_SerialChange( Sender: TObject );
          Procedure btn_GetSerClick( Sender: TObject );
          Procedure mxProtectorGetSerialNumber( Sender: TObject; Var UserName, SerialNumber: String );
          Procedure btn_AboutClick( Sender: TObject );
          Procedure mxProtectorInvalidSerialNumber( Sender: TObject );
          Procedure mxProtectorUnknownHardware( Sender: TObject );

     Private

          Procedure ProcessRights;

     Public

     End;

Var
     frm_MainWindow: Tfrm_MainWindow;

Implementation

{$R *.DFM}

// *************************************************************************************
// ** Tfrm_MainWindow.FormCreate, 8/21/01 4:09:20 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.FormCreate( Sender: TObject );
Begin
     // If poAutoInit is excluded from Option you have to init the protection ***
     // mxProtector.Init;
     ProcessRights;
     Edit_HWID.Text := mxProtector.GetHardwareID;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.ProcessRights, 8/30/01 9:25:21 AM
// *************************************************************************************

Procedure Tfrm_MainWindow.ProcessRights;
Begin
     btn_Go.Enabled := mxProtector.IsRegistered;
     grp_Reg.Enabled := Not mxProtector.IsRegistered;
     btn_GetSer.Enabled := Not mxProtector.IsRegistered;
     btn_Register.Enabled := Not mxProtector.IsRegistered;
     btn_Reset.Enabled := mxProtector.IsRegistered;
     Edit_UserName.Enabled := Not mxProtector.IsRegistered;
     Edit_Serial.Enabled := Not mxProtector.IsRegistered;
     btn_Register.Enabled := ( Edit_UserName.Text <> '' ) And ( Edit_Serial.Text <> '' ) And ( Not mxProtector.IsRegistered );

     If mxProtector.IsRegistered Then
     Begin
          label1.Caption := 'Registered version';
          Label5.Caption := 'Thanks for the registration!';
     End
     Else
     Begin
          label1.Caption := 'Shareware Edition';
          Label5.Caption := 'To enable the Go button you must register!';
     End;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.btn_CancelClick, 8/21/01 4:12:29 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_CancelClick( Sender: TObject );
Begin
     Close;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.btn_GoClick, 8/21/01 4:20:55 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_GoClick( Sender: TObject );
Begin
     MessageDlg( 'It is a registered feature!', mtInformation, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** Tfrm_MainWindow.btn_ResetClick, 8/21/01 4:41:49 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_ResetClick( Sender: TObject );
Begin
     mxProtector.Reset;
     MessageDlg( 'Registration removed!', mtInformation, [ mbOK ], 0 );
     ProcessRights;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.Button1Click, 8/21/01 5:01:15 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_RegisterClick( Sender: TObject );
Begin
     mxProtector.Registration;
     ProcessRights;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.Edit_SerialChange, 8/28/01 3:42:35 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.Edit_SerialChange( Sender: TObject );
Begin
     btn_Register.Enabled := ( Edit_UserName.Text <> '' ) And ( Edit_Serial.Text <> '' );
End;

// *************************************************************************************
// ** Tfrm_MainWindow.btn_GetSerClick, 8/28/01 3:42:50 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_GetSerClick( Sender: TObject );
Begin
     Edit_Serial.Text := mxProtector.GenerateSerialNumber( Edit_UserName.Text );
End;

// *************************************************************************************
// ** Tfrm_MainWindow.mxProtectorGetSerialNumber, 8/30/01 9:41:16 AM
// *************************************************************************************

Procedure Tfrm_MainWindow.mxProtectorGetSerialNumber( Sender: TObject; Var UserName, SerialNumber: String );
Begin
     UserName := Edit_UserName.Text;
     SerialNumber := Edit_Serial.Text;
End;

// *************************************************************************************
// ** Tfrm_MainWindow.btn_AboutClick, 8/30/01 12:37:25 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.btn_AboutClick( Sender: TObject );
Var
     S: String;
Begin
     If mxProtector.GetRegisteredUserName = '' Then
          S := 'This is an unregistered copy' Else
          S := 'This software is registered to'#13#10 + mxProtector.GetRegisteredUserName;

     MessageDlg( S, mtInformation, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** Tfrm_MainWindow.mxProtectorInvalidSerialNumber, 8/30/01 12:37:22 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.mxProtectorInvalidSerialNumber( Sender: TObject );
Begin
     MessageDlg( 'This serial number is invalid!', mtError, [ mbOK ], 0 );
End;

// *************************************************************************************
// ** Tfrm_MainWindow.mxProtectorUnknownHardware, 10/12/01 1:33:55 PM
// *************************************************************************************

Procedure Tfrm_MainWindow.mxProtectorUnknownHardware( Sender: TObject );
Begin
     MessageDlg( 'Your Hardware does not compatible to this software' + #13 + #10 + 'Please contact the author.', mtError, [ mbOK ], 0 );
End;

End.

Open in new window

0
 
LVL 32

Accepted Solution

by:
ewangoya earned 300 total points
Comment Utility
First make sure Tfrm_MainWindow  is not autocreated
Then add code to your mainform onshow event
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

const
  UM_CHECKREGISTRATION = WM_USER + 101;

type
  TMainForm = class(TForm)
    procedure FormShow(Sender: TObject);
  private
    procedure UMCHECKREGISTRATION(var Message: TMessage); message UM_CHECKREGISTRATION;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses
  Form_Main;

procedure TMainForm.FormShow(Sender: TObject);
begin
  //post message to check for registration
  PostMessage(Handle, UM_CHECKREGISTRATION, 0, 0);
end;

procedure TMainForm.UMCHECKREGISTRATION(var Message: TMessage);
begin
  frm_MainWindow := Tfrm_MainWindow.Create(Self);
  try
    if not frm_MainWindow.mxProtector.IsRegistered then
    begin
      frm_MainWindow.ShowModal;
      if not frm_MainWindow.mxProtector.IsRegistered then
      begin
        PostMessage(Handle, WM_CLOSE, 0, 0);
        Exit;
      end;
    end;
  finally
    FreeAndNil(frm_MainWindow);
  end;
end;

end.

Open in new window

0
 

Author Comment

by:pr2501
Comment Utility
The second part i beliewe that i have made alright.
But with:
First make sure Tfrm_MainWindow  is not autocreated
something is not OK, because on RUN app blinks.

So where to check:
First make sure Tfrm_MainWindow  is not autocreated
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

You can check in Project->Options and select the tab for Forms

there are two lists
1. Auto-create forms
2. Available forms

The frm_MainWindow should be in Available forms
0
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
this doesn't mean the form isn't autocreated

you can just as well put it in the initialization section of a unit:
 
unit HiddenFromProjectXXX;

implementation

var mfrmMain: Tfrm_MainWindow;

procedure InitUnit;
begin
  mfrmMain := Tfrm_MainWindow.Create(Application);  
end;

initialization
  InitUnit;
end;

Open in new window

0
 
LVL 32

Expert Comment

by:ewangoya
Comment Utility

@pr2501
I'm not exactly sure what you mean by  'app blinks'
Can you please elaborate


@Geert

initialization
  InitUnit;

This is not auto creation, you have specifically put in code to create the form on Initialization
0
 

Author Comment

by:pr2501
Comment Utility
I hope You can understand  it for the picture.

Like one moment form is visible and then  not any more.  And this happens wit frequency high for human aye.
blink.JPG
0
 

Author Comment

by:pr2501
Comment Utility
I need some time more to elaborate Your last post, pleas.
0
 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 150 total points
Comment Utility
>>ewangoya
auto create at start of app, this means that a form is created at startup without the user interaction

off course you missed it :)
I only put 1 line of code in the initialization ... check the contents of InitUnit:

procedure InitUnit;
begin
  mfrmMain := Tfrm_MainWindow.Create(Application);  
end;

I can assure you that this form is created at startup in my sample

>>pr2501
you have a loop in your own code somewhere and you must be starting the mxProtecter too somewhere
0
 

Author Comment

by:pr2501
Comment Utility
I made it.  Sure am satisfied. And it is with Your sacrifices in patience that i have got positive result.
I have try it on three different PC-s.
Thank you.
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now