100分求一段delphi注册码的生成代码，

网上一搜一箩筐附一段简单的吧
{-------------------------------------------------------------------------------
  过程名:    EncrypKey
  作者:      Administrator
  日期:      2008.05.21
  参数:      Src:String; Key:String
  返回值:    string
-------------------------------------------------------------------------------}
function EncrypKey (Src:String; Key:String):string;
var
  //idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  //TmpSrcAsc :Integer;
  Range :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then
    key:='objectsoft';
  KeyPos:=0;
  //SrcPos:=0;
  //SrcAsc:=0;
  Range:=256;
  Randomize;
  offset:=Random(Range);
  dest:=format('%1.2x',[offset]);
  for SrcPos := 1 to Length(Src) do
  begin
    SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
    if KeyPos < KeyLen then
      KeyPos:= KeyPos + 1
    else
      KeyPos:=1;
    SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
    dest:=dest + format('%1.2x',[SrcAsc]);
    offset:=SrcAsc;
  end;
  Result:=Dest;
end;
//解密字符串
{-------------------------------------------------------------------------------
  过程名:    UncrypKey
  作者:      Administrator
  日期:      2008.05.21
  参数:      Src:String; Key:String
  返回值:    string
-------------------------------------------------------------------------------}
function UncrypKey (Src:String; Key:String):string;
var
  //idx :integer;
  KeyLen :Integer;
  KeyPos :Integer;
  offset :Integer;
  dest :string;
  SrcPos :Integer;
  SrcAsc :Integer;
  TmpSrcAsc :Integer;
  //Range :Integer;
begin
  KeyLen:=Length(Key);
  if KeyLen = 0 then
    key:='objectsoft';
  KeyPos:=0;
  //SrcPos:=0;
  //SrcAsc:=0;
  //Range:=256;
  offset:=StrToInt('$'+ copy(src,1,2));
  SrcPos:=3;
  repeat
    SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
    if KeyPos < KeyLen Then
      KeyPos := KeyPos + 1
    else
      KeyPos := 1;
    TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
    if TmpSrcAsc <= offset then
      TmpSrcAsc := 255 + TmpSrcAsc - offset
    else
      TmpSrcAsc := TmpSrcAsc - offset;
    dest := dest + chr(TmpSrcAsc);
    offset:=srcAsc;
    SrcPos:=SrcPos + 2;
  until SrcPos >= Length(Src);
  Result:=Dest;
end;从网上你可以找到MD5的

……倒塌
加密的算法要自己写才好
给你一个MD5的
unit Unit1; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,PTools;
type
TForm1 = class(TForm)
edDM: TEdit;
edSNO: TEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
edSNO.Text := SNOEncode(edDM.Text);
end; end.

