(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower OnGuard
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * Andrew Haines         andrew@haines.name                        {AH.01}
 *                       conversion to CLX                         {AH.01}
 *                       December 30, 2003                         {AH.01}
 *
 * ***** END LICENSE BLOCK ***** *)
{*********************************************************}
{*                  ONGUARD.PAS 1.13                     *}
{*     Copyright (c) 1996-02 TurboPower Software Co      *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I onguard.inc}
{$I-} { I/O checks disabled}
{$Q-} {Integer overflow check disabled.
Warning : at least one function (MixBlock) causes overflow}

unit onguard;
  {-code and key classes and routines}

interface

uses
{$IFDEF MSWINDOWS}                                                 {AH.01}
  Windows,                                                         {AH.01}
{$ENDIF}                                                           {AH.01}
{$IFDEF IBO_CONSOLE}
  ConsoleStubs,
{$ENDIF}  
{$IFDEF LINUX}                                                     {AH.01}
  BaseUnix,                                                            {AH.01}
{$ENDIF}                                                           {AH.01}
  Classes, SysUtils,MD5,
  ogconst,
  ogutil
{$IFNDEF IBO_CONSOLE}
  ,Controls, Dialogs
{$ENDIF}
{$IFDEF UsingZLib}
  ,ZLib
{$ENDIF}
{$IFDEF WIN32}
 ,idesn
{$ENDIF}
  ;

{$IFNDEF IBO_CONSOLE}
const
  {magic values}
  DaysCheckCode    = $649B;
  DateCheckCode    = $A4CB;
  NetCheckCode     = $9341;
  RegCheckCode     = $D9F6;
  SerialCheckCode  = $3C69;
  UsageCheckCode   = $F3D5;
  SpecialCheckCode = $9C5B;

type
  {code tyes}
  PCode = ^TCode;
  TCode = packed record
    CheckValue : Word;               {magic value}
    Expiration : Word;               {expiration date or 0, if none}
    InvalidCount : Word;             {count of respected invalid code accidents,normally 0}
    case Byte of
      0 : (FirstDate    : Word;      {for date code}
           EndDate      : Word);
      1 : (Days         : Word;      {for days code}
           LastAccess   : Word);
      2 : (RegString    : LongInt);  {for reg code}
      3 : (SerialNumber : LongInt);  {for serial number code}
      4 : (UsageCount   : Word;      {for usage count code}            {!!.02}
           LastChange   : Word);                                       {!!.02}
      5 : (Value        : LongInt);  {for specail codes}
      6 : (NetIndex     : LongInt);  {for net codes}
  end;

type
  TCodeType = (ctDate, ctDays, ctRegistration, ctSerialNumber,
               ctUsage, ctNetwork, ctSpecial, ctUnknown);
  {order must match tab order for code generation notebook}

type
  TKey     = array [0..15] of Byte;
  TKeyType = (ktRandom, ktMessageDigest, ktMessageDigestCS);
  {order must match order for key generation combobox string list}

type
  {contexts}
  TTMDContext = array [0..279] of Byte;

  {bit mixing types}
  T128Bit     = array [0..3] of LongInt;
  T256Bit     = array [0..7] of LongInt;

const
  DefCodeType      = ctDate;
  DefKeyType       = ktRandom;

type
  TEsMachineInfoSet =                                                  {!!.05}
    set of (midUser, midSystem, midNetwork, midDrives);                {!!.05}

type
  {result of code verification}
  TCodeStatus = (ogValidCode,    {code is valid but may still be expired}
                 ogInvalidCode,  {code is invalid}
                 ogPastEndDate,  {end date has been reached}
                 ogDayCountUsed, {number of days authorized have been used}
                 ogRunCountUsed, {number of runs authorized have been used}
                 ogNetCountUsed, {number of authorized users has been exceeded}
                 ogCodeExpired); {expiration date has been reached}

{$ENDIF}

type
  EOnGuardException = class(Exception);

type
  TChangeCodeEvent =
    procedure(Sender : TObject; Code : TCode)
    of object;
  TCheckedCodeEvent =
    procedure(Sender : TObject; Status : TCodeStatus)
    of object;
  TGetCodeEvent =
    procedure(Sender : TObject; var Code : TCode)
    of object;
  TGetKeyEvent =
    procedure(Sender : TObject; var Key : TKey)
    of object;
  TGetModifierEvent =
    procedure(Sender : TObject; var Value : LongInt)
    of object;
  TGetRegStringEvent =
    procedure(Sender : TObject; var Value : string)
    of object;

  {base regisration code component}
  TOgCodeBase = class(TComponent)
  protected {private}
    {property variables}
    FAutoCheck     : Boolean;          {true to test code when loaded}
    FCode          : TCode;            {release code}
    FModifier      : LongInt;          {key modifier}
    FStoreCode     : Boolean;          {true to store release code on stream}
    FStoreModifier : Boolean;          {true to store key modifier on stream}

    {event variables}
    FOnChecked     : TCheckedCodeEvent;{called after auto check is made}
    FOnGetCode     : TGetCodeEvent;    {called to retrieve release code}
    FOnGetKey      : TGetKeyEvent;     {called to retrieve key}
    FOnGetModifier : TGetModifierEvent;{called to retrieve key modifier}

    {property methods}
    function GetCode : string;
    function GetModifier : string;
    function GetAbout : string;                                      {!!.08}
    procedure SetCode(const Value : string);
    procedure SetModifier(const Value : string);
    procedure SetAbout(const Value : string);                        {!!.08}

  protected
    procedure Loaded;
      override;

    procedure DoOnChecked(Value : TCodeStatus);
      dynamic;
    function DoOnGetCode : TCode;
      dynamic;
    procedure DoOnGetKey(var Key : TKey);
      dynamic;
    function DoOnGetModifier : LongInt;
      dynamic;

    {protected properties}
    property Code : string
      read GetCode
      write SetCode;

    property StoreCode : Boolean
      read FStoreCode
      write FStoreCode;

  public
    constructor Create(AOwner : TComponent);
      override;

    function CheckCode(Report : Boolean) : TCodeStatus;
      virtual; abstract;
    function IsCodeValid : Boolean;
      {-return true if code is valid}

  published
    {properties}
    property AutoCheck : Boolean
      read FAutoCheck
      write FAutoCheck
      default DefAutoCheck;

    property Modifier : string
      read GetModifier
      write SetModifier
      stored FStoreModifier;

    property StoreModifier : Boolean
      read FStoreModifier
      write FStoreModifier
      default DefStoreModifier;

    property About : string                                          {!!.08}
      read GetAbout                                                  {!!.08}
      write SetAbout                                                 {!!.08}
      stored False;

    {events}
    property OnChecked : TCheckedCodeEvent
      read FOnChecked
      write FOnChecked;

    property OnGetKey : TGetKeyEvent
      read FOnGetKey
      write FOnGetKey;

    property OnGetCode : TGetCodeEvent
      read FOnGetCode
      write FOnGetCode;

    property OnGetModifier : TGetModifierEvent
      read FOnGetModifier
      write FOnGetModifier;
  end;

  TOgMakeCodes = class(TComponent)
  protected {private}
    {property variables}
    FCode        : TCode;
    FCodeType    : TCodeType;
    FKey         : TKey;
    FKeyFileName : string;
    FKeyType     : TKeyType;
    FShowHints   : Boolean;

    {property methods}
    function GetAbout : string;                                      {!!.08}
    procedure SetAbout(const Value : string);                        {!!.08}

  public
    constructor Create(AOwner : TComponent);
      override;
    function Execute : Boolean;
    procedure GetCode(var Value : TCode);                            {!!.08}
    procedure SetCode(Value : TCode);                                {!!.08}
    procedure GetKey(var Value : TKey);                              {!!.08}
    procedure SetKey(Value : TKey);                                  {!!.08}

    property KeyType : TKeyType
      read FKeyType
      write FKeyType;

  published

    {properties}
    property CodeType : TCodeType
      read FCodeType
      write FCodeType
      default DefCodeType;

     property KeyFileName : string
      read FKeyFileName
      write FKeyFileName;

    property ShowHints : Boolean
      read FShowHints
      write FShowHints
      default False;

    property About : string                                          {!!.08}
      read GetAbout                                                  {!!.08}
      write SetAbout                                                 {!!.08}
      stored False;
  end;

type
  TOgMakeKeys = class(TComponent)
  protected {private}
    {property variables}
    FKeyFileName : string;
    FKey         : TKey;
    FKeyType     : TKeyType;
    FShowHints   : Boolean;

    {property methods}
    function GetAbout : string;                                      {!!.08}
    procedure SetAbout(const Value : string);                        {!!.08}

  public
    constructor Create(AOwner : TComponent);
      override;
    function Execute : Boolean;

    procedure ApplyModifierToKey(Modifier : LongInt; var Key; KeySize : Cardinal);
      {-signs the key with the modifier}
    function GenerateDateModifier(D : TDateTime) : LongInt;
      {-returns a modifier based on the current date}
    function GenerateMachineModifier : LongInt;
      {-returns a modifier based on hardware information}
    procedure GenerateMDKey(var Key; KeySize : Cardinal; const Str : string);
      {-generate a key based on the message digest of Str}
    procedure GenerateRandomKey(var Key; KeySize : Cardinal);
      {-generate a random key}
    function GenerateStringModifier(const S : string) : LongInt;
      {-returns a modifier based on S}
    function GenerateUniqueModifier : LongInt;
      {-returns a unique/random modifier}
    procedure SetKey(Value : TKey);                                  {!!.08}
    procedure GetKey(var Value : TKey);                              {!!.08}

  published

    {properties}
    property About : string                                          {!!.08}
      read GetAbout                                                  {!!.08}
      write SetAbout                                                 {!!.08}
      stored False;

    property KeyFileName : string
      read FKeyFileName
      write FKeyFileName;

    property KeyType : TKeyType
      read FKeyType
      write FKeyType
      default DefKeyType;

    property ShowHints : Boolean
      read FShowHints
      write FShowHints
      default False;
  end;

  { TOgDateCode }

  TOgDateCode = class(TOgCodeBase)
  public
    function CheckCode(Report : Boolean) : TCodeStatus;
      override;
    function GetValue : TDateTime;
      {-return expiration date (0 for error)}

    function GetInvalidCount : LongInt;

  published
    {properties}
    property Code
      stored FStoreCode;

    property StoreCode
      default DefStoreCode;
  end;

  TOgDaysCode = class(TOgCodeBase)
  protected {private}
    {property variables}
    FAutoDecrease : Boolean;

    {event variables}
    FOnChangeCode : TChangeCodeEvent;

  protected
    procedure Loaded;
      override;

    procedure DoOnChangeCode(Value : TCode);
      dynamic;

  public
    constructor Create(AOwner : TComponent);
      override;
    function CheckCode(Report : Boolean) : TCodeStatus;
      override;
    procedure Decrease;
      {-reduce days and generate modified code}
    function GetValue : LongInt;
      {-return number of days remaining}

    function GetInvalidCount : LongInt;

  published
    {properties}
    property AutoDecrease : Boolean
      read FAutoDecrease
      write FAutoDecrease
      default DefAutoDecrease;

    {events}
    property OnChangeCode : TChangeCodeEvent
      read FOnChangeCode
      write FOnChangeCode;
  end;

  TOgRegistrationCode = class(TOgCodeBase)
  protected {private}
    {property variables}
    FRegString      : string;
    FStoreRegString : Boolean;

    {event variables}
    FOnGetRegString : TGetRegStringEvent;

  protected
    function DoOnGetRegString : string;
      dynamic;

  public
    constructor Create(AOwner : TComponent);
      override;

    function CheckCode(Report : Boolean) : TCodeStatus;
      override;

  published
    {properties}
    property Code
      stored FStoreCode;

    property StoreCode
      default DefStoreCode;

    property RegString : string
      read FRegString
      write FRegString
      stored FStoreRegString;

    property StoreRegString : Boolean
      read FStoreRegString
      write FStoreRegString
      default DefStoreRegString;

    {events}
    property OnGetRegString : TGetRegStringEvent
      read FOnGetRegString
      write FOnGetRegString;
  end;

  TOgSerialNumberCode = class(TOgCodeBase)
  public
    function CheckCode(Report : Boolean) : TCodeStatus;
      override;
    function GetValue : LongInt;
      {-return serial number (0 for error)}

  published
    {properties}
    property Code
      stored FStoreCode;

    property StoreCode
      default DefStoreCode;

  end;

  TOgSpecialCode = class(TOgCodeBase)
    function CheckCode(Report : Boolean) : TCodeStatus;
      override;
    function GetValue : LongInt;
      {-return serial number (0 for error)}

  published
    {properties}
    property Code
      stored FStoreCode;

    property StoreCode
      default DefStoreCode;
  end;

  TOgUsageCode = class(TOgCodeBase)
  protected {private}
    {property variables}
    FAutoDecrease : Boolean;

    {event variables}
    FOnChangeCode : TChangeCodeEvent;

  protected
    procedure Loaded;
      override;

    procedure DoOnChangeCode(Value : TCode);
      dynamic;

  public
    constructor Create(AOwner : TComponent);
      override;
    function CheckCode(Report : Boolean) : TCodeStatus;
      override;
    procedure Decrease;
      {-reduce number of uses and generate code}
    function GetValue : LongInt;
      {-return number of uses remaining}

  published
    {properties}
    property AutoDecrease : Boolean
      read FAutoDecrease
      write FAutoDecrease
      default DefAutoDecrease;

    {events}
    property OnChangeCode : TChangeCodeEvent
      read FOnChangeCode
      write FOnChangeCode;
  end;

{$IFNDEF IBO_CONSOLE}

function GetInvalidCountValue(const Key : TKey; const Code : TCode) : LongInt;
procedure DecInvalidCountCode(const Key : TKey; var Code : TCode);


function GetCodeType(const Key : TKey; const Code : TCode) : TCodeType;
  {-return the type of code}
function GetExpirationDate(const Key : TKey; const Code : TCode) : TDateTime;
  {-return the date this code expires}

procedure InitDateCode(const Key : TKey; StartDate, EndDate : TDateTime; var Code : TCode; InvalidCount : Word=0);
function IsDateCodeValid(const Key : TKey; const Code : TCode) : Boolean;
function GetDateCodeValue(const Key : TKey; const Code : TCode) : TDateTime;
function IsDateCodeExpired(const Key : TKey; const Code : TCode) : Boolean;

procedure InitDaysCode(const Key : TKey; Days : Word; Expires : TDateTime; var Code : TCode; InvalidCount : Word=0);
function IsDaysCodeValid(const Key : TKey; const Code : TCode) : Boolean;
procedure DecDaysCode(const Key : TKey; var Code : TCode);
function GetDaysCodeValue(const Key : TKey; const Code : TCode) : LongInt;
function IsDaysCodeExpired(const Key : TKey; const Code : TCode) : Boolean;


procedure InitRegCode(const Key : TKey; const RegStr : string; Expires : TDateTime; var Code : TCode);
function IsRegCodeValid(const Key : TKey; const Code : TCode) : Boolean;
function IsRegCodeExpired(const Key : TKey; const Code : TCode) : Boolean;

procedure InitSerialNumberCode(const Key : TKey;  Serial : LongInt; Expires : TDateTime; var Code : TCode);
function IsSerialNumberCodeValid(const Key : TKey; const Code : TCode) : Boolean;
function GetSerialNumberCodeValue(const Key : TKey; const Code : TCode) : LongInt;
function IsSerialNumberCodeExpired(const Key : TKey; const Code : TCode) : Boolean;

procedure InitSpecialCode(const Key : TKey; Value : LongInt; Expires : TDateTime; var Code : TCode);
function IsSpecialCodeValid(const Key : TKey; const Code : TCode) : Boolean;
function GetSpecialCodeValue(const Key : TKey; const Code : TCode) : LongInt;
function IsSpecialCodeExpired(const Key : TKey; const Code : TCode) : Boolean;

procedure InitUsageCode(const Key : TKey; Count : Word; Expires : TDateTime; var Code : TCode;InvalidCount : Word=0);
function IsUsageCodeValid(const Key : TKey; const Code : TCode) : Boolean;
procedure DecUsageCode(const Key : TKey; var Code : TCode);
function GetUsageCodeValue(const Key : TKey; const Code : TCode) : LongInt;
function IsUsageCodeExpired(const Key : TKey; const Code: TCode) : Boolean;


{generate key routines}
procedure GenerateRandomKeyPrim(var Key; KeySize : Cardinal);
procedure GenerateTMDKeyPrim(var Key; KeySize : Cardinal; const Str : string);
procedure GenerateMD5KeyPrim(var Key: TKey; const Str : string);

{modifier routines}
function CreateMachineID(MachineInfo : TEsMachineInfoSet) : LongInt;   {!!.05}
function GenerateStringModifierPrim(const S : string) : LongInt;
function GenerateUniqueModifierPrim : LongInt;
function GenerateMachineModifierPrim : LongInt;
function GenerateDateModifierPrim(D : TDateTime) : LongInt;
procedure ApplyModifierToKeyPrim(Modifier : LongInt; var Key; KeySize : Cardinal);

{hash routines}
function StringHashElf(const Str : string) : LongInt;

{mixing routines}
procedure MixBlock(const Matrix : T128Bit; var Block; Encrypt : Boolean);

{utility routines}
function ExpandDate(D : Word) : TDateTime;
function ShrinkDate(D : TDateTime) : Word;

const
  BaseDate : LongInt = 0;
{$ENDIF}

implementation
{$IFNDEF IBO_CONSOLE}
uses
  {$IFNDEF NoMakeCodesSupport} qonguard2 {$ENDIF}                    {!!.10}           {!!.10}
  {$IFNDEF NoMakeKeysSupport} , qonguard3  {$ENDIF}                    {!!.10}           {!!.10}
  ;
{$ENDIF}
{$IFNDEF IBO_CONSOLE}
{first 2048 bits of Pi in hexadecimal, low to high, without the leading "3"}
const
  Pi2048: array [0..255] of Byte = (
    $24, $3F, $6A, $88, $85, $A3, $08, $D3, $13, $19, $8A, $2E, $03, $70, $73, $44,
    $A4, $09, $38, $22, $29, $9F, $31, $D0, $08, $2E, $FA, $98, $EC, $4E, $6C, $89,
    $45, $28, $21, $E6, $38, $D0, $13, $77, $BE, $54, $66, $CF, $34, $E9, $0C, $6C,
    $C0, $AC, $29, $B7, $C9, $7C, $50, $DD, $3F, $84, $D5, $B5, $B5, $47, $09, $17,
    $92, $16, $D5, $D9, $89, $79, $FB, $1B, $D1, $31, $0B, $A6, $98, $DF, $B5, $AC,
    $2F, $FD, $72, $DB, $D0, $1A, $DF, $B7, $B8, $E1, $AF, $ED, $6A, $26, $7E, $96,
    $BA, $7C, $90, $45, $F1, $2C, $7F, $99, $24, $A1, $99, $47, $B3, $91, $6C, $F7,
    $08, $01, $F2, $E2, $85, $8E, $FC, $16, $63, $69, $20, $D8, $71, $57, $4E, $69,
    $A4, $58, $FE, $A3, $F4, $93, $3D, $7E, $0D, $95, $74, $8F, $72, $8E, $B6, $58,
    $71, $8B, $CD, $58, $82, $15, $4A, $EE, $7B, $54, $A4, $1D, $C2, $5A, $59, $B5,
    $9C, $30, $D5, $39, $2A, $F2, $60, $13, $C5, $D1, $B0, $23, $28, $60, $85, $F0,
    $CA, $41, $79, $18, $B8, $DB, $38, $EF, $8E, $79, $DC, $B0, $60, $3A, $18, $0E,
    $6C, $9E, $0E, $8B, $B0, $1E, $8A, $3E, $D7, $15, $77, $C1, $BD, $31, $4B, $27,
    $78, $AF, $2F, $DA, $55, $60, $5C, $60, $E6, $55, $25, $F3, $AA, $55, $AB, $94,
    $57, $48, $98, $62, $63, $E8, $14, $40, $55, $CA, $39, $6A, $2A, $AB, $10, $B6,
    $B4, $CC, $5C, $34, $11, $41, $E8, $CE, $A1, $54, $86, $AF, $7C, $72, $E9, $93);


{mixing routines}
procedure Mix128(var X : T128Bit);
var
  AA, BB, CC, DD : LongInt;
begin
  AA := X[0];  BB := X[1];  CC := X[2];  DD := X[3];

  AA := AA + DD;  DD := DD + AA;  AA := AA xor (AA shr 7);
  BB := BB + AA;  AA := AA + BB;  BB := BB xor (BB shl 13);
  CC := CC + BB;  BB := BB + CC;  CC := CC xor (CC shr 17);
  DD := DD + CC;  CC := CC + DD;  DD := DD xor (DD shl 9);
  AA := AA + DD;  DD := DD + AA;  AA := AA xor (AA shr 3);
  BB := BB + AA;  AA := AA + BB;  BB := BB xor (BB shl 7);
  CC := CC + BB;  BB := BB + CC;  CC := CC xor (DD shr 15);
  DD := DD + CC;  CC := CC + DD;  DD := DD xor (DD shl 11);

  X[0] := AA;  X[1] := BB;  X[2] := CC;  X[3] := DD;
end;

{quick (block) mixer routine}
procedure MixBlock(const Matrix : T128bit; var Block; Encrypt : Boolean);
const
  CKeyBox : array [False..True, 0..3, 0..2] of LongInt =
    (((0, 3, 1), (2, 1, 3), (1, 0, 2), (3, 2, 0)),
     ((3, 2, 0), (1, 0, 2), (2, 1, 3), (0, 3, 1)));
var
  Blocks  : array [0..1] of LongInt absolute Block;
  Work    : LongInt;
  Right   : LongInt;
  Left    : LongInt;
  R       : LongInt;
  AA, BB  : LongInt;
  CC, DD  : LongInt;
begin
  Right := Blocks[0];
  Left := Blocks[1];

  for R := 0 to 3 do begin
    {transform the right side}
    AA := Right;
    BB := Matrix[CKeyBox[Encrypt, R, 0]];
    CC := Matrix[CKeyBox[Encrypt, R, 1]];
    DD := Matrix[CKeyBox[Encrypt, R, 2]];

    {commented code does not affect results - removed for speed}
    AA := AA + DD;DD := DD + AA;AA := AA xor (AA shr 7);
    BB := BB + AA; AA := AA + BB; BB := BB xor (BB shl 13);
    CC := CC + BB; BB := BB + CC; CC := CC xor (CC shr 17);
    DD := DD + CC; CC := CC + DD; DD := DD xor (DD shl 9);
    AA := AA + DD; DD := DD + AA; AA := AA xor (AA shr 3);
    BB := BB + AA; {AA := AA + BB;}  BB := BB xor (BB shl 7);
    CC := CC + BB; {BB := BB + CC;}  CC := CC xor (DD shr 15);
    DD := DD + CC; {CC := CC + DD;}  DD := DD xor (DD shl 11);

    Work := Left xor DD;
    Left := Right;
    Right := Work;
  end;

  Blocks[0] := Left;
  Blocks[1] := Right;
end;

function HashElf(const Buf;  BufSize : LongInt) : LongInt;
var
  Bytes : TByteArray absolute Buf;
  I, X  : LongInt;
begin
  Result := 0;
  for I := 0 to BufSize - 1 do begin
    Result := (Result shl 4) + Bytes[I];
    X := Result and $F0000000;
    if (X <> 0) then
      Result := Result xor (X shr 24);
    Result := Result and (not X);
  end;
end;

function StringHashElf(const Str : string) : LongInt;
begin
  Result := HashElf(Str[1], Length(Str));
end;


{message digest routines}
type
  TMDContextEx = record
    DigestIndex : LongInt;
    Digest      : array [0..255] of Byte;
    KeyIndex    : LongInt;
    case Byte of
      0: (KeyInts : array [0..3] of LongInt);
      1: (Key     : TKey);
  end;
  TBlock2048 = array [0..255] of Byte;

procedure InitTMD(var Context : TTMDContext);
var
  ContextEx : TMDContextEx absolute Context;
