//看到坛子里有人提出了CRC32加密算法，就发上这一贴吧：
//软件已经很老了，没有什么实用性。

//************************************************************************
//**************HappyEO电子琴3.0标准版算号器CRC32加密*********************
//************************************************************************     

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Label4: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure crc32gen;                      //无参数的过程说明:用来生成CRC32表
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
const
  reg='3456789BCDEFGHIJKLMNOPQRSTUVWXYZ012A';  //软件作者用来查表得到8位注册码的一个字串
type                              
  crc32=array[0..255] of longword; //字义数组,注意，得先定义它的类！CRC32表共有256个元素
implementation
  var crc33:crc32;                 //再定义全局变量
{$R *.dfm}
procedure Tform1.crc32gen;         //无参数的过程执行
var
i,j:integer;
crc:longword;
begin
for i:=low(crc32) to high(crc32) do
   begin
    crc:=i;
      for j:=0 to 7 do
         if (crc and 1)<>0 then     //因为Delphi不支持Integer作为Boolean所以这样处理
              crc:=(crc shr 1) xor $EDB88320
         else
              crc:=crc shr 1;
    crc33[i]:=crc;
   end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
crc32gen;                        //程序启动，生成CRC32表
end;

procedure TForm1.Button1Click(Sender: TObject);
  var
  name,email,regname:string;     //注册信息
  find:integer;                  //用来检查Email是否正确
  i:integer;
  oldcrc,temp,crc:longword;      //用来查CRC33的表
  regcode:string;                //注册码
begin
  regcode:='';
  name:=trim(edit1.Text);
  email:=trim(edit2.text);
  If Length(name) < 4 Then
  begin
    showmessage('注册名长度不能少于4！');
    edit1.SetFocus ;
    Exit;
  end;
  find:=pos('@',email);
  If (Length(email) < $C) Or (find=0) Then
  begin
    showmessage('合法的信箱长度不能少于12位，且有@字符！');
    edit2.SetFocus;
    exit;
  end;
  regname:=name+email;                      //注册名和信箱联接起来，用它进行CRC32运算
  oldcrc:=$FFFFFFFF;                        //初始化CRC ，所有CRC过程是参考OD出来的汇编码写出
  for i:=1 to length(regname) do
  begin
  temp:=(ord(regname[i]) xor (oldcrc and $FF))and $FF;   //生成用来查CRC32表的序数
  crc:=crc33[temp];                                      //查CRC32表
  oldcrc:=((oldcrc shr 8) and $FFFFFF) xor crc;
  end;
  oldcrc:=oldcrc xor $FFFFFFFF;               //得到CRC32的值！！！到这里，CRC32运算结束！

//以下与CRC无关，这是软件作者用来生成注册码的！
  for i:=1 to 8 do                  
  begin
  regcode:=regcode+reg[oldcrc mod $24+1];
  oldcrc:=oldcrc div 7;
  end;
  edit3.Text:=regcode;                //输出注册码
end;

end.
//**************************************************** //
// 真的很高兴，终于做成了CRC32的注册机！！
//为什么高兴呢？因为曾经想用VB制作CRC32，总是完不成任务！！！
// 因为Delphi7中有Longword型（可是64位无符号型哟！）
// 而且有移位指令shl,shr
// 2005-5-27
// by wofan[OCN]
//***************************************************** //

[培训]内核驱动高级班，冲击BAT一流互联网大厂工作，每周日13:00-18:00直播授课