COM/LicenceCode/STGenLIC.pas

(* ***** 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 SysTools
 *
 * 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):
 *
 * ***** END LICENSE BLOCK ***** *)

{NOTE: THIS UNIT IS NOT TO BE DISTRIBUTED}

unit STGenLIC;

interface

function GenerateHexString(const aSerialNumber : string) : string;

implementation            

uses
  Windows,
  SysUtils;

const
  MagicSeed = $6457;
  MagicHash = $5746;

var
  RandSeed : longint;

function RandomNumber : integer;
begin
  Result := ((RandSeed * 4561) + 51349) mod 243000;
  RandSeed := Result;
end;

function HashBKDR(const S : string; Lower, Upper : integer; StartValue : longint) : longint;
var
  i : integer;
begin
  Result := StartValue;
  for i := Lower to Upper do begin
    Result := (Result * 31) + ord(S[i]);
  end;
end;

function IsDigit(aCh : char) : boolean;
begin
  Result := ('0' <= aCh) and (aCh <= '9');
end;

procedure IncString(var S : string);
var
  Done : boolean;
  i    : integer;
begin
  i := 8;
  repeat
    Done := true;
    if (S[i] = '9') then
      S[i] := 'A'
    else if (S[i] = 'F') then begin
      S[i] := '0';
      dec(i);
      if (i <> 0) then
        Done := false;
    end
    else
      inc(S[i])
  until Done;
end;


function GenerateHexString(const aSerialNumber : string) : string;
var
  i : integer;
  SNHash    : longint;
  StartHash : longint;
  NextDigit : integer;
begin
  {validate the serial number}
  if (length(aSerialNumber) <> 6) then
    raise Exception.Create('GenerateHexString: serial number must be 6 digits');
  for i := 1 to 6 do
    if not IsDigit(aSerialNumber[i]) then
      raise Exception.Create('GenerateHexString: serial number not all digits');
  {calculate the serial number hash: this will give us an index
   between 0 and 9}
  SNHash := HashBKDR(aSerialNumber, 1, 6, 0);
  SNHash := (SNHash shr 5) mod 10;
  {calculate a hex string that matches the serial number}
  RandSeed := MagicSeed;
  StartHash := RandomNumber;
  for i := 0 to SNHash do
    StartHash := RandomNumber;
  {randomize}
  RandSeed := GetTickCount;
  {create a random hex string}
  SetLength(Result, 8);
  for i := 1 to 8 do begin
    NextDigit := (RandomNumber and $F000) shr 12;
    if NextDigit <= 9 then
      Result[i] := char(ord('0') + NextDigit)
    else
      Result[i] := char(ord('A') + NextDigit - 10)
  end;
  while true do begin
    if (HashBKDR(Result, 1, 8, StartHash) and $FFFF) = MagicHash then
      Exit;
    IncString(Result);
  end;
end;

end.
1	(* *** BEGIN LICENSE BLOCK ***
2	* Version: MPL 1.1
3	*
4	* The contents of this file are subject to the Mozilla Public License Version
5	* 1.1 (the "License"); you may not use this file except in compliance with
6	* the License. You may obtain a copy of the License at
7	* http://www.mozilla.org/MPL/
8	*
9	* Software distributed under the License is distributed on an "AS IS" basis,
10	* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
11	* for the specific language governing rights and limitations under the
12	* License.
13	*
14	* The Original Code is TurboPower SysTools
15	*
16	* The Initial Developer of the Original Code is
17	* TurboPower Software
18	*
19	* Portions created by the Initial Developer are Copyright (C) 1996-2002
20	* the Initial Developer. All Rights Reserved.
21	*
22	* Contributor(s):
23	*
24	* *** END LICENSE BLOCK *** *)
25
26	{NOTE: THIS UNIT IS NOT TO BE DISTRIBUTED}
27
28	unit STGenLIC;
29
30	interface
31
32	function GenerateHexString(const aSerialNumber : string) : string;
33
34	implementation
35
36	uses
37	Windows,
38	SysUtils;
39
40	const
41	MagicSeed = $6457;
42	MagicHash = $5746;
43
44	var
45	RandSeed : longint;
46
47	function RandomNumber : integer;
48	begin
49	Result := ((RandSeed * 4561) + 51349) mod 243000;
50	RandSeed := Result;
51	end;
52
53	function HashBKDR(const S : string; Lower, Upper : integer; StartValue : longint) : longint;
54	var
55	i : integer;
56	begin
57	Result := StartValue;
58	for i := Lower to Upper do begin
59	Result := (Result * 31) + ord(S[i]);
60	end;
61	end;
62
63	function IsDigit(aCh : char) : boolean;
64	begin
65	Result := ('0' <= aCh) and (aCh <= '9');
66	end;
67
68	procedure IncString(var S : string);
69	var
70	Done : boolean;
71	i : integer;
72	begin
73	i := 8;
74	repeat
75	Done := true;
76	if (S[i] = '9') then
77	S[i] := 'A'
78	else if (S[i] = 'F') then begin
79	S[i] := '0';
80	dec(i);
81	if (i <> 0) then
82	Done := false;
83	end
84	else
85	inc(S[i])
86	until Done;
87	end;
88
89
90	function GenerateHexString(const aSerialNumber : string) : string;
91	var
92	i : integer;
93	SNHash : longint;
94	StartHash : longint;
95	NextDigit : integer;
96	begin
97	{validate the serial number}
98	if (length(aSerialNumber) <> 6) then
99	raise Exception.Create('GenerateHexString: serial number must be 6 digits');
100	for i := 1 to 6 do
101	if not IsDigit(aSerialNumber[i]) then
102	raise Exception.Create('GenerateHexString: serial number not all digits');
103	{calculate the serial number hash: this will give us an index
104	between 0 and 9}
105	SNHash := HashBKDR(aSerialNumber, 1, 6, 0);
106	SNHash := (SNHash shr 5) mod 10;
107	{calculate a hex string that matches the serial number}
108	RandSeed := MagicSeed;
109	StartHash := RandomNumber;
110	for i := 0 to SNHash do
111	StartHash := RandomNumber;
112	{randomize}
113	RandSeed := GetTickCount;
114	{create a random hex string}
115	SetLength(Result, 8);
116	for i := 1 to 8 do begin
117	NextDigit := (RandomNumber and $F000) shr 12;
118	if NextDigit <= 9 then
119	Result[i] := char(ord('0') + NextDigit)
120	else
121	Result[i] := char(ord('A') + NextDigit - 10)
122	end;
123	while true do begin
124	if (HashBKDR(Result, 1, 8, StartHash) and $FFFF) = MagicHash then
125	Exit;
126	IncString(Result);
127	end;
128	end;
129
130	end.