DELPHI 注册表注册授权代码

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,Registry ; //Registry ;注册表的引用

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

procedure Button2Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

iTimes: Integer;//定义时间

procedure Reginfo;//查看注册信息

{ Private declarations }

public

function GetSN: TstringList; //得到序列号

{ Public declarations }

end;

var

G_IsOverTime: Boolean; //全局变量 是否超过试用期

Form1: TForm1;

implementation

uses Share,Reg;//引用单元Share,reg

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);

begin

Close;

end;

Procedure TFrmLogin.Reginfo;

var

LoginTimes: string;

TmpStr: string;

begin

//以下为判断是否注册过

TmpStr := Trim(GetSN.Strings[1]); //看注册表中是否有注册信息

if (TmpStr = Share.GetZCH(Trim(TmpList.Strings[0]))) and (TmpStr <> '') then //是正确的注册号

begin

if FrmMain.Caption <> '婚庆娱乐网（正式注册版）' then

begin

FrmMain.Caption := '婚庆娱乐网（正式注册版）';

end;

end

else //没有注册

begin

if FrmMain.Caption <> '婚庆娱乐网（试用版）' then

begin

FrmMain.Caption := '婚庆娱乐网（试用版）';

end;

LoginTimes := Share.GetLoginTimes; //得到剩余的登录次数

if (StrtoIntDef(LoginTimes, 0) >= 2) and (StrtoIntDef(LoginTimes, 0) <= 30) then

begin

LoginTimes := IntToStr(StrToInt(LoginTimes) - 1);

Application.MessageBox(Pchar('您还未注册，还可以使用本软件' + LoginTimes + '次！'), '提示', Mb_ok or Mb_IconInformation);

Share.WriteLoginTimes(LoginTimes); //把剩余次数写回注册表

end

else //试用次数到期了

begin

if StrToIntDef(LoginTimes, 0) = 1 then

begin

Application.MessageBox('软件已过试用期限,请注册！', '提示');

G_IsOverTime := True;

if Application.MessageBox('现在注册吗？', '提示', Mb_YesNo or Mb_IconQuestion) = IdYes then

begin

if not Assigned(FrmReg) then

begin

FrmReg := TFrmReg.Create(Self);

end;

FrmReg.ShowModal; //显示注册窗口

end

else

begin

Application.Terminate; //程序终止

end;

end;

end;

end;

end;

function TFrmLogin.GetSN: TstringList; //获取到注册表中的注册信息

var

MyReg: TRegistry;

sn, reg: string;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\Reg', True);

try

sn := MyReg.ReadString('sn');

reg := MyReg.ReadString('reg');

except

MyReg.WriteString('sn', '');

MyReg.WriteString('reg', '');

end;

TmpList.Add(sn);

TmpList.Add(reg);

Result := TmpList;

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

end.

---

unit Share;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,

StdCtrls, Registry;

function GetVolumeNumber: string; //得到硬盘卷标号

function GetZCH(sn: string): string; //生成注册号

procedure WriteReg(sn,reg : string); //写注册表

procedure WriteLoginTimes(LoginTimes: string); //回写登录次数

function GetLoginTimes: string; //得到登录次数

implementation

function GetVolumeNumber: string; //得到硬盘卷标号

var

VolumeSerialNumber: DWORD;

MaximumComponentLength: DWORD;

FileSystemFlags: DWORD;

SerialNumber: string;

begin

