unitsoftkeyclass.pas

delphi做的注册码验证程序

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; //注册用户名
//****************************************************************************//
implementation

uses 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.