DELPHI 注册表注册授权代码

时间：2022-09-05 08:27:07

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.

标签：

相关文章