Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kompon/d5/MREGAPP.ZIP/mRegApp.pas

Pascal/Delphi Source File | 2002-08-08 | 10KB | 380 lines

{
----------------------------------------------------------
MAS-CompMaker was used to generate this code
MAS-CompMaker, 2000-2002« Mats Asplund
----------------------------------------------------------

Component Name: TmRegApp
        Author: Mats Asplund
      Creation: 2002-08-03
       Version: 1.0
   Description: An application registration component.
        Credit: Thanks to Oleg Petkov, http://olegpetkov.dir.bg/
                for providing the code/decode-routines.
        E-mail: [e-mail]
          Site: http://go.to/mdp
  Legal issues: All rights reserved 2002« by Mats Asplund

Usage:
  This software is provided 'as-is', without any express or
  implied warranty.  In no event will the author be held liable
  for any  damages arising from the use of this software.

  Permission is granted to anyone to use this software for any
  purpose, including commercial applications, and to alter it
  and redistribute it freely, subject to the following
  restrictions:

  1. The origin of this software must not be misrepresented,
     you must not claim that you wrote the original software.
     If you use this software in a product, an acknowledgment
     in the product documentation would be appreciated but is
     not required.

  2. Altered source versions must be plainly marked as such, and
     must not be misrepresented as being the original software.

  3. This notice may not be removed or altered from any source
     distribution.

  4. If you decide to use this software in any of your applications.
     Send me an EMail and tell me about it.

Quick Reference:
  TmRegApp inherits from TComponent.

  Key-Properties:
    P: The password. Automatically coded. Otherwise it could be read in the
    resource part of the exe-file. Note! Set password at designtime. Otherwise
    it will not work.

    CodeKey: Key used for coding/decoding. Change this to anything you like.

    DaysToUse: The number of days before registering is needed.

    FakeGUID: A false GUID used as key in Registry. You should change this,
    otherwise others with knowledge of this component could find it.

  Key-Methods:
    Init: Should be called each time the application starts executing. Returns
          the days left before registrering is needed. If the app. is registered
          -1 is returned.

    MoveBack: Read this to see if user has manipulated the clock. If true,
              the user has moved the clock back more then one day compared with
              the lastuse date. In this case 0 will be returned (and will
              continue to do so until registered), when calling the Init function.

    ClearReg: Deletes all Registry-entries made.
              (Deletes the FakeGUID-key from Registry.)

    CheckPassWord: Returns true if password is correct.
                   If so the values: 'DaysToUse', 'Expire', 'LastUse' will be
                   deleted from Registry. The value: 'Registered' will be set true.

    ExpireDate: Returns Expiredate as a string.

    InstallationDate: Returns Installationdate as a string.

    LastUseDate: Returns the date of last use as a string.


--------------------------------------------------------------------------------
}
unit mRegApp;

interface

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

type
  TDType = (dtInstall, dtLastUse, dtExpire);

  TmRegApp = class(TComponent)
  private
    FAbout: string;
    fP: string;
    fCodeKey: string;
    fDaysToUse: Integer;
    fFakeGUID: string;
    procedure SetCop(Value: string);
    procedure SetP(const Value: string);
    function Code(Text: string): shortstring;
    function Decode(CodedText: string): shortstring;
    function GetDates(DateType: TDType): string;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Init: Integer;
    function ExpireDate: string;
    function InstallationDate: string;
    function LastUseDate: string;
    function MoveBack: boolean;
    procedure ClearReg;
    function CheckPassWord(PassWord: string):boolean;
  published
    property P: string read fP write SetP; // The password
    property CodeKey: string read fCodeKey write fCodeKey;
    property DaysToUse: Integer read fDaysToUse write fDaysToUse;
    property FakeGUID: string read fFakeGUID write fFakeGUID;
    property About: string read FAbout write SetCop;
  end;

procedure Register;

const
  RegKey = '\Software\CLASSES\CLSID\';

implementation
uses DateUtils, Registry;

procedure Register;
begin
  RegisterComponents('MAs Prod.', [TmRegApp]);
end;

constructor TmRegApp.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fCodeKey:= 'MA-89D7-02';
  fDaysToUse:= 31;
  fFakeGUID:= '{A1159D67-71E0-11D4-BE52-39A481D50110}';
  FAbout:= 'Version 1.0, 2002 « Mats Asplund, http://go.to/masdp';
end;

destructor TmRegApp.Destroy;
begin
  inherited Destroy;
end;

function TmRegApp.Init: Integer; //DaysLeft. -1 if registered
var
  Reg: TRegistry;
  LastUse, ExpireDate: TDateTime;