begin
  ContextEx.DigestIndex := 0;
  TBlock2048(ContextEx.Digest) := TBlock2048(Pi2048);

  ContextEx.KeyIndex := 0;
  ContextEx.KeyInts[0] := $55555555;
  ContextEx.KeyInts[1] := $55555555;
  ContextEx.KeyInts[2] := $55555555;
  ContextEx.KeyInts[3] := $55555555;
end;

procedure UpdateTMD(var Context : TTMDContext; const Buf; BufSize : LongInt);
var
  ContextEx : TMDContextEx absolute Context;
  BufBytes  : TByteArray absolute Buf;
  AA, BB    : LongInt;
  CC, DD    : LongInt;
  I, R      : LongInt;
begin
  for I := 0 to BufSize - 1 do
    with ContextEx do begin
      {update Digest}
      Digest[DigestIndex] := Digest[DigestIndex] xor BufBytes[I];
      DigestIndex := DigestIndex + 1;
      if (DigestIndex = SizeOf(Digest)) then
        DigestIndex := 0;

      {update BlockKey}
      Key[KeyIndex] := Key[KeyIndex] xor BufBytes[I];
      KeyIndex := KeyIndex + 1;
      if (KeyIndex = SizeOf(Key) div 2) then begin
        AA := KeyInts[3];
        BB := KeyInts[2];
        CC := KeyInts[1];
        DD := KeyInts[0];

        {mix all the bits around for 4 rounds}
        {achieves avalanche and eliminates funnels}
        for R := 0 to 3 do begin
          AA := AA + DD; DD := DD + AA; AA := AA xor (AA shr 7);
          BB := BB + AA; AA := AA + BB; BB := BB xor (BB shl 13);
          CC := CC + BB; BB := BB + CC; CC := CC xor (CC shr 17);
          DD := DD + CC; CC := CC + DD; DD := DD xor (DD shl 9);
          AA := AA + DD; DD := DD + AA; AA := AA xor (AA shr 3);
          BB := BB + AA; AA := AA + BB; BB := BB xor (BB shl 7);
          CC := CC + BB; BB := BB + CC; CC := CC xor (DD shr 15);
          DD := DD + CC; CC := CC + DD; DD := DD xor (DD shl 11);
        end;

        KeyInts[0] := AA;
        KeyInts[1] := BB;
        KeyInts[2] := CC;
        KeyInts[3] := DD;

        KeyIndex := 0;
      end;
    end;
end;

procedure FinalizeTMD(var Context : TTMDContext; var Digest; DigestSize : LongInt);
const
  Padding : array [0..7] of Byte = (1, 0, 0, 0, 0, 0, 0, 0);
var
  ContextEx : TMDContextEx absolute Context;
  I         : Integer;
begin
  {pad with "1", followed by as many "0"s as needed to fill the block}
  UpdateTMD(Context, Padding, SizeOf(Padding) - ContextEx.KeyIndex);

  {mix each block within Context with the key}
  for I := 0 to (SizeOf(ContextEx.Digest) div SizeOf(TCode)) - 1 do
    MixBlock(T128Bit(ContextEx.Key), PCode(@ContextEx.Digest[I * SizeOf(TCode)])^, True);

  {return Digest of requested DigestSize}
  {max digest is 2048-bit, although it could be greater if Pi2048 was larger}
  Move(ContextEx.Digest, Digest, Min(SizeOf(ContextEx.Digest), DigestSize));
end;

{message digest hash}
procedure HashTMD(var Digest; DigestSize : LongInt; const Buf; BufSize : LongInt);
var
  Context : TTMDContext;
begin
  InitTMD(Context);
  UpdateTMD(Context, Buf, BufSize);
  FinalizeTMD(Context, Digest, DigestSize);
end;

{$IFDEF Win32}
{!!.05} {added}



function CreateMachineID(MachineInfo : TEsMachineInfoSet) : LongInt;
{ Obtains information from:
    - Volume sizes (NOT free space)
    - Volume serial numbers
    - Registration name and company
    - GetSystemInfo relevant info
    - Network card ID (if available)
}
const
  sCurVer   = 'Software\Microsoft\Windows\CurrentVersion';           {!!.11}
  sCurVerNT = 'Software\Microsoft\Windows NT\CurrentVersion';        {!!.11}
  sRegOwner = 'RegisteredOwner';                                     {!!.11}
  sRegOrg   = 'RegisteredOrganization';                              {!!.11}

type                                                                     {!!.11}
  TUuidCreateSequential = function (lpGUID : Pointer): HResult; stdcall; {!!.11}

  
var
  hRPCTR4 : THandle;                                                 {!!.11}
  UuidCreateSequential : TUuidCreateSequential;                      {!!.11}
  I       : DWord;
  RegKey  : HKEY;
  GUID1   : TGUID;
  GUID2   : TGUID;
  Drive   : AnsiChar;
  SysInfo : TSystemInfo;
  Context : TTMDContext;
  UserInfoFound : Boolean;                                           {!!.11}
  Buf     : array [0..1023] of Byte;
  iController, iDrive, maxController : Integer;
  BufStr : AnsiString;
begin
  InitTMD(Context);

  {include user specific information}
  if midUser in MachineInfo then begin
{!!.11}
    UserInfoFound := False;
    { first look for registered info in \Windows\CurrentVersion }
    if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, sCurVer, 0,
        KEY_QUERY_VALUE, RegKey) = ERROR_SUCCESS) then begin
      I := SizeOf(Buf);
      if RegQueryValueEx(RegKey, sRegOwner, nil, nil, @Buf, @I) = ERROR_SUCCESS then begin
        UserInfoFound := True;
        UpdateTMD(Context, Buf, I);
        I := SizeOf(Buf);
        if RegQueryValueEx(RegKey, sRegOrg, nil, nil, @Buf, @I) = ERROR_SUCCESS then
          UpdateTMD(Context, Buf, I);
      end;
      RegCloseKey(RegKey);                                           {!!.13}
    end;

{!!.11}
    { if not found, then look in \Windows NT\CurrentVersion }
    if not UserInfoFound then
      if (RegOpenKeyEx(HKEY_LOCAL_MACHINE, sCurVerNT, 0,
          KEY_QUERY_VALUE, RegKey) = ERROR_SUCCESS) then begin
        I := SizeOf(Buf);
        if RegQueryValueEx(RegKey, sRegOwner, nil, nil, @Buf, @I) = ERROR_SUCCESS then begin
          UpdateTMD(Context, Buf, I);
          I := SizeOf(Buf);
          if RegQueryValueEx(RegKey, sRegOrg, nil, nil, @Buf, @I) = ERROR_SUCCESS then
            UpdateTMD(Context, Buf, I);
        end;
        RegCloseKey(RegKey);                                         {!!.13}
      end;
  end;

  if midSystem in MachineInfo then begin
    {include system specific information}
    GetSystemInfo(SysInfo);
    PDWord(@Buf[0])^ := SysInfo.dwOemId;
    PDWord(@Buf[4])^ := SysInfo.dwProcessorType;
    UpdateTMD(Context, Buf, 8);
  end;

  if midNetwork in MachineInfo then begin
    {include network ID}

    CreateGuid(GUID1); //CoCreateGuid(GUID1);
    CreateGuid(GUID2); //CoCreateGuid(GUID2);

     
{!!.11}
    { use UuidCreateSequential instead of CoCreateGuid if available }
        hRPCTR4 := LoadLibrary('rpcrt4.dll');
        if (hRPCTR4 <> 0) then begin
          UuidCreateSequential := TUuidCreateSequential(GetProcAddress(hRPCTR4, 'UuidCreateSequential'));
          if Assigned(UuidCreateSequential) then begin
            UuidCreateSequential(@GUID1);
            UuidCreateSequential(@GUID2);
          end;
          FreeLibrary(hRPCTR4);                                      {!!.13}
        end;
{!!.11}



    {check to see if "network" ID is available}
    if (GUID1.D4[2] = GUID2.D4[2]) and
       (GUID1.D4[3] = GUID2.D4[3]) and
       (GUID1.D4[4] = GUID2.D4[4]) and
       (GUID1.D4[5] = GUID2.D4[5]) and
       (GUID1.D4[6] = GUID2.D4[6]) and
       (GUID1.D4[7] = GUID2.D4[7]) then
      UpdateTMD(Context, GUID1.D4[2], 6);//brandys
  end;

  if midDrives in MachineInfo then begin
    {include drive specific information}
  maxController := 15;
  if Win32Platform<>VER_PLATFORM_WIN32_NT then maxController := 0;
  for iController := 0 to maxController do
  begin
    for iDrive := 0 to 4 do
    begin
        BufStr := '';
        if GetIdeDiskSerialNumber(iController,iDrive,BufStr) then
           if BufStr<>'' then UpdateTMD(Context, BufStr[1], 5);
    end;
  end;
  end;

  FinalizeTMD(Context, Result, SizeOf(Result));