unit PTools; interface uses
SysUtils; type
TSpecials = set of Char; const SpecialChar: TSpecials =
['=', '(', ')', '[', ']', '<', '>', ':', ';', '.', ',', '@', '/', '?', '\',
'"', '_'];
URLFullSpecialChar: TSpecials =
[';', '/', '?', ':', '@', '=', '&amt;', '#'];
URLSpecialChar: TSpecials =
[#$00..#$20, '_', '<', '>', '"', '>', '{', '}', '|', '\', '^', '~', '[', ']',
'`', #$7F..#$FF];
TableBase64 =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/=';
TableUU =
'`!"#$>&amt;''()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
TableXX =
'+-0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz_';
ReTablebase64 =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$3E +#$40
+#$40 +#$40 +#$3F +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$01 +#$02 +#$03
+#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21
+#$22 +#$23 +#$24 +#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableUU =
#$01 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A +#$0B +#$0C
+#$0D +#$0E +#$0F +#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18
+#$19 +#$1A +#$1B +#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24
+#$25 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D +#$2E +#$2F +#$30
+#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39 +#$3A +#$3B +#$3C
+#$3D +#$3E +#$3F +#$00 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;
ReTableXX =
#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$00 +#$40
+#$01 +#$40 +#$40 +#$02 +#$03 +#$04 +#$05 +#$06 +#$07 +#$08 +#$09 +#$0A
+#$0B +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$40 +#$0C +#$0D +#$0E +#$0F
+#$10 +#$11 +#$12 +#$13 +#$14 +#$15 +#$16 +#$17 +#$18 +#$19 +#$1A +#$1B
+#$1C +#$1D +#$1E +#$1F +#$20 +#$21 +#$22 +#$23 +#$24 +#$25 +#$40 +#$40
+#$40 +#$40 +#$40 +#$40 +#$26 +#$27 +#$28 +#$29 +#$2A +#$2B +#$2C +#$2D
+#$2E +#$2F +#$30 +#$31 +#$32 +#$33 +#$34 +#$35 +#$36 +#$37 +#$38 +#$39
+#$3A +#$3B +#$3C +#$3D +#$3E +#$3F +#$40 +#$40 +#$40 +#$40 +#$40 +#$40;

算了，太多了，给个连接楼主自己看吧
http://www.programsalon.com/downloads40/sourcecode/delphi_control/detail141069.html
点击那个sno.rar，然后再文件列表里面找PAS文件
唯一不好的就是不能下载……

unit UnitSoftKeyClass;interface
uses
    SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms,
    Dialogs,IniFiles,StdCtrls, ExtCtrls, ComCtrls, Registry;
//******************************************************************************
//**********************自定义函数很过程****************************************
procedure SoftKey;
function ReadProductId  :String;
function ReadRegeditName:String;
function WomExecOutPro(const FileName: string; ExeType: Boolean): Boolean;
//******************************************************************************
var
    Product_Id   : String; //(操作系统)产品系列号
    RegeditName  : String; //注册用户名
//****************************************************************************//
implementationuses UnitkeyCryptClass, UnitSoftRegedit;function WomExecOutPro(const FileName: string; ExeType: Boolean): Boolean; //执行外部程序。ExeType:是否等待执行结束,True为一直等待
var
    sInfo: TStartupInfo;
    pInfo: TProcessInformation;
    TmpDWORD: DWORD;
begin
    FillChar(sInfo, sizeof(sInfo), #0);
    sInfo.cb := SizeOf(sInfo);
    sInfo.dwFlags := STARTF_USESHOWWINDOW;
    sInfo.wShowWindow := SW_NORMAL;
    try
        CreateProcess(nil, PChar(FileName), nil, nil, False, CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil, sInfo, pInfo);
        if ExeType = False then
        Result := True
        else
        begin
            waitforsingleobject(pInfo.hProcess, INFINITE);
            GetExitCodeProcess(pInfo.hProcess, TmpDWORD);
            CloseHandle(pInfo.hProcess);
            CloseHandle(pInfo.hThread);
            Result := True;
        end;
  except
        Result := False;
        Exit;
    end;
end;
//读注册表中系统产品序列号
function ReadProductId:String;
var
    Reg:TRegistry;
begin
    try
        Reg:=TRegistry.Create;
        Reg.RootKey:=HKEY_LOCAL_MACHINE;
        Reg.OpenKey('Software\Microsoft\Windows NT\CurrentVersion',False);
        Result:=Reg.ReadString('ProductId');
    except
        Application.MessageBox('读系统注册表失败！！','系统错误',MB_ICONERROR+MB_OK);
    end;
end;
function ReadRegeditName:String;
var
    re_id           : integer;
    Soft_UserName   : String;
    RegisterTemp    : TRegistry;
    inputstr,get_id : string;
    dy,clickedok    : boolean;
    Myini           : TiniFile;
    tempstr         : String;
begin
    dy:=false; //软件是否已到注册期、及是否允许继续使用的标志，当值为FALSE是为允许使用。
    registerTemp := TRegistry.Create; //准备使用注册表
    with registerTemp do
    begin
        RootKey:=HKEY_LOCAL_MACHINE; //存放在此根下
        if OpenKey('Software\Microsoft\Windows\CurrentVersion\LuerSoft',True) then
        // 建一目录，存放标志值。当然也可以存放在已存在的目录下。怎么样，很难发现吧？
        begin
            if valueexists('Regedit_UserName') then
            begin //用Regedit_UserName的值作为标志，首先判断其存在否？
                Soft_UserName:=RegisterTemp.ReadString('Regedit_UserName');//读出标志值
                Myini:=TIniFile.Create(ExtractFileDir(application.Exename)+'\SystemSet.ini');
                tempstr:=Myini.ReadString('SoftWareSet','RegeditName','');
                //034020008023//name
                tempstr:=Copy(tempstr,13,length(tempstr)-12);
                tempstr:=Encrypt(tempstr,'luersoft');
                if Trim(tempstr)<>Trim(Soft_UserName) then
                begin
                    WomExecOutPro(ExtractFilePath(Application.ExeName) + 'GD_SoftRegedit.exe', True);
                    Application.Terminate;
                end;
                if re_id=100 then dy:=true; //假如值已到100，则应注册。
            end
            else
            begin
                WomExecOutPro(ExtractFilePath(Application.ExeName) + 'GD_SoftRegedit.exe', True);
                Application.Terminate;
            end;
        end;
        if dy then
        begin //若dy值为TRUE，则应提示用户输入注册码，进行注册。
            Application.MessageBox('您使用的是非注册软件,请输入注册码：',Pchar(Application.Title),MB_ICONINFORMATION+MB_OK);
            WomExecOutPro(ExtractFilePath(Application.ExeName) + 'GD_SoftRegedit.exe', True);
            Application.Terminate;
        end;
    end;
end;
//****************************************************************************//
procedure SoftKey;
var
    re_id           : integer;
    registerTemp    : TRegistry;
    inputstr,get_id : string;
    dy,clickedok    : boolean;
begin
    dy:=false; //软件是否已到注册期、及是否允许继续使用的标志，当值为FALSE是为允许使用。
    registerTemp := TRegistry.Create; //准备使用注册表
    with registerTemp do
    begin
        RootKey:=HKEY_LOCAL_MACHINE; //存放在此根下
        if OpenKey('Software\Microsoft\Windows\CurrentVersion\LuerSoft',True) then
        // 建一目录，存放标志值。当然也可以存放在已存在的目录下。怎么样，很难发现吧？
        begin
            if valueexists('gc_id') then
            begin //用gc_id的值作为标志，首先判断其存在否？
                re_id:=readinteger('gc_id');//读出标志值
                if (re_id<>0) and (re_id<>100) then
                begin //若标志值为0，则说明已注册。
                    //若不为0且值不到100,说明虽未注册，但允许使用的次数尚未达到。
                    re_id:=re_id+5; //允许标志的最大值为100，每次加5，则最多只可用20次。
                    Writeinteger('gc_id',re_id);//将更新后的标志值写入注册表中。
                end;
                if re_id=100 then dy:=true; //假如值已到100，则应注册。
            end
            else Writeinteger('gc_id',5);//建立标志，并置初始标志值。
        end;
        if dy then
        begin //若dy值为TRUE，则应提示用户输入注册码，进行注册。
            clickedok:=InputQuery('您使用的是非注册软件,请输入注册码：',' ',inputstr);
            if clickedok then
            begin
                get_id:=inttostr(27593758*2);//注册码为55187516，当然可加入更杂的算法。
                if get_id=inputstr then
                begin
                    Writeinteger('gc_id',0);//若输入的注册码正确，则将标志值置为0,即已注册。
                    CloseKey;
                    Free;
                end
                else
                begin //若输入的注册码错误，应作出提示并拒绝让其继续使用
                    application.messagebox('注册码错误!请与作者联系!','警告框',mb_ok);
                    CloseKey;
                    Free;
                    application.terminate; //中止程序运行，拒绝让其继续使用
                end;
            end
            else
            begin //若用户不输入注册码，也应作出提示并拒绝让其继续使用
                application.messagebox('请与作者联系，使用注册软件!','警告框',mb_ok);
                CloseKey;
                Free;
                application.terminate;
            end;
        end;
    end;
end;end.
给你一个最简单的……

调试易

100分求一段delphi注册码的生成代码，

解决方案 »