unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, XPMan, StdCtrls, ClipBrd;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
edName: TEdit;
edSerial: TEdit;
btnGen: TButton;
XPManifest1: TXPManifest;
btnCopy: TButton;
btnCopy2: TButton;
Label3: TLabel;
cbType: TComboBox;
procedure FormCreate(Sender: TObject);
procedure btnGenClick(Sender: TObject);
procedure btnCopyClick(Sender: TObject);
procedure btnCopy2Click(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
DCPsha1, DCPblowfish, DCPsha512, DCPidea;
function MakeKey(input: String; progIndex: integer): String;
var
s: String;
name: String;
head: String;
serial: String;
blowfish: TDCP_blowfish;
idea: TDCP_idea;
i, n: Integer;
salt: String;
function TronXau(a, b: String): String;
var
s: String;
i, j, m, n, l, k: integer;
begin
s := '';
m := length(a);
n := length(b);
l := m + n;
i := 1;
j := 1;
k := 1;
while k <= l do
begin
if i <= m then
begin
s := s + a[i];
i := i + 1;
k := k + 1;
end;
if j <= n then
begin
s := s + b[j];
j := j + 1;
k := k + 1;
end;
end;
Result := s;
end;
function SinhXau: String;
var
s: String;
i: integer;
begin
//ky tu thu 1 3 5 7 la ky tu ngau nhien
s := 'ABCDEFGH';
i := random(ord('Z') - ord('A') + 1);
s[1] := chr(ord('A') + i);
i := random(26);
s[3] := chr(ord('A') + i);
i := random(26);
s[5] := chr(ord('A') + i);
i := random(26);
s[7] := chr(ord('A') + i);
i := random(ord('Z') - ord('O') + 1);
s[2] := chr(ord('O') + i);
i := random(ord('Z') - ord('M') + 1);
s[4] := chr(ord('M') + i);
i := random(ord('Z') - ord('I') + 1);
s[6] := chr(ord('I') + i);
i := random(ord('Z') - ord('D') + 1);
s[8] := chr(ord('D') + i);
if (s[4] = 'M') and (s[8] = 'D') and (s[6] = 'I') and (s[2] = 'O') then
begin
s[2] := 'P';
end;
Result := s;
end;
function ChonXau(a: String; len: Integer): String;
var
s: String;
i, n, pos: Integer;
begin
n := length(a);
s := '';
pos := 0;
for i := 1 to n do
begin
if (a[i] <= 'Z') and (a[i] >= 'A') then
begin
s := s + a[i];
pos := pos + 1;
if pos = len then
begin
break;
end;
end;
end;
Result := s;
end;
begin
//68386 max view
//96332
//98332
case progIndex of
0:
salt := '96338';
1:
salt := '96332';
2:
salt := '68386';
3:
salt := '98332';
end;
head := SinhXau;
serial := head;
s := Concat('me4T6cBLV', head, 'CpCwxrvCJZ30pKLu8Svxjhnhut437glCpofVssnFeBh2G0ekUq4VcxFintMix52vL0iJNbdtWqHPyeumkDUC+4AaoSX+xpl56Esonk4=');
blowfish := TDCP_blowfish.Create(nil);
idea := TDCP_idea.Create(nil);
blowfish.InitStr(s, TDCP_sha1);
name := input;
name := Uppercase(name);
s := Concat(head, salt, TronXau(name, head));
idea.InitStr(s, TDCP_sha512);
s := TronXau(name, head);
s := blowfish.EncryptString(s);
s := idea.EncryptString(s);
s := ChonXau(s, 8);
serial := serial + s;
blowfish.InitStr('09232849248398340903834873297239340547237623242043324398489390309284343843223493299435', TDCP_sha512);
s := Concat(head, salt, TronXau(name, head));
idea.InitStr(s, TDCP_sha1);
n := ord(head[1]) - $32;
for i:= 1 to n + 1 do
begin
s := idea.EncryptString(TronXau(name, head));
end;
s := blowfish.EncryptString(s);
serial := serial + ChonXau(s, 4);
Insert('-', serial, 6);
Insert('-', serial, 12);
Insert('-', serial, 18);
Result := serial;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
key: String;
begin
Randomize;
cbType.Items.Add('FastStone Capture 9.0');
cbType.Items.Add('FastStone Image Viewer 7.2');
cbType.Items.Add('FastStone MaxView 3.3');
cbType.Items.Add('FastStone Photo Resizer 4.3');
cbType.ItemIndex := 0;
key := MakeKey(edName.Text, 0);
edSerial.Text := key;
end;
procedure TForm1.btnGenClick(Sender: TObject);
var
key: String;
name: String;
begin
name := edName.Text;
name := Trim(name);
if length(name) < 5 then
begin
ShowMessage('Name greater than 5 characters');
Exit;
end;
key := MakeKey(name, cbType.ItemIndex);
edSerial.Text := key;
end;
procedure TForm1.btnCopyClick(Sender: TObject);
begin
ClipBoard.AsText := edName.Text;
end;
procedure TForm1.btnCopy2Click(Sender: TObject);
begin
ClipBoard.AsText := edSerial.Text;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND, $F012, 0);
end;
end;
end.