end;
{$ELSE}
{$IFNDEF LINUX}
function CreateMachineID(MachineInfo : TEsMachineInfoSet) : LongInt;
var
  I       : DWord;
  RegKey  : DWord;
  GUID1   : TGUID;
  GUID2   : TGUID;
  Drive   : Integer;
  Context : TTMDContext;
  Buf     : array [0..1023] of Byte;
begin
  InitTMD(Context);

  {no user (midUser) information under Win16}

  if midSystem in MachineInfo then begin
    {include system specific information}
    I := GetWindowsDirectory(@Buf, SizeOf(Buf));
    UpdateTMD(Context, Buf, I);
    I := GetSystemDirectory(@Buf, SizeOf(Buf));
    UpdateTMD(Context, Buf, I);

    PLongInt(@Buf[0])^ := GetWinFlags;
    PLongInt(@Buf[4])^ := WinProcs.GetVersion;
    UpdateTMD(Context, Buf, 8);
  end;

  if midNetwork in MachineInfo then begin
    {include network ID}
    CreateGuid(GUID1);
    CreateGuid(GUID2);
    {check to see if "network" ID is available}
    if (GUID1.Data4[2] = GUID2.Data4[2]) and
       (GUID1.Data4[3] = GUID2.Data4[3]) and
       (GUID1.Data4[4] = GUID2.Data4[4]) and
       (GUID1.Data4[5] = GUID2.Data4[5]) and
       (GUID1.Data4[6] = GUID2.Data4[6]) and
       (GUID1.Data4[7] = GUID2.Data4[7]) then
      UpdateTMD(Context, GUID1.Data4[2], 6);
  end;

  if midDrives in MachineInfo then begin
    {include drive specific information}
    for Drive := 2 {C} to 25 {Z} do begin
      if GetDriveType(Drive) = DRIVE_FIXED then begin
        FillChar(Buf, Sizeof(Buf), 0);
        Buf[0] := Drive;
        {!!.06} {removed cluster information}
        PLongInt(@Buf[1])^ := GetDiskSerialNumber(Chr(Drive+Ord('A')));{!!.06}
        UpdateTMD(Context, Buf, 5);
      end;
    end;
  end;

  FinalizeTMD(Context, Result, SizeOf(Result));
end;
{$ELSE}
function CreateMachineID(MachineInfo : TEsMachineInfoSet) : LongInt;
var
  I       : LongInt;
  RegKey  : DWord;
  GUID1   : TGUID;
  GUID2   : TGUID;
  Drive   : Integer;
  Context : TTMDContext;
  Buf     : array [0..2047] of Byte;
  iFileHandle : LongInt;
begin
  InitTMD(Context);

  {include user specific information}
  if midUser in MachineInfo then
  begin
   //[to do] find some organization specific info
  end;

  if midSystem in MachineInfo then
  begin
    {include system specific information}
    iFileHandle := FileOpen('/proc/cpuinfo', fmopenRead or fmShareDenyNone);
    I := FileRead(iFileHandle, Buf,2048);
    if I > 0 then  UpdateTMD(Context, Buf, I-1);
    FileClose(iFileHandle);


    iFileHandle := FileOpen('/proc/sys/kernel/version', fmopenRead or fmShareDenyNone);
    I := FileRead(iFileHandle, Buf, 2048);
    if I > 0 then  UpdateTMD(Context, Buf, I-1);
    FileClose(iFileHandle);



    iFileHandle := FileOpen('/proc/sys/kernel/osrelease', fmopenRead or fmShareDenyNone);
    I := FileRead(iFileHandle, Buf, 2048);
    if I > 0 then  UpdateTMD(Context, Buf, I-1);
    FileClose(iFileHandle);


    iFileHandle := FileOpen('/proc/sys/kernel/hostname', fmopenRead or fmShareDenyNone);
    I := FileRead(iFileHandle, Buf, 2048);
    if I > 0 then  UpdateTMD(Context, Buf, I-1);
    FileClose(iFileHandle);
  end;

  if midNetwork in MachineInfo then
  begin
    {include network ID}
    CreateGuid(GUID1);
    CreateGuid(GUID2);
    {check to see if "network" ID is available}
    if (GUID1.D4[2] = GUID2.D4[2]) and
       (GUID1.D4[3] = GUID2.D4[3]) and
       (GUID1.D4[4] = GUID2.D4[4]) and
       (GUID1.D4[5] = GUID2.D4[5]) and
       (GUID1.D4[6] = GUID2.D4[6]) and
       (GUID1.D4[7] = GUID2.D4[7]) then
      UpdateTMD(Context, GUID1.D4[2], 6);
  end;

  if midDrives in MachineInfo then
  begin
    {include drive specific information}
    for Drive := 2 {C} to 25 {Z} do begin
      if GetDriveType(Drive) = 3 {DRIVE_FIXED} then begin
        FillChar(Buf, Sizeof(Buf), 0);
        Buf[0] := Drive;
        {!!.06} {removed cluster information}
        PLongInt(@Buf[1])^ := GetDiskSerialNumber(Chr(Drive+Ord('A')));{!!.06}
        UpdateTMD(Context, Buf, 5);
      end;
    end;
  end;

  FinalizeTMD(Context, Result, SizeOf(Result));
end;
{$ENDIF}
{$ENDIF}

{key generation routines }
procedure GenerateRandomKeyPrim(var Key; KeySize: Cardinal);
var
  Bytes : TByteArray absolute Key;
  I     : Integer;
begin
  Randomize;
  for I := 0 to KeySize - 1 do
    Bytes[I] := Random(256);
end;

procedure GenerateTMDKeyPrim(var Key; KeySize: Cardinal; const Str: string);
var
  I  : Integer;
  S2 : string;
begin
  {strip accented characters from the string}                          {!!.06}
  S2 := Str;                                                           {!!.06}
  for I := Length(S2) downto 1 do                                      {!!.06}
    if Ord(S2[I]) > 127 then                                           {!!.06}
      Delete(S2, I, 1);                                                {!!.06}

  HashTMD(Key, KeySize, S2[1], Length(S2));                            {!!.06}
end;

procedure GenerateMD5KeyPrim(var Key: TKey; const Str: string);
var
  D : TMD5Digest;
  I  : Integer;
  S2 : string;
begin
  {strip accented characters from the string}                          {!!.06}
  S2 := Str;                                                           {!!.06}
  for I := Length(S2) downto 1 do                                      {!!.06}
    if Ord(S2[I]) > 127 then                                           {!!.06}
      Delete(S2, I, 1);                                                {!!.06}

  D := MD5String(S2);                                     {!!.06}
  Key := TKey(D);
end;


{modifier routines}
function GenerateStringModifierPrim(const S : string) : LongInt;
var
  I   : Integer;                                                       {!!.06}
  Sig : array [0..4] of AnsiChar;
  S2  : string;                                                        {!!.06}
begin
  FillChar(Sig, SizeOf(Sig), 0);

  {strip accented characters from the string}                          {!!.06}
  S2 := S;                                                             {!!.06}
  for I := Length(S2) downto 1 do                                      {!!.06}
    if Ord(S2[I]) > 127 then                                           {!!.06}
      Delete(S2, I, 1);                                                {!!.06}

  StrPLCopy(Sig, AnsiUpperCase(S2), Min(4, Length(S2)));               {!!.06}
  Result := PLongInt(@Sig[0])^;
end;

