鬼仔's Blog

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,MD5,BASE64,math,CLIPBRD, ExtCtrls,DateUtils;

type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
GroupBox1: TGroupBox;
ComboBox1: TComboBox;
Label4: TLabel;
ComboBox2: TComboBox;
Label3: TLabel;
ComboBox3: TComboBox;
Label5: TLabel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
RadioGroup1: TRadioGroup;
Image1: TImage;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
Procedure GenPE2006Key();
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
PublicKey=63169;
Modulus=43679;
Function Crypt(const pLngMessage, pLngKey:integer):Integer;
var
lLngMod,lLngResult,lLngIndex:integer;
begin
If pLngKey Mod 2 = 0 Then
begin

lLngResult := 1;
For lLngIndex := 1 To pLngKey div 2 do
begin
lLngMod := round(Power(pLngMessage , 2)) Mod Modulus;
// Mod may error on key generation
lLngResult := (lLngMod * lLngResult) Mod Modulus
end;
end
Else
begin
lLngResult := pLngMessage ;
For lLngIndex := 1 To pLngKey div 2 do
begin
lLngMod := round(Power(pLngMessage , 2)) Mod Modulus ;

// Mod may error on key generation
lLngResult := (lLngMod * lLngResult) Mod Modulus ;

end;
End;
Result := lLngResult ;
End;

Function Encode(const pStrMessage:String):String;
var
lLngIndex,lLngMaxIndex:Integer;
lBytAscii:Byte;
lLngEncrypted:Integer;
begin
Result := '';
lLngMaxIndex := Length(pStrMessage);
If lLngMaxIndex = 0 Then
Exit;
For lLngIndex := 1 To lLngMaxIndex do
begin
lBytAscii := Ord(pStrMessage[lLngIndex]);
lLngEncrypted := Crypt(lBytAscii, PublicKey);
Result := Result + IntToHex(lLngEncrypted, 4)
end;
End;

Procedure Gen2006Key(var st1:String; Const sSiteName,sYear,sVersion:String;iStr:Integer);
var
sSiteMD5,SA,sCRC:String;
i,k:Integer;
begin
SA:='';
sSiteMD5:= cMD5.UpperMD5(cBase64.StrToBase64(sSiteName)+ cBase64.StrToBase64(sVersion));

sCRC:=Encode(Trim(Copy(sSiteMD5,1,5)));
SA:=sSiteMD5+sSiteMD5+sYear+sCRC;

//填充散列
k:=iStr;
for i:=1 to Length(SA) do
begin
st1[k]:= SA[i];
k:= k+(i mod 9) +1;
end;

end;

procedure TForm1.GenPE2006Key;
const
sBase='123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz-=';
var
sSiteName,sYear:String;
SN:String;
st1,st2:String;

i:integer;

F1: TextFile;

begin

sSiteName:=Trim(Edit1.Text);

DateSeparator := '-';
ShortDateFormat := 'yyyy-mm-dd';

case RadioGroup1.ItemIndex of
0:sYear:=DateToStr(IncDay(Date,3));
1:sYear:=DateToStr(IncDay(Date,10));
2:sYear:=DateToStr(IncDay(Date,365));
3:sYear:=DateToStr(IncDay(Date,3650));
4:sYear:=Trim(Edit2.Text);
end;
sYear:= Trim(cBase64.StrToBase64(sYear));

Setlength(SN,4096);

//生成随机数
SetLength(st1,4064);
Randomize;
for i:=1 to Length(st1) do
st1[i]:= sBase[Random(63)+1];

if ComboBox1.ItemIndex >0 then
Gen2006Key(st1,sSiteName,sYear,'CMS'+intTostr(ComboBox1.ItemIndex),1);

if ComboBox2.ItemIndex >0 then
Gen2006Key(st1,sSiteName,sYear,'eShop'+intTostr(ComboBox2.ItemIndex),501);

if ComboBox3.ItemIndex >0 then
Gen2006Key(st1,sSiteName,sYear,'CRM'+intTostr(ComboBox3.ItemIndex),1001);

//供求
if CheckBox1.Checked then
Gen2006Key(st1,sSiteName,sYear,'SD',3001);

//房产
if CheckBox2.Checked then
Gen2006Key(st1,sSiteName,sYear,'House',3501);

//企业招聘
if CheckBox3.Checked then
Gen2006Key(st1,sSiteName,sYear,'HR',2501);

//室场登记
if CheckBox4.Checked then
Gen2006Key(st1,sSiteName,sYear,'Equipment',2001);

//学生学籍
if CheckBox5.Checked then
Gen2006Key(st1,sSiteName,sYear,'SDMS',1501);

st2:= cMD5.UpperMD5(st1);

//填充序列号
for i:=1 to 4000 do
SN[i]:= st1[i];
for i:=1 to Length(st2) do
SN[4000+i]:= st2[i];
for i:=1 to 64 do
SN[4032+i]:= st1[4000+i];

Clipboard.Astext := SN ;

AssignFile(F1, '['+sSiteName+']SN.txt');
Rewrite(F1);
Write(F1,SN);
CloseFile(F1);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GenPE2006Key();
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
RadioGroup1.Color := RGB(78,111,214);
GroupBox1.Color := RGB(78,111,214);
end;