begin
  Reg:= TRegistry.Create;
  try
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(RegKey + fFakeGUID) then
    begin
      Reg.OpenKey(RegKey + fFakeGUID, false);
      if Reg.ReadBool(Code('Registered')) then
        Result:= -1
      else
      begin
        LastUse:= StrToDateTime(Decode(Reg.ReadString(Code('LastUse'))));
        if (Reg.ReadBool(Code('MoveBack'))) or (CompareDate(Now, LastUse) < 0)
          then
        begin
          Reg.WriteBool(Code('MoveBack'), true);
          Result:= 0; // Time moved back
          Exit;
        end;
        Reg.WriteString(Code('LastUse'), Code(DateTimeToStr(Now)));
        ExpireDate:= StrToDateTime(Decode(Reg.ReadString(Code('Expire'))));
        if CompareDate(ExpireDate, Now) > 0 then
          Result:= DaysBetween(ExpireDate, Now)
        else
          Result:= 0; // Expired
      end
    end
    else
    begin // First time started
      Reg.OpenKey(RegKey + fFakeGUID, true);
      Reg.WriteString(Code('DaysToUse'), Code(IntToStr(fDaysToUse)));
      Reg.WriteString(Code('Install'), Code(DateTimeToStr(Now)));
      Reg.WriteString(Code('Expire'), Code(DateTimeToStr(IncDay(Now,
        fDaysToUse))));
      Reg.WriteString(Code('LastUse'), Code(DateTimeToStr(Now)));
      Reg.WriteBool(Code('MoveBack'), false);
      Reg.WriteBool(Code('Registered'), false);
      Reg.CloseKey;
      Result:= fDaysToUse;
    end;
  finally
    Reg.Free;
  end;
end;

procedure TmRegApp.ClearReg;
var
  Reg: TRegistry;
begin
  Reg:= TRegistry.Create;
  try
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(RegKey + fFakeGUID) then
      Reg.DeleteKey(RegKey + fFakeGUID);
  finally
    Reg.Free;
  end;
end;

function TmRegApp.LastUseDate: string;
begin
  Result:= GetDates(dtLastUse);
end;

function TmRegApp.ExpireDate: string;
begin
  Result:= GetDates(dtExpire);
end;

function TmRegApp.InstallationDate: string;
begin
  Result:= GetDates(dtInstall);
end;

function TmRegApp.MoveBack: boolean;
var
  Reg: TRegistry;
begin
  Result:= false;
  Reg:= TRegistry.Create;
  try
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(RegKey + fFakeGUID) then
    begin
      Reg.OpenKey(RegKey + fFakeGUID, false);
      Result:= Reg.ReadBool(Code('MoveBack'));
    end;
  finally
    Reg.Free;
  end;
end;

function TmRegApp.CheckPassWord(PassWord: string): boolean;
var
  Reg: TRegistry;
begin
  Reg:= TRegistry.Create;
  try
  Result:= false;
  if PassWord = Decode(fP) then
  begin
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(RegKey + fFakeGUID) then
    begin
      Reg.OpenKey(RegKey + fFakeGUID, false);
      Reg.WriteBool(Code('Registered'), true);
      Reg.DeleteValue(Code('DaysToUse'));
      Reg.DeleteValue(Code('Expire'));
      Reg.DeleteValue(Code('LastUse'));
      Result:= true;
    end;
  end
  else
    Result:= false;
  finally
    Reg.Free;
  end;
end;

procedure TmRegApp.SetCop(Value: string);
begin
  Exit;
end;

procedure TmRegApp.SetP(const Value: string);
begin
  fP:= Value;
  if csDesigning in ComponentState then // Could only be set at designtime
  begin
    Showmessage('Password "' + fP + '" is coded to: ' + Code(fP));
    fP:= Code(fP);
  end;
end;

function TmRegApp.GetDates(DateType: TDType): string;
var
  Reg: TRegistry;
  DT: string;
begin
  Reg:= TRegistry.Create;
  try
    Result:= '';
    case DateType of
      dtInstall: DT:= 'Install';
      dtLastUse: DT:= 'LastUse';
      dtExpire: DT:= 'Expire';
    end;
    Reg.RootKey:= HKEY_LOCAL_MACHINE;
    if Reg.KeyExists(RegKey + fFakeGUID) then
    begin
      Reg.OpenKey(RegKey + fFakeGUID, false);
      Result:= Decode(Reg.ReadString(Code(DT)));
    end;
  finally
    Reg.Free;
  end;
end;

function TmRegApp.Decode(CodedText: string): shortstring;
var
  DataSize, q, Q1, k, Len: short;
  P: PChar;

  function HexaToInt(ch: char): short;
  begin
    case ch of
      '0'..'9': Result:= StrToInt(ch);
      'A': Result:= 10;
      'B': Result:= 11;
      'C': Result:= 12;
      'D': Result:= 13;
      'E': Result:= 14;
      'F': Result:= 15;
    else
      Result:= 7;
    end;
  end;
begin
  Result:= '';
  k:= 1;
  P:= PChar(CodedText);
  DataSize:= Length(CodedText);
  Len:= Length(fCodeKey);
  if Len > DataSize then
    Len:= DataSize;
  while DataSize > 0 do
  begin
    case P^ of
      #10, #13, #32: Inc(P);
    else
      Q1:= HexaToInt(P^);
      Inc(P);
      q:= HexaToInt(P^);
      Inc(P);
      q:= (Q1 * 16) + q;
      q:= q xor (Ord(fCodeKey[k]));
      Inc(k);
      if k > Len then
        k:= 1;
      Result:= Result + chr(q);
    end;
    Dec(DataSize, 2);
  end;
end;

function TmRegApp.Code(Text: string): shortstring;
var
  DataSize, i, q, k: short;
begin
  Result:= '';
  DataSize:= Length(Text);
  k:= 1;
  for i:= 1 to DataSize do
  begin
    q:= Ord(Text[i]) xor Ord(fCodeKey[k]);
    Inc(k);
    if k > Length(fCodeKey) then
      k:= 1;
    Result:= Result + IntToHex(q, 2);
  end;
end;

end.