function GenerateUniqueModifierPrim : LongInt;
var
  ID : TGUID;
begin
  CreateGuid(ID);
  Mix128(T128Bit(ID));
  Result := T128Bit(ID)[3];
end;

{!!.05} {revised}
function GenerateMachineModifierPrim : LongInt;
begin
  Result := CreateMachineID([midUser, midSystem, {midNetwork,} midDrives]);
end;

function GenerateDateModifierPrim(D : TDateTime) : LongInt;
begin
  Result := Trunc(D);
  TLongIntRec(Result).Hi := TLongIntRec(Result).Lo xor $AAAA;
end;

procedure ApplyModifierToKeyPrim(Modifier : LongInt; var Key; KeySize : Cardinal);
begin
  if Modifier <> 0 then
    XorMem(Key, Modifier, Min(SizeOf(Modifier), KeySize));
end;
{$ENDIF}

{*** TogCodeBase ***}

constructor TOgCodeBase.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FAutoCheck := DefAutoCheck;
  FStoreCode := DefStoreCode;
  FStoreModifier := DefStoreModifier;

end;

procedure TOgCodeBase.DoOnChecked(Value : TCodeStatus);
begin
  if Assigned(FOnChecked) then
    FOnChecked(Self, Value)
  else if FAutoCheck then
    raise EOnGuardException.CreateFmt(SCNoOnCheck, [Self.ClassName]);
end;

function TOgCodeBase.DoOnGetCode : TCode;
begin
  FillChar(Result, SizeOf(Result), 0);
  if FStoreCode then
    Result := FCode
  else begin
    if Assigned(FOnGetCode) then
      FOnGetCode(Self, Result)
    else
      raise EOnGuardException.CreateFmt(SCNoOnGetCode, [Self.ClassName]);
  end;

  {store code for easy access using the Code property}                 {!!.02}
  FCode := Result;                                                     {!!.02}
end;

procedure TOgCodeBase.DoOnGetKey(var Key : TKey);
begin
  FillChar(Key, SizeOf(TKey), 0);
  if Assigned(FOnGetKey) then
    FOnGetKey(Self, Key)
  else
    raise EOnGuardException.CreateFmt(SCNoOnGetKey, [Self.ClassName]);
end;

{!!.02} {revised}
function TOgCodeBase.DoOnGetModifier : LongInt;
var
  L : LongInt;
begin
  Result := 0;
  if FStoreModifier then
    Result := FModifier
  else if Assigned(FOnGetModifier) then begin
    FOnGetModifier(Self, L);
    if FStoreModifier then begin
      {byte and word swap the modifier}
      TLongIntRec(Result).HiHi := TLongIntRec(L).LoLo;
      TLongIntRec(Result).HiLo := TLongIntRec(L).LoHi;
      TLongIntRec(Result).LoHi := TLongIntRec(L).HiLo;
      TLongIntRec(Result).LoLo := TLongIntRec(L).HiHi;
    end else
      Result := L;
  end;

  {store modifier for easy access using the Modifier property}         {!!.02}
  FModifier := Result;                                                 {!!.02}
end;

function TOgCodeBase.GetCode : string;
var
  Work : TCode;
begin
  Result := '$' + BufferToHex(FCode, SizeOf(FCode));
  if not HexToBuffer(Result, Work, SizeOf(Work)) then
    Result := '';

  if HexStringIsZero(Result) then
    Result := '';
end;

function TOgCodeBase.GetModifier : string;
var
  Work : LongInt;
begin
  Result := '$' + BufferToHex(FModifier, SizeOf(FModifier));
  if not HexToBuffer(Result, Work, SizeOf(Work)) then
    Result := '';

  if HexStringIsZero(Result) then
    Result := '';
end;

function TOgCodeBase.GetAbout : string;                              {!!.08}
begin
  Result := OgVersionStr;
end;

function TOgCodeBase.IsCodeValid : Boolean;
begin
  Result := (CheckCode(False) = ogValidCode);
end;

procedure TOgCodeBase.Loaded;
begin
  inherited Loaded;

  if FAutoCheck and not (csDesigning in ComponentState) then
    CheckCode(True);
end;

procedure TOgCodeBase.SetCode(const Value : string);
begin
  if not HexToBuffer(Value, FCode, SizeOf(FCode)) then
    FillChar(FCode, SizeOf(FCode), 0);
end;

procedure TOgCodeBase.SetModifier(const Value : string);
begin
  if not HexToBuffer(Value, FModifier, SizeOf(FModifier)) then
    FModifier := 0;
end;

procedure TOgCodeBase.SetAbout(const Value : string);                {!!.08}
begin
end;


{*** TOgDateCode ***}

function TOgDateCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  Result := ogValidCode;

  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  if IsDateCodeValid(Key, ACode) then begin
    if IsDateCodeExpired(Key, ACode) then
      Result := ogPastEndDate;
  end else
  begin
    Result := ogInvalidCode;
    if GetInvalidCountValue(Key,ACode)=1 then Result := ogCodeExpired;
  end;


  if Report then
    DoOnChecked(Result);
end;

function TOgDateCode.GetValue : TDateTime;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetDateCodeValue(Key, ACode);
end;

function TOgDateCode.GetInvalidCount: LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetInvalidCountValue(Key, ACode);
end;


{*** TOgDaysCode ***}

function TOgDaysCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  Result := ogValidCode;

  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  if IsDaysCodeValid(Key, ACode) then begin
    if IsDaysCodeExpired(Key, ACode) then begin
      Result := ogDayCountUsed;
      if GetExpirationDate(Key, ACode) < Date then
        Result := ogCodeExpired;
    end;
  end else
  begin
    Result := ogInvalidCode;
    if GetInvalidCountValue(Key,ACode)=1 then Result := ogCodeExpired;
  end;



  if Report then
    DoOnChecked(Result);
end;

constructor TOgDaysCode.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FAutoDecrease := DefAutoDecrease;
end;

procedure TOgDaysCode.Decrease;
var
  ACode     : TCode;
  Work     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  Work := ACode;
  AModifier := DoOnGetModifier;
  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));

  {code is only decreased once per day - no matter how many times called}
  DecDaysCode(Key, Work);

  {save code if it was changed}
  if (Work.CheckValue <> ACode.CheckValue) or (Work.Days <> ACode.Days) then
    DoOnChangeCode(Work);
end;

procedure TOgDaysCode.DoOnChangeCode(Value : TCode);
begin
  if Assigned(FOnChangeCode) then
    FOnChangeCode(Self, Value)
  else
    raise EOnGuardException.CreateFmt(SCNoOnChangeCode, [Self.ClassName]);
end;

function TOgDaysCode.GetValue : LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetDaysCodeValue(Key, ACode);
end;


function TOgDaysCode.GetInvalidCount : LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetInvalidCountValue(Key, ACode);
end;


procedure TOgDaysCode.Loaded;
begin
  inherited Loaded;

  if FAutoDecrease and not (csDesigning in ComponentState) then
    Decrease;
end;


{*** TOgMakeCodes ***}

constructor TOgMakeCodes.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FCodeType := DefCodeType;
  FShowHints := False;
end;

function TOgMakeCodes.Execute : Boolean;
{$IFNDEF NoMakeCodesSupport}                                         {!!.10}
var
  F : TCodeGenerateFrm;
{$ENDIF}                                                             {!!.10}
begin
{$IFNDEF NoMakeCodesSupport}                                         {!!.10}
  F := TCodeGenerateFrm.Create(Owner);
  try
    F.CodeType := FCodeType;
    F.SetKey(FKey);                                                  {!!.08}
    F.KeyType := FKeyType;
    F.KeyFileName := FKeyFileName;
    F.ShowHint := FShowHints;
    Result := F.ShowModal = mrOK;
    if Result then begin
      FCode := F.Code;
      F.GetKey(FKey);                                                {!!.08}
      FKeyType := F.KeyType;
      FKeyFileName := F.KeyFileName;
    end;
  finally
    F.Free;
  end;
{$ELSE}                                                              {!!.10}
  Result := False;                                                   {!!.10}
{$ENDIF}                                                             {!!.10}
end;

function TOgMakeCodes.GetAbout : string;                             {!!.08}
begin
  Result := OgVersionStr;
end;

procedure TOgMakeCodes.SetAbout(const Value : string);               {!!.08}
begin
end;

procedure TOgMakeCodes.GetCode(var Value : TCode);                   {!!.08}
begin
  Value := FCode;
end;

procedure TOgMakeCodes.SetCode(Value : TCode);                       {!!.08}
begin
  FCode := Value;
end;

procedure TOgMakeCodes.GetKey(var Value : TKey);                     {!!.08}
begin
  Value := FKey;
end;

procedure TOgMakeCodes.SetKey(Value : TKey);                         {!!.08}
begin
  FKey := Value;
end;


{*** TOgMakeKeys ***}

constructor TOgMakeKeys.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FKeyType := DefKeyType;
  FShowHints := False;
end;

function TOgMakeKeys.Execute : Boolean;
{$IFNDEF NoMakeCodesSupport}                                         {!!.10}
var
  F : TKeyMaintFrm;
{$ENDIF}                                                             {!!.10}
begin
{$IFNDEF NoMakeCodesSupport}                                         {!!.10}
  F := TKeyMaintFrm.Create(Owner);
  try
    F.SetKey(FKey);                                                  {!!.08}
    F.KeyType := FKeyType;
    F.KeyFileName := FKeyFileName;
    F.ShowHint := FShowHints;
    Result := F.ShowModal = mrOK;
    if Result then begin
      F.GetKey(FKey);                                                {!!.08}
      FKeyType := F.KeyType;                                       
      FKeyFileName := F.KeyFileName;
    end;
  finally
    F.Free;
  end;
{$ELSE}                                                              {!!.10}
  Result := False;                                                   {!!.10}
{$ENDIF}                                                             {!!.10}
end;

procedure TOgMakeKeys.ApplyModifierToKey(Modifier : LongInt; var Key; KeySize : Cardinal);
begin
  ApplyModifierToKeyPrim(Modifier, Key, KeySize);
end;

function TOgMakeKeys.GenerateDateModifier(D : TDateTime) : LongInt;
begin
  Result := GenerateDateModifierPrim(D);
end;

function TOgMakeKeys.GenerateMachineModifier : LongInt;
begin
  Result := GenerateMachineModifierPrim;
end;

procedure TOgMakeKeys.GenerateMDKey(var Key; KeySize : Cardinal; const Str : string);
begin
  GenerateTMDKeyPrim(Key, KeySize, Str);
end;

procedure TOgMakeKeys.GenerateRandomKey(var Key; KeySize : Cardinal);
begin
  GenerateRandomKeyPrim(Key, KeySize);
end;

function TOgMakeKeys.GenerateUniqueModifier : LongInt;
begin
  Result := GenerateUniqueModifierPrim;
end;

function TOgMakeKeys.GenerateStringModifier(const S : string) : LongInt;
begin
  Result := GenerateStringModifierPrim(S);
end;

function TOgMakeKeys.GetAbout : string;                              {!!.08}
begin
  Result := OgVersionStr;
end;

procedure TOgMakeKeys.SetAbout(const Value : string);                {!!.08}
begin
end;

procedure TOgMakeKeys.GetKey(var Value : TKey);                      {!!.08}
begin
  Value := FKey;
end;

procedure TOgMakeKeys.SetKey(Value : TKey);                          {!!.08}
begin
  FKey := Value;
end;


{*** TOgRegistrationCode ***}

function TOgRegistrationCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
  {RegStr   : string;}                                                 {!!.02}
begin
  Result := ogValidCode;

  FRegString := DoOnGetRegString;                                      {!!.02}
  DoOnGetKey(Key);
  ACode       := DoOnGetCode;
  AModifier   := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  if not IsRegCodeValid(Key, ACode) then
    Result := ogInvalidCode
  else if GetExpirationDate(Key, ACode) < Date then
    Result := ogCodeExpired;

  if Report then
    DoOnChecked(Result);
end;

constructor TOgRegistrationCode.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FRegString := '';
  FStoreRegString := DefStoreRegString;
end;

function TOgRegistrationCode.DoOnGetRegString : string;
begin
  Result := '';
  if FStoreRegString then
    Result := FRegString
  else if Assigned(FOnGetRegString) then
    FOnGetRegString(Self, Result)
end;


{*** TOgSerialNumberCode ***}

function TOgSerialNumberCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  Result := ogValidCode;

  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  if not IsSerialNumberCodeValid(Key, ACode) then
    Result := ogInvalidCode
  else if GetExpirationDate(Key, ACode) < Date then
    Result := ogCodeExpired;

  if Report then
    DoOnChecked(Result);
end;

function TOgSerialNumberCode.GetValue : LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetSerialNumberCodeValue(Key, ACode);
end;


{*** TOgSpecialCode ***}

function TOgSpecialCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  Result := ogValidCode;

  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  if not IsSpecialCodeValid(Key, ACode) then
    Result := ogInvalidCode
  else if GetExpirationDate(Key, ACode) < Date then
    Result := ogCodeExpired;

  if Report then
    DoOnChecked(Result);
end;

function TOgSpecialCode.GetValue : LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetSpecialCodeValue(Key, ACode);
end;


{*** TOgUsageCode ***}

function TOgUsageCode.CheckCode(Report : Boolean) : TCodeStatus;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  Result := ogValidCode;

  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;
  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));

  if IsUsageCodeValid(Key, ACode) then begin
    if IsUsageCodeExpired(Key, ACode) then begin
      Result := ogRunCountUsed;
      if GetExpirationDate(Key, ACode) < Date then
        Result := ogCodeExpired;
    end;
  end else
  begin
    Result := ogInvalidCode;
    if GetInvalidCountValue(Key,ACode)=1 then Result := ogCodeExpired;
  end;



  if Report then
    DoOnChecked(Result);
end;

constructor TOgUsageCode.Create(AOwner : TComponent);
begin
  inherited Create(AOwner);

  FAutoDecrease := DefAutoDecrease;
end;

procedure TOgUsageCode.Decrease;
var
  ACode     : TCode;
  Work     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  Work := ACode;
  AModifier := DoOnGetModifier;
  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));

  {code is decreased each time this routine is called}
  DecUsageCode(Key, Work);
  {save the changed code}
  DoOnChangeCode(Work);
end;

procedure TOgUsageCode.DoOnChangeCode(Value : TCode);
begin
  if Assigned(FOnChangeCode) then
    FOnChangeCode(Self, Value)
  else
    raise EOnGuardException.CreateFmt(SCNoOnChangeCode, [Self.ClassName]);
end;

function TOgUsageCode.GetValue : LongInt;
var
  ACode     : TCode;
  Key      : TKey;
  AModifier : LongInt;
begin
  DoOnGetKey(Key);
  ACode := DoOnGetCode;
  AModifier := DoOnGetModifier;

  ApplyModifierToKeyPrim(AModifier, Key, SizeOf(Key));
  Result := GetUsageCodeValue(Key, ACode);
end;

procedure TOgUsageCode.Loaded;
begin
  inherited Loaded;

  if FAutoDecrease and not (csDesigning in ComponentState) then
    Decrease;
end;

{$IFNDEF IBO_CONSOLE}
{*** general routines ***}

procedure DecInvalidCountCode(const Key : TKey; var Code : TCode);
begin
  MixBlock(T128bit(Key), Code, False);
  if Code.InvalidCount > 0 then  Code.InvalidCount := Code.InvalidCount - 1;
  MixBlock(T128bit(Key), Code, True);
end;


