84f9ba551c
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@923 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2232 lines
62 KiB
ObjectPascal
2232 lines
62 KiB
ObjectPascal
(* ***** 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.
|
|
|
|
|
|
|