动易2007就快发布了，把2006的算法公开吧，赚点人气，希望动易不要来找我 。

正在装载数据……

 unit Unit1;

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;

end.

本文来源：http://blog.csdn.net/soweb/archive/2007/08/10/1736475.aspx