GetVolumeInformation('c:\', nil, 0, @VolumeSerialNumber, MaximumComponentLength, FileSystemFlags, nil, 0);

Result := inttohex(VolumeSerialNumber, 2);

end;

function GetZCH(sn: string): string; //生成注册号

var

TmpStr: string;

i: integer;

begin

TmpStr := Trim(sn);

for i := 1 to Length(TmpStr) do

begin

case TmpStr[i] of

'A': TmpStr[i] := '1';

'B': TmpStr[i] := '6';

'C': TmpStr[i] := 'F';

'D': TmpStr[i] := '8';

'E': TmpStr[i] := '6';

'F': TmpStr[i] := '7';

'1': TmpStr[i] := 'A';

'2': TmpStr[i] := '8';

'3': TmpStr[i] := 'E';

'4': TmpStr[i] := '6';

'5': TmpStr[i] := '5';

'6': TmpStr[i] := 'B';

'7': TmpStr[i] := '3';

'8': TmpStr[i] := 'C';

'9': TmpStr[i] := 'F';

end;

end;

Result := TmpStr;

end;

procedure WriteReg(sn,reg : string); //写注册表

var

MyReg: TRegistry;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\Reg', True);

MyReg.WriteString('sn', sn);

MyReg.WriteString('reg', reg);

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

procedure WriteLoginTimes(LoginTimes: string); //回写剩余登录次数到注册表

var

MyReg: TRegistry;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\LoginTimes', False);

MyReg.WriteString('LoginTimes', LoginTimes);

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

function GetLoginTimes: string; //获取注册表的登录次数

var

MyReg: TRegistry;

LoginTimes: string;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\LoginTimes', True);

LoginTimes := MyReg.ReadString('LoginTimes');

Result := LoginTimes;

if (LoginTimes = '') or (StrToIntDef(LoginTimes,0) > 30) then

begin

MyReg.WriteString('LoginTimes', '30');

LoginTimes := MyReg.ReadString('LoginTimes');

Result := LoginTimes;

end;

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

end.

----

unit Reg;

interface

uses

Registry;

type

TFrmReg = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Btn_Reg: TBitBtn;

Btn_Exit: TBitBtn;

procedure Btn_ExitClick(Sender: TObject);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Btn_RegClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure FormShow(Sender: TObject);

private

{ Private declarations }

public

TmpList: TStringlist;

function GetSN: TstringList; //得到序列号

{ Public declarations }

end;

var

FrmReg: TFrmReg;

implementation

uses Unit1,Share;

{$R *.dfm}

procedure TFrmReg.Btn_ExitClick(Sender: TObject);

begin

if G_IsOverTime then

begin

Application.Terminate;

end

else

begin

Self.Close;

end;

end;

procedure TFrmReg.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

if Edit2.Text <> '' then

begin

Btn_Reg.Click;

end;

end;

end;

procedure TFrmReg.Btn_RegClick(Sender: TObject);

begin

if Edit2.Text = '' then //没有输入注册号

begin

//Application.MessageBox('请输入注册号', '提示' Mb_ok or Mb_IconWarning);

Edit2.SetFocus;

Exit;

end;

if Trim(Edit2.Text) = Share.GetZCH(Edit1.Text) then //如果注册号正确

begin

Application.MessageBox('注册成功！','提示',Mb_ok or Mb_IconInformation);

Share.WriteReg(Edit1.Text,Edit2.Text); //把序列号，注册号写入注册表

Self.Close;

if TForm1.Caption <> '婚庆娱乐网（正式注册版）' then

begin

TForm1.Caption := '婚庆娱乐网（正式注册版）';

end;

if Application.MessageBox('请重新启动本软件以以使注册生效！','提示',Mb_ok or Mb_IconInformation)=IdOk then

begin

Application.Terminate;

end;

end

else //注册号不正确

begin

Application.MessageBox('注册失败！', '提示',Mb_ok or Mb_IconError);

if G_IsOverTime then //已超过试用期

begin

Application.Terminate;

end

else //没过试用期，关闭注册窗口

begin

Self.Close;

end;

end;

end;

procedure TFrmReg.FormActivate(Sender: TObject);

begin

Edit1.Text := Share.GetVolumeNumber; //得到序列号

Edit2.Clear;

Edit2.SetFocus;

end;

function TFrmReg.GetSN: TstringList; //获取到注册表中的注册信息

var

MyReg: TRegistry;

sn, reg: string;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\Reg', True);

try

sn := MyReg.ReadString('sn');

reg := MyReg.ReadString('reg');

except

MyReg.WriteString('sn', '');

MyReg.WriteString('reg', '');

end;

TmpList.Add(sn);

TmpList.Add(reg);

Result := TmpList;

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

procedure TFrmReg.FormDestroy(Sender: TObject);

begin

TmpList.Free;

end;

procedure TFrmReg.FormCreate(Sender: TObject);

begin

TmpList := TStringList.Create;

end;

procedure TFrmReg.FormShow(Sender: TObject);

var

LoginTimes: string;

TmpStr: string;

begin

TmpStr := Trim(GetSN.Strings[1]); //看注册表中是否有注册信息

if (TmpStr = Share.GetZCH(Trim(TmpList.Strings[0]))) and (TmpStr <> '') then //是正确的注册号

begin

Label3.Caption:='软件已注册成为正式版，不再将有期限！';

Btn_Reg.Enabled:=false;

end;

end;

end.

---

unit Login;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls,Registry ;

type

TFrmLogin = class(TForm)

Label1: TLabel;

Label2: TLabel;

edtPassWord: TEdit;

Button1: TButton;

Button2: TButton;

cbName: TComboBox;

procedure Button2Click(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure FormShow(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure edtPassWordKeyPress(Sender: TObject; var Key: Char);

procedure FormDestroy(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

iTimes: Integer;

slOperator: TStringList;

procedure LoadOperators;

function CheckPW: Boolean;

procedure RecordCurrentOP;

procedure Reginfo;

{ Private declarations }

public

TmpList: TStringlist;

function GetSN: TstringList; //得到序列号

{ Public declarations }

end;

var

G_IsOverTime: Boolean; //全局变量 是否超过试用期

FrmLogin: TFrmLogin;

implementation

uses DM,Share, Main, Reg;

{$R *.dfm}

procedure TFrmLogin.Button2Click(Sender: TObject);

begin

Close;

end;

procedure TFrmLogin.FormClose(Sender: TObject; var Action: TCloseAction);

begin

if not Application.ShowMainForm then

Application.Terminate;

end;

procedure TFrmLogin.FormShow(Sender: TObject);

begin

LoadOperators;

end;

procedure TFrmLogin.LoadOperators;

begin

cbName.Items.Clear;

slOperator := TStringList.Create;

with Frmdm.qryQuery do

begin

if Active then

Active := False;

SQL.Clear;

SQL.Add('Select ID,aname From admin Order By ID');

Active := True;

if RecordCount < 1 then

Exit;

First;

while not Eof do

begin

cbName.Items.Add(FieldByName('aname').AsString);

slOperator.Add(FieldByName('ID').AsString);

Next;

end;

Active := False;

end;

if cbName.Items.Count > 0 then

cbName.ItemIndex := 0;

end;

function TfrmLogin.CheckPW: Boolean;

var

tmpstr: string;

begin

Result := False;

tmpstr := Frmdm.GetValue('admin','pass','ID',slOperator.Strings[cbName.ItemIndex],False);

Result := tmpstr = edtPassWord.Text;

end;

procedure TFrmLogin.Button1Click(Sender: TObject);

begin

if cbName.ItemIndex < 0 then

begin

Application.MessageBox('请选择操作员。','提示',MB_OK);

cbName.SetFocus;

Exit;

end;

if CheckPW then

begin

Application.ShowMainForm := True;

Reginfo;

RecordCurrentOP;

Close;

end

else begin

Inc(iTimes);

if iTimes >= 3 then

begin

Application.MessageBox('口令错误，程序将被终止。','提示',MB_OK);

Application.Terminate;

end;

Application.MessageBox(PChar('口令错误，还有'+IntToStr(3 - iTimes) +'次'),'提示',MB_OK);

cbName.SetFocus;

end;

end;

procedure TfrmLogin.RecordCurrentOP;

var

tmpstr: string;

begin

tmpstr := slOperator.Strings[cbName.ItemIndex];

Operator.No := StrToInt(tmpstr);

Operator.Name := cbName.Items.Strings[cbName.ItemIndex];

end;

procedure TFrmLogin.edtPassWordKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

Button1Click(nil);

end;

Procedure TFrmLogin.Reginfo;

var

LoginTimes: string;

TmpStr: string;

begin

//以下为判断是否注册过

TmpStr := Trim(GetSN.Strings[1]); //看注册表中是否有注册信息

if (TmpStr = Share.GetZCH(Trim(TmpList.Strings[0]))) and (TmpStr <> '') then //是正确的注册号

begin

if FrmMain.Caption <> '婚庆娱乐网（正式注册版）' then

begin

FrmMain.Caption := '婚庆娱乐网（正式注册版）';

end;

end

else //没有注册

begin

if FrmMain.Caption <> '婚庆娱乐网（试用版）' then

begin

FrmMain.Caption := '婚庆娱乐网（试用版）';

end;

LoginTimes := Share.GetLoginTimes; //得到剩余的登录次数

if (StrtoIntDef(LoginTimes, 0) >= 2) and (StrtoIntDef(LoginTimes, 0) <= 30) then

begin

LoginTimes := IntToStr(StrToInt(LoginTimes) - 1);

Application.MessageBox(Pchar('您还未注册，还可以使用本软件' + LoginTimes + '次！'), '提示', Mb_ok or Mb_IconInformation);

Share.WriteLoginTimes(LoginTimes); //把剩余次数写回注册表

end

else //试用次数到期了

begin

if StrToIntDef(LoginTimes, 0) = 1 then

begin

Application.MessageBox('软件已过试用期限,请注册！', '提示');

G_IsOverTime := True;

if Application.MessageBox('现在注册吗？', '提示', Mb_YesNo or Mb_IconQuestion) = IdYes then

begin

if not Assigned(FrmReg) then

begin

FrmReg := TFrmReg.Create(Self);

end;

FrmReg.ShowModal; //显示注册窗口

end

else

begin

Application.Terminate; //程序终止

end;

end;

end;

end;

end;

function TFrmLogin.GetSN: TstringList; //获取到注册表中的注册信息

var

MyReg: TRegistry;

sn, reg: string;

begin

try

Myreg := TRegistry.Create;

MyReg.RootKey := HKEY_LOCAL_MACHINE;

MyReg.OpenKey('Software\HQ\Reg', True);

try

sn := MyReg.ReadString('sn');

reg := MyReg.ReadString('reg');

except

MyReg.WriteString('sn', '');

MyReg.WriteString('reg', '');

end;

TmpList.Add(sn);

TmpList.Add(reg);

Result := TmpList;

finally

MyReg.CloseKey;

MyReg.Free;

end;

end;

procedure TFrmLogin.FormDestroy(Sender: TObject);

begin

TmpList.Free;

end;

procedure TFrmLogin.FormCreate(Sender: TObject);

begin

TmpList := TStringList.Create;

end;

end.