function GetInvalidCountValue(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Result := 0;
  if Code.CheckValue<>0 then
  begin
   Work := Code;
   MixBlock(T128bit(Key), Work, False);
   Result := Work.InvalidCount;
  end;
end;


function GetCodeType(const Key : TKey; const Code : TCode) : TCodeType;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  case Work.CheckValue of
    DateCheckCode    : Result := ctDate;
    DaysCheckCode    : Result := ctDays;
    RegCheckCode     : Result := ctRegistration;
    SerialCheckCode  : Result := ctSerialNumber;
    UsageCheckCode   : Result := ctUsage;
    NetCheckCode     : Result := ctNetwork;
    SpecialCheckCode : Result := ctSpecial;
  else
    Result := ctUnknown;
  end;
end;

function ExpandDate(D : Word) : TDateTime;
begin
  if D > 0 then
    Result := LongInt(D) + BaseDate
  else
    Result := EncodeDate(9999, 1, 1);
end;

function ShrinkDate(D : TDateTime) : Word;
begin
  if (Trunc(D) = 0) or (Trunc(D) - BaseDate > High(Word)) then
    Result := 0
  else
    Result := Trunc(D) - BaseDate;
end;

function GetExpirationDate(const Key : TKey; const Code : TCode) : TDateTime;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  case Work.CheckValue of
    DateCheckCode    : Result := ExpandDate(Work.EndDate);
    DaysCheckCode    : Result := ExpandDate(Work.Expiration);
    RegCheckCode     : Result := ExpandDate(Work.Expiration);
    SerialCheckCode  : Result := ExpandDate(Work.Expiration);
    UsageCheckCode   : Result := ExpandDate(Work.Expiration);
    SpecialCheckCode : Result := ExpandDate(Work.Expiration);
  else
    Result := ExpandDate(0)
  end;
end;

{*** date code ***}

procedure InitDateCode(const Key : TKey;
          StartDate, EndDate : TDateTime; var Code : TCode;InvalidCount : Word=0);
begin
  Code.CheckValue := DateCheckCode;
  Code.Expiration := 0; {not used for date codes}
  Code.FirstDate := ShrinkDate(StartDate);
  Code.EndDate := ShrinkDate(EndDate);
  Code.InvalidCount := InvalidCount;
  MixBlock(T128bit(Key), Code, True);
end;

function IsDateCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = DateCheckCode) and
            (ExpandDate(Work.FirstDate) <= Date);
end;

function GetDateCodeValue(const Key : TKey; const Code : TCode) : TDateTime;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  {return the end date}
  if (Work.CheckValue = DateCheckCode) and
     (ExpandDate(Work.FirstDate) <= Date) then
    Result := ExpandDate(Work.EndDate)
  else
    Result := 0;
end;

function IsDateCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
begin
  Result := (GetDateCodeValue(Key, Code) < Date);
end;


{*** days code ***}

procedure InitDaysCode(const Key : TKey; Days : Word; Expires : TDateTime;
                       var Code : TCode;InvalidCount : Word=0);
begin
  Code.CheckValue := DaysCheckCode;
  Code.Expiration := ShrinkDate(Expires);
  Code.Days := Days;
  Code.LastAccess := ShrinkDate(Date);
  Code.InvalidCount := InvalidCount;
  MixBlock(T128bit(Key), Code, True);
end;

function IsDaysCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = DaysCheckCode) and
            (ExpandDate(Work.LastAccess) <= Date);
  if (not Result) and (Work.InvalidCount >0) then Result := true;
end;

procedure DecDaysCode(const Key : TKey; var Code : TCode);
var
  X : LongInt;
  Valid : Boolean;
begin
  MixBlock(T128bit(Key), Code, False);
  Valid := (Code.CheckValue = DaysCheckCode) and
            (ExpandDate(Code.LastAccess) <= Date);

  X := ShrinkDate(Date);
  if (Code.LastAccess <> X) then begin
    if Code.Days > 0 then                                              {!!.02}
      Code.Days := Max(0, Code.Days - 1);                              {!!.02}
    Code.LastAccess := X;
  end;
  if (not Valid) and (Code.InvalidCount>0) then
   Code.InvalidCount := Code.InvalidCount-1;
  MixBlock(T128bit(Key), Code, True);
end;

function GetDaysCodeValue(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  if (Work.CheckValue = DaysCheckCode) and
     (ExpandDate(Work.LastAccess) <= Date) then
    Result := Work.Days
  else
  begin
    Result := 0;
    if Work.InvalidCount>0 then Result := Work.Days;
  end;
end;



function IsDaysCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.Days = 0) or (ExpandDate(Work.Expiration) < Date);
end;


{*** registration code ***}

procedure InitRegCode(const Key : TKey; const RegStr : string; Expires : TDateTime; var Code : TCode);
var
  S : string;                                                          {!!.06}
  I : Integer;                                                         {!!.06}
begin
  Code.CheckValue := RegCheckCode;
  Code.Expiration := ShrinkDate(Expires);
  {strip accented characters from the registration string}             {!!.06}
  S := RegStr;                                                         {!!.06}
  for I := Length(S) downto 1 do                                       {!!.06}
    if Ord(S[I]) > 127 then                                            {!!.06}
      Delete(S, I, 1);                                                 {!!.06}
  Code.RegString := StringHashElf(AnsiUpperCase(S));                   {!!.06}
  MixBlock(T128bit(Key), Code, True);
end;

function IsRegCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = RegCheckCode);
end;

function IsRegCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := ExpandDate(Work.Expiration) < Date;
end;


{*** serial number code ***}

procedure InitSerialNumberCode(const Key : TKey; Serial : LongInt; Expires : TDateTime; var Code : TCode);
begin
  Code.CheckValue := SerialCheckCode;
  Code.Expiration := ShrinkDate(Expires);
  Code.SerialNumber := Serial;
  MixBlock(T128bit(Key), Code, True);
end;

function IsSerialNumberCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = SerialCheckCode);
end;

function GetSerialNumberCodeValue(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  if Work.CheckValue = SerialCheckCode then
    Result := Work.SerialNumber
  else
    Result := 0;
end;

function IsSerialNumberCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := ExpandDate(Work.Expiration) < Date;
end;


{*** special code ***}

procedure InitSpecialCode(const Key : TKey; Value : LongInt; Expires : TDateTime; var Code : TCode);
begin
  Code.CheckValue := SpecialCheckCode;
  Code.Expiration := ShrinkDate(Expires);
  Code.Value := Value;
  MixBlock(T128bit(Key), Code, True);
end;

function IsSpecialCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = SpecialCheckCode);
end;

function GetSpecialCodeValue(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  if Work.CheckValue = SpecialCheckCode then
    Result := Work.Value
  else
    Result := 0;
end;

function IsSpecialCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := ExpandDate(Work.Expiration) < Date;
end;


{*** usage code ***}

procedure InitUsageCode(const Key : TKey; Count : Word; Expires : TDateTime; var Code : TCode;InvalidCount : Word=0);
begin
  Code.CheckValue := UsageCheckCode;
  Code.Expiration := ShrinkDate(Expires);
  Code.UsageCount := Count;
  Code.LastChange := ShrinkDate(Date);                                 {!!.02}
  Code.InvalidCount := InvalidCount;
  MixBlock(T128bit(Key), Code, True);
end;

function IsUsageCodeValid(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.CheckValue = UsageCheckCode) and                     {!!.02}
            (ExpandDate(Work.LastChange) <= Date);                     {!!.02}
end;

procedure DecUsageCode(const Key : TKey; var Code : TCode);
var                                                                    {!!.02}
  D : Word;                                                            {!!.02}
begin
  MixBlock(T128bit(Key), Code, False);
  D := ShrinkDate(Date);                                               {!!.02}
  if Code.UsageCount > 0 then                                          {!!.02}
    Code.UsageCount := Max(0, Code.UsageCount - 1);                    {!!.02}
  if (Code.LastChange < D) then                                        {!!.02}
    Code.LastChange := D;                                              {!!.02}

  MixBlock(T128bit(Key), Code, True);
end;

function GetUsageCodeValue(const Key : TKey; const Code : TCode) : LongInt;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  if (Work.CheckValue = UsageCheckCode) and                            {!!.02}
     (ExpandDate(Work.LastChange) <= Date) then                        {!!.02}
    Result := Work.UsageCount                                          {!!.02}
  else
    Result := 0;
end;

function IsUsageCodeExpired(const Key : TKey; const Code : TCode) : Boolean;
var
  Work : TCode;
begin
  Work := Code;
  MixBlock(T128bit(Key), Work, False);
  Result := (Work.UsageCount = 0) or (ExpandDate(Work.Expiration) < Date);
end;
{$ENDIF}




initialization
  {record our baseline date}
  BaseDate := Trunc(EncodeDate(1996, 1, 1));

end.



