paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
d6a99df706
lazarus-ccr/components/onguard/source/qonguard2.pas
brandysb eed17766fe - fixed obsolete TextHeight properties from lfm resources 
- initial support for InvalidCount , which allow to run program even if trial rules are broken (but only exactly set count)
- IDE serial number used instead of volume serial

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@921 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2009-07-28 13:17:46 +00:00

684 lines
20 KiB
ObjectPascal
Raw Blame History

(* ***** 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 ***** *)
{*********************************************************}
{* ONGUARD3.PAS 1.13 *}
{* Copyright (c) 1996-02 TurboPower Software Co *}
{* All rights reserved. *}
{*********************************************************}
{$I ONGUARD.INC}
unit qonguard2;
{-Code generation dialog}
interface
uses
//{$IFDEF MSWINDOWS} {AH.01}
// Windows,
// Messages, {AH.01}
//{$ENDIF} {AH.01}
//{$IFDEF UsingCLX} {AH.01}
// Types, {AH.01}
//{$ENDIF} {AH.01}
LCLIntf,
LResources,
//{$IFDEF LINUX} {AH.01}
// Libc, {AH.01}
//{$ENDIF} {AH.01}
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, ComCtrls,
ogconst,
ognetwrk,
ogutil,
onguard,
qonguard3; {AH.01}
(*
{$IFDEF MSWINDOWS} {AH.01}
const
OGM_CHECK = WM_USER + 100;
OGM_QUIT = WM_USER + 101;
{$ENDIF} {AH.01}
*)
type
{ TCodeGenerateFrm }
TCodeGenerateFrm = class(TForm)
OKBtn: TBitBtn;
CancelBtn: TBitBtn;
CodesNbk: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
TabSheet5: TTabSheet;
TabSheet6: TTabSheet;
TabSheet7: TTabSheet;
Label9: TLabel;
Label11: TLabel;
Label13: TLabel;
Label2: TLabel;
Label6: TLabel;
RegRandomBtn: TButton;
Label4: TLabel;
RegStrCopySb: TSpeedButton;
Label7: TLabel;
Label15: TLabel;
SerRandomBtn: TButton;
Label14: TLabel;
Label17: TLabel;
Label10: TLabel;
Label12: TLabel;
Label19: TLabel;
GroupBox1: TGroupBox;
NoModifierCb: TCheckBox;
MachineModifierCb: TCheckBox;
UniqueModifierCb: TCheckBox;
DateModifierCb: TCheckBox;
StringModifierCb: TCheckBox;
Label1: TLabel;
Label5: TLabel;
GenerateKeySb: TSpeedButton;
GroupBox2: TGroupBox;
GenerateBtn: TButton;
RegCodeCopySb: TSpeedButton;
ModDateEd: TEdit;
ModStringEd: TEdit;
ModifierEd: TEdit;
BlockKeyEd: TEdit;
RegCodeEd: TEdit;
StartDateEd: TEdit;
EndDateEd: TEdit;
DaysCountEd: TEdit;
DaysExpiresEd: TEdit;
RegStrEd: TEdit;
RegExpiresEd: TEdit;
SerialNumberEd: TEdit;
SerialExpiresEd: TEdit;
UsageCountEd: TEdit;
UsageExpiresEd: TEdit;
NetworkSlotsEd: TEdit;
SpecialDataEd: TEdit;
SpecialExpiresEd: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure GenerateBtnClick(Sender: TObject);
procedure InfoChanged(Sender: TObject);
procedure RegCodeCopySbClick(Sender: TObject);
procedure ParametersChanged(Sender: TObject);
procedure ModifierEdKeyPress(Sender: TObject; var Key: Char);
procedure ModifierClick(Sender: TObject);
procedure DateEdKeyPress(Sender: TObject; var Key: Char);
procedure GenerateKeySbClick(Sender: TObject);
procedure NumberKeyEdPress(Sender: TObject; var Key: Char);
procedure RegStrCopySbClick(Sender: TObject);
procedure RegRandomBtnClick(Sender: TObject);
procedure CodesNbkChanging(Sender: TObject;
var AllowChange: Boolean);
procedure SerRandomBtnClick(Sender: TObject);
private
{ Private declarations }
FCode : TCode;
FCodeType : TCodeType;
FKey : TKey;
FKeyType : TKeyType;
FKeyFileName : string;
(*
{$IFDEF MSWINDOWS} {AH.01}
procedure OGMCheck(var Msg : TMessage);
message OGM_CHECK;
procedure OGMQuit(var Msg : TMessage);
message OGM_QUIT;
{$ELSE} {AH.01}
*)
procedure OGMCheck; {AH.01}
procedure OGMQuit; {AH.01}
//{$ENDIF} {AH.01}
procedure SetCodeType(Value : TCodeType);
public
procedure SetKey(Value : TKey); {!!.08}
procedure GetKey(var Value : TKey); {!!.08}
property Code : TCode
read FCode;
property CodeType : TCodeType
read FCodeType
write SetCodeType;
property KeyFileName : string
read FKeyFileName
write FKeyFileName;
property KeyType : TKeyType
read FKeyType
write FKeyType;
end;
var
CodeGenerateFrm: TCodeGenerateFrm;
implementation
procedure TCodeGenerateFrm.FormCreate(Sender: TObject);
var
D : TDateTime;
begin
NoModifierCb.Checked := True;
CodesNbk.ActivePageIndex := Ord(FCodeType);
BlockKeyEd.Text := BufferToHex(FKey, SizeOf(FKey));
if HexStringIsZero(BlockKeyEd.Text)then
BlockKeyEd.Text := '';
{initialize date edits}
StartDateEd.Text := OgFormatDate(Date); {!!.09}
EndDateEd.Text := OgFormatDate(Date); {!!.09}
ModDateEd.Text := OgFormatDate(Date); {!!.09}
D := EncodeDate(9999,12,31);
UsageExpiresEd.Text := OgFormatDate(D); {!!.09}
SpecialExpiresEd.Text := OgFormatDate(D); {!!.09}
SerialExpiresEd.Text := OgFormatDate(D); {!!.09}
RegExpiresEd.Text := OgFormatDate(D); {!!.09}
DaysExpiresEd.Text := OgFormatDate(D); {!!.09}
NoModifierCb.Checked := True; {!!.11}
InfoChanged(Self);
end;
procedure TCodeGenerateFrm.FormShow(Sender: TObject);
begin
OGMCheck;
end;
procedure TCodeGenerateFrm.GenerateBtnClick(Sender: TObject);
var
I : LongInt;
Work : TCode;
K : TKey;
Modifier : LongInt;
D1, D2 : TDateTime;
begin
Modifier := 0;
if ((ModifierEd.Text = '') or HexToBuffer(ModifierEd.Text, Modifier, SizeOf(LongInt))) then begin
K := FKey;
ApplyModifierToKeyPrim(Modifier, K, SizeOf(K));
case CodesNbk.ActivePageIndex of
0 : begin
try
D1 := StrToDate(StartDateEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidStartDate);
StartDateEd.SetFocus;
Exit;
end else
raise;
end;
try
D2 := StrToDate(EndDateEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidStartDate);
EndDateEd.SetFocus;
Exit;
end else
raise;
end;
InitDateCode(K, Trunc(D1), Trunc(D2), FCode);
Work := FCode;
MixBlock(T128bit(K), Work, False);
{sanity check}
StartDateEd.Text := OgFormatDate(Work.FirstDate+BaseDate); {!!.09}
EndDateEd.Text := OgFormatDate(Work.EndDate+BaseDate); {!!.09}
end;
1 : begin
try
D1 := StrToDate(DaysExpiresEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidExDate);
DaysExpiresEd.SetFocus;
Exit;
end else
raise;
end;
InitDaysCode(K, StrToIntDef(DaysCountEd.Text, 0), D1, FCode);
end;
2 : begin
try
D1 := StrToDate(RegExpiresEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidExDate);
RegExpiresEd.SetFocus;
Exit;
end else
raise;
end;
InitRegCode(K, RegStrEd.Text, D1, FCode);
end;
3 : begin
try
D1 := StrToDate(SerialExpiresEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidExDate);
SerialExpiresEd.SetFocus;
Exit;
end else
raise;
end;
InitSerialNumberCode(K, StrToIntDef(SerialNumberEd.Text, 0), D1, FCode);
end;
4 : begin
try
D1 := StrToDate(UsageExpiresEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidExDate);
UsageExpiresEd.SetFocus;
Exit;
end else
raise;
end;
InitUsageCode(K, StrToIntDef(UsageCountEd.Text, 0), D1, FCode);
end;
5 : begin
I := StrToIntDef(NetworkSlotsEd.Text, 2);
if I < 1 then {!!.08}
I := 1; {!!.08}
NetworkSlotsEd.Text := IntToStr(I);
EncodeNAFCountCode(K, I, FCode);
end;
6 : begin
try
D1 := StrToDate(SpecialExpiresEd.Text);
except
on EConvertError do begin
ShowMessage(SCInvalidExDate);
SpecialExpiresEd.SetFocus;
Exit;
end else
raise;
end;
InitSpecialCode(K, StrToIntDef(SpecialDataEd.Text, 0), D1, FCode);
end;
end;
RegCodeEd.Text := BufferToHex(FCode, SizeOf(FCode));
end else
MessageDlg(SCInvalidKeyOrModifier, mtError, [mbOK], 0);
end;
procedure TCodeGenerateFrm.InfoChanged(Sender: TObject);
begin
// GenerateBtn.Enabled := HexToBuffer(BlockKeyEd.Text, FKey, SizeOf(FKey));
// OKBtn.Enabled := Length(RegCodeEd.Text) > 0;
end;
procedure TCodeGenerateFrm.RegCodeCopySbClick(Sender: TObject);
var
OldSelStart: Integer;
begin
if (RegCodeEd.SelLength > 0) then
RegCodeEd.CopyToClipboard
else begin
OldSelStart := RegCodeEd.SelStart;
RegCodeEd.SelStart := 0;
RegCodeEd.SelLength := MaxInt;
RegCodeEd.CopyToClipboard;
RegCodeEd.SelStart := OldSelStart;
RegCodeEd.SelLength := 0;
end;
end;
procedure TCodeGenerateFrm.ParametersChanged(Sender: TObject);
begin
RegCodeEd.Text := '';
end;
procedure TCodeGenerateFrm.ModifierEdKeyPress(Sender: TObject; var Key: Char);
const
CHexChars = ['$', 'A', 'B', 'C', 'D', 'E', 'F', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
begin
if (not (Key in CHexChars)) and (not (Key < #32)) then begin
Beep();
Key := #0;
end;
end;
procedure TCodeGenerateFrm.ModifierClick(Sender: TObject);
const
Busy : Boolean = False;
var
L : LongInt;
D : TDateTime;
S : string; {!!.11}
i : Integer; {!!.12}
begin
if Busy then
Exit;
{set busy flag so that setting "Checked" won't recurse}
Busy := True;
try
L := 0;
if (Sender = NoModifierCb) and NoModifierCb.Checked then begin
UniqueModifierCb.Checked := False;
MachineModifierCb.Checked := False;
DateModifierCb.Checked := False;
StringModifierCb.Checked := False; {!!.11}
ModifierEd.Color := clBtnFace; {!!.11}
ModifierEd.ReadOnly := True; {!!.11}
end else begin
NoModifierCb.Checked := False;
ModifierEd.Color := clWindow; {!!.11}
ModifierEd.ReadOnly := False; {!!.11}
end;
(*
if not UniqueModifierCb.Checked and
not MachineModifierCb.Checked and
not DateModifierCb.Checked and
not StringModifierCb.Checked and {!!.11}
(ModifierEd.Text = '') then begin {!!.11}
NoModifierCb.Checked := True;
ModifierEd.Color := clBtnFace; {!!.11}
ModifierEd.ReadOnly := True; {!!.11}
end;
*)
if MachineModifierCb.Checked then begin
if L = 0 then
L := GenerateMachineModifierPrim
else
L := L xor GenerateMachineModifierPrim;
end;
{set status of string field} {!!.11}
ModStringEd.Enabled := StringModifierCb.Checked; {!!.11}
if ModStringEd.Enabled then {!!.11}
ModStringEd.Color := clWindow {!!.11}
else {!!.11}
ModStringEd.Color := clBtnFace; {!!.11}
{!!.11}
if StringModifierCb.Checked then begin {!!.11}
S := ModStringEd.Text; {!!.11}
{strip accented characters from the string} {!!.12}
for i := Length(S) downto 1 do {!!.12}
if Ord(S[i]) > 127 then {!!.12}
Delete(S, i, 1); {!!.12}
L := StringHashELF(S); {!!.11}
end; {!!.11}
{set status of date field}
ModDateEd.Enabled := DateModifierCb.Checked;
if ModDateEd.Enabled then
ModDateEd.Color := clWindow
else
ModDateEd.Color := clBtnFace;
if DateModifierCb.Checked then begin
try
D := StrToDate(ModDateEd.Text);
except
{ignore errors and don't generate modifier}
D := 0;
end;
if Trunc(D) <> 0 then begin
if L = 0 then
L := GenerateDateModifierPrim(D)
else
L := L xor GenerateDateModifierPrim(D);
end;
end;
if UniqueModifierCb.Checked then begin
if L = 0 then
L := GenerateUniqueModifierPrim
else
L := L xor GenerateUniqueModifierPrim;
end;
if L = 0 then
ModifierEd.Text := ''
else
ModifierEd.Text := '$' + BufferToHex(L, 4);
finally
Busy := False;
end;
end;
procedure TCodeGenerateFrm.DateEdKeyPress(Sender: TObject; var Key: Char);
begin
if (not (Key in ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', DateSeparator])) and (not (Key < #32)) then begin
Beep();
Key := #0;
end;
end;
procedure TCodeGenerateFrm.GenerateKeySbClick(Sender: TObject);
var
F : TKeyMaintFrm;
begin
F := TKeyMaintFrm.Create(Self);
try
F.SetKey(FKey);
F.KeyType := FKeyType;
F.KeyFileName := FKeyFileName;
F.ShowHint := ShowHint;
if F.ShowModal = mrOK then begin
F.GetKey(FKey);
BlockKeyEd.Text := BufferToHex(FKey, SizeOf(FKey));
if HexStringIsZero(BlockKeyEd.Text)then
BlockKeyEd.Text := '';
FKeyType := F.KeyType;
FKeyFileName := F.KeyFileName;
InfoChanged(Self);
end;
finally
F.Free;
end;
end;
procedure TCodeGenerateFrm.NumberKeyEdPress(Sender: TObject; var Key: Char);
const
CIntChars = ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9'];
begin
if (not (Key in CIntChars)) and (not (Key < #32)) then begin
Beep();
Key := #0;
end;
end;
procedure TCodeGenerateFrm.RegStrCopySbClick(Sender: TObject);
var
OldSelStart: Integer;
begin
if (RegStrEd.SelLength > 0) then
RegStrEd.CopyToClipboard
else begin
OldSelStart := RegStrEd.SelStart;
RegStrEd.SelStart := 0;
RegStrEd.SelLength := MaxInt;
RegStrEd.CopyToClipboard;
RegStrEd.SelStart := OldSelStart;
RegStrEd.SelLength := 0;
end;
end;
procedure TCodeGenerateFrm.RegRandomBtnClick(Sender: TObject);
var
I : Integer;
L : LongInt;
Bytes : array[0..3] of Byte absolute L;
begin
Randomize;
for I := 0 to 3 do
Bytes[I] := Random(256);
RegStrEd.Text := IntToHex(L, 8);
end;
procedure TCodeGenerateFrm.CodesNbkChanging(Sender: TObject;
var AllowChange: Boolean);
begin
AllowChange := True;
RegCodeEd.Text := '';
NoModifierCb.Checked := True;
ModifierEd.Text := '';
end;
procedure TCodeGenerateFrm.SerRandomBtnClick(Sender: TObject);
var
I : Integer;
L : LongInt;
Bytes : array[0..3] of Byte absolute L;
begin
Randomize;
for I := 0 to 3 do
Bytes[I] := Random(256);
SerialNumberEd.Text := IntToHex(L, 8);
end;
procedure TCodeGenerateFrm.GetKey(var Value : TKey);
begin
Value := FKey;
end;
(*
{$IFDEF MSWINDOWS} {AH.01}
procedure TCodeGenerateFrm.OGMQuit(var Msg : TMessage);
begin
ModalResult := mrCancel;
end;
{$ELSE} {AH.01}
*)
procedure TCodeGenerateFrm.OGMQuit; {AH.01}
begin
ModalResult := mrCancel;
end;
(*
{$IFDEF MSWINDOWS} {AH.01}
procedure TCodeGenerateFrm.OGMCheck(var Msg : TMessage);
var
F : TKeyMaintFrm;
begin
if not HexToBuffer(BlockKeyEd.Text, FKey, SizeOf(FKey)) then begin
{get a key}
F := TKeyMaintFrm.Create(Self);
try
F.SetKey(FKey);
F.KeyType := ktRandom;
F.KeyFileName := FKeyFileName;
F.ShowHint := ShowHint;
if F.ShowModal = mrOK then begin
F.GetKey(FKey);
BlockKeyEd.Text := BufferToHex(FKey, SizeOf(FKey));
if HexStringIsZero(BlockKeyEd.Text)then
BlockKeyEd.Text := '';
FKeyFileName := F.KeyFileName;
InfoChanged(Self);
end else
PostMessage(HWND(Handle), OGM_QUIT, 0, 0);
finally
F.Free;
end;
end;
end;
{$ELSE} {AH.01}
*)
procedure TCodeGenerateFrm.OGMCheck; {AH.01}
var
F : TKeyMaintFrm;
begin
if not HexToBuffer(BlockKeyEd.Text, FKey, SizeOf(FKey)) then begin
{get a key}
F := TKeyMaintFrm.Create(Self);
try
F.SetKey(FKey);
F.KeyType := ktRandom;
F.KeyFileName := FKeyFileName;
F.ShowHint := ShowHint;
if F.ShowModal = mrOK then begin
F.GetKey(FKey);
BlockKeyEd.Text := BufferToHex(FKey, SizeOf(FKey));
if HexStringIsZero(BlockKeyEd.Text)then
BlockKeyEd.Text := '';
FKeyFileName := F.KeyFileName;
InfoChanged(Self);
end else
OGMQuit;
finally
F.Free;
end;
end;
end;
procedure TCodeGenerateFrm.SetKey(Value : TKey);
begin
FKey := Value;
BlockKeyEd.Text := BufferToHex(FKey, SizeOf(FKey));
if HexStringIsZero(BlockKeyEd.Text)then
BlockKeyEd.Text := '';
end;
procedure TCodeGenerateFrm.SetCodeType(Value : TCodeType);
begin
if Value <> TCodeType(CodesNbk.ActivePageIndex) then begin
FCodeType := Value;
CodesNbk.ActivePageIndex := Ord(FCodeType);
end;
end;
initialization
{$I qonguard2.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink