Solved

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

Posted on 2011-02-17
13
1,243 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 37

Expert Comment

by:Geert Gruwez
ID: 34923851
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
ID: 34924735
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
ID: 34924741
Form1 - your main application form and Form2 - your login/password form
0
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 

Author Comment

by:pr2501
ID: 34925477
 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
ID: 34939388
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
ID: 34941108
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
 
LVL 32

Expert Comment

by:ewangoya
ID: 34943383

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 37

Expert Comment

by:Geert Gruwez
ID: 34943422
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
ID: 34948003

@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
ID: 34949160
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
ID: 34949163
I need some time more to elaborate Your last post, pleas.
0
 
LVL 37

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 150 total points
ID: 34949229
>>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
ID: 34951235
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

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
In an interesting question (https://www.experts-exchange.com/questions/29008360/) here at Experts Exchange, a member asked how to split a single image into multiple images. The primary usage for this is to place many photographs on a flatbed scanner…

840 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