向大家提供一个通用的软件的试用期设定的控件

Question

近来写了个软件试用期设定的控件,这种方法是大部分小型软件的试用期设定方法，希望大家多多指点。unit USoftReg;interfaceuses
  Windows, Messages, Classes, SysUtils, Registry, dialogs;Const
    Letter76: array[0..76] of PChar = (
             '0','1','2','3','4','5','6','7','8','9',
             'A','B','C','D','E','F','G','H','I','J',
             'K','L','M','N','O','P','Q','R','S','T',
             'U','V','W','X','Y','Z','a','b','c','d',
             'e','f','g','f','i','j','k','l','m','n',
             'o','p','q','r','s','t','u','v','w','x',
             'y','z','.',',','-','(',')','/','=','!',
             '"','%','&','*',';','<','>');
Type
  TSoftWareReg = Class(TComponent)  private
    FAllowTimes, FPeriod: integer;
    FRegName: String;
    FAvailable: Boolean;
    FirstDate: TDatetime;
    Reg: TRegistry;
    function Encrypt(TempStr: string): String;
    procedure SetAllowTime(Value: integer);
    procedure SetFreePeriod(Value: integer);
    procedure SetRegName(Value: String);
    procedure SetAvailable(Value: Boolean);
//    procedure SetDefaultName;
  protected  public
    constructor Create(AOwner: TComponent);override;
    destructor Destroy; override;
    procedure Registried(RegUser, RegPass: String);
    function IsRegistry: boolean;
    function Isexpire(CurrentDate: TDateTime): boolean;
    function IsAllowExecuted: boolean;
    procedure SetRegistry;
  published
    property Available: Boolean read FAvailable write SetAvailable Default False;
    property AllowTimes: integer read FAllowTimes write SetAllowTime;
    property FreePeriod: integer read FPeriod write SetFreePeriod;
    property RegName: String read FRegName write SetRegName;  end;procedure Register;implementationprocedure Register;
begin
  RegisterComponents('Wally', [TSoftWareReg]);
end;constructor TSoftWareReg.Create(AOwner: TComponent);begin
  inherited Create(AOwner);
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
  except
    Reg.Free;
  end;end;destructor TSoftWareReg.Destroy;
begin
  Reg.Free;
  inherited Destroy;
end;function TSoftWareReg.Encrypt(TempStr: string): String;
var
  ReturnStr: String;
  Str1: Char;
  i, j, k, iTemp: integer;
  iFlag1, iFlag2: boolean;
begin
  ReturnStr := '';
  iFlag1 := False;
  iFlag2 := False;
  for i:=1 to Length(TempStr) do
  begin
    j := (i*i*i*i mod (i+30)) +(i*i mod(I+20)) +i*3+1;
    iTemp := Ord(TempStr[i]) +j;
    if Ord(TempStr[i]) +j >122 then
       iTemp := Ord(TempStr[i]) +j - 122;
    if iTemp < 32 then
      iTemp := iTemp +32;
    Str1 := Chr(iTemp);
    for k := 0 to 76 do
    begin
      if Str1 = Letter76[k] then
      begin
        iFlag1 := True;
        break;
      end
      else
        iFlag1 := False;
    end;
    if iFlag1 then
      ReturnStr := ReturnStr + Str1
    else
      ReturnStr := ReturnStr +'W';
    j := (i*i*i*i mod (i+30)) +(i*i mod(I+20)) +i*3+1;
    iTemp := Ord(TempStr[i]) +j;
    if Ord(TempStr[i]) +j >122 then
       iTemp := Ord(TempStr[i]) +j - 122;
    if iTemp < 32 then
      iTemp := iTemp +32;
    Str1 := Chr(iTemp);
    for k := 0 to 76 do
    begin
      if Str1 = Letter76[k] then
      begin
        iFlag2 := True;
        break;
      end
      else
        iFlag2 := False;
    end;
    if iFlag2 then
      ReturnStr := ReturnStr + Str1
    else
      ReturnStr := ReturnStr +'W'
  end;
  Result := ReturnStr;
end;function TSoftWareReg.IsAllowExecuted: boolean;
beginend;function TSoftWareReg.Isexpire(CurrentDate: TDateTime): boolean;
var
  iPeriod: integer;
  dtFirstDate: TDateTime;
  rUseDate: Real;
begin
  Result := False;
  if IsRegistry then
    Result := False
  else
  begin
    try
      if Reg.KeyExists('\SOFTWARE\' +FRegName)then
      begin
        Reg.OpenKey('\SOFTWARE\' +FRegName, False);
        if Reg.ValueExists('FirstDate') then
          dtFirstDate := Reg.ReadDate('FirstDate')
        else
          Result := True;
        if Reg.ValueExists('Period') then
          iPeriod := Reg.ReadInteger('Period')
        else
          Result := True;
        rUseDate := CurrentDate - dtFirstDate;
        if round(rUseDate -iPeriod) >= 0 then
          Result := True;
      end
      else
        Result := False;
    finally
      Reg.CloseKey;
    end;
   end;
end;function TSoftWareReg.IsRegistry: boolean;
begin
  try
    if Reg.KeyExists('\SOFTWARE\' +FRegName)then
    begin
      Reg.OpenKey('\SOFTWARE\' +FRegName, False);
      if Reg.ValueExists('Registried') then
        Result := Reg.ReadBool('Registried')
      else
        Result := False;
    end
    else
      Result := False;
  finally
    Reg.CloseKey;
  end;
end;procedure TSoftWareReg.Registried(RegUser, RegPass: String);
var
  sCompare, s1: string;
  i: integer;
begin
  try
    if not Reg.KeyExists('\SOFTWARE\' +FRegName)then
      Reg.CreateKey('\SOFTWARE\' +FRegName);
    Reg.OpenKey('\SOFTWARE\' +FRegName, false);
    sCompare := Encrypt(trim(RegUser));
    if CompareStr(sCompare, Trim(RegPass)) = 0 then
      Reg.WriteBool('Registried', True)
  finally
    Reg.CloseKey;
  end;
end;procedure TSoftWareReg.SetAllowTime(Value: integer);
begin
  if FAllowTimes <> 0 then
    FAllowTimes := Value
  else
    FAllowTimes := 1;  
end;procedure TSoftWareReg.SetAvailable(Value: Boolean);
begin
  FAvailable := Value;
end;procedure TSoftWareReg.SetFreePeriod(Value: integer);
begin
  if Value <> 0 then
    FPeriod := Value
  else
    FPeriod := 30;
end;procedure TSoftWareReg.SetRegName(Value: String);
begin
  if Value <> EmptyStr then
    FRegName := Value
  else
    FRegName := 'RegSoftWare';  
end;procedure TSoftWareReg.SetRegistry;
begin
  try
    if not Reg.KeyExists('\SOFTWARE\' +FRegName)then
    begin
      Reg.CreateKey('\SOFTWARE\' +FRegName);
      Reg.OpenKey('\SOFTWARE\' +FRegName, false);
      Reg.WriteInteger('Period', FPeriod);
      Reg.WriteInteger('AllowTimes', FAllowTimes);
      Reg.WriteBool('Registried', False);
      Reg.WriteDate('FirstDate', Date);
    end;
  finally
    Reg.CloseKey;
  end;
end;end.

Answer 1

调用的例子：
unit RefTest;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Registry, USoftReg;Const
    Letter76: array[0..76] of PChar = (
             '0','1','2','3','4','5','6','7','8','9',
             'A','B','C','D','E','F','G','H','I','J',
             'K','L','M','N','O','P','Q','R','S','T',
             'U','V','W','X','Y','Z','a','b','c','d',
             'e','f','g','f','i','j','k','l','m','n',
             'o','p','q','r','s','t','u','v','w','x',
             'y','z','.',',','-','(',')','/','=','!',
             '"','%','&','*',';','<','>');type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    Edit3: TEdit;
    SoftWareReg1: TSoftWareReg;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    function Encrypt(TempStr: string): String;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}function TForm1.Encrypt(TempStr: string): String;
var
  ReturnStr: String;
  Str1: Char;
  i, j, k, iTemp: integer;
  iFlag1, iFlag2: boolean;
begin
  ReturnStr := '';
  iFlag1 := False;
  iFlag2 := False;
  for i:=1 to Length(TempStr) do
  begin
    j := (i*i*i*i mod (i+30)) +(i*i mod(I+20)) +i*3+1;
    iTemp := Ord(TempStr[i]) +j;
    if Ord(TempStr[i]) +j >122 then
       iTemp := Ord(TempStr[i]) +j - 122;
    if iTemp < 32 then
      iTemp := iTemp +32;
    Str1 := Chr(iTemp);
    for k := 0 to 76 do
    begin
      if Str1 = Letter76[k] then
      begin
        iFlag1 := True;
        break;
      end
      else
        iFlag1 := False;
    end;
    if iFlag1 then
      ReturnStr := ReturnStr + Str1
    else
      ReturnStr := ReturnStr +'W';
    j := (i*i*i*i mod (i+30)) +(i*i mod(I+20)) +i*3+1;
    iTemp := Ord(TempStr[i]) +j;
    if Ord(TempStr[i]) +j >122 then
       iTemp := Ord(TempStr[i]) +j - 122;
    if iTemp < 32 then
      iTemp := iTemp +32;
    Str1 := Chr(iTemp);
    for k := 0 to 76 do
    begin
      if Str1 = Letter76[k] then
      begin
        iFlag2 := True;
        break;
      end
      else
        iFlag2 := False;
    end;
    if iFlag2 then
      ReturnStr := ReturnStr + Str1
    else
      ReturnStr := ReturnStr +'W'
  end;
  Result := ReturnStr;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  s, s1: string;
  i: integer;
  Reg: TRegistry;
begin
  s := Encrypt(trim(Edit1.Text));
  Edit3.Text := s;
      showmessage(s);
  try
    Reg := TRegistry.Create;
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if not Reg.OpenKey('\SOFTWARE\RegSample', False) then
      Reg.CreateKey('\SOFTWARE\RegSample');
    Reg.OpenKey('\SOFTWARE\RegSample', false);
    if CompareStr(S, Trim(Edit2.Text)) = 0 then
    begin
        Reg.WriteString('UserName', Trim(Edit1.Text));
        Reg.WriteString('PassWord', s);
        Reg.WriteBool('Registried', True);
    end
    else
      Reg.WriteBool('Registried', False);
  finally
    Reg.CloseKey;
    Reg.Free;
  end;end;procedure TForm1.Button2Click(Sender: TObject);
begin
  SoftWareReg1.SetRegistry;
end;procedure TForm1.FormShow(Sender: TObject);
begin
  if not SoftWareReg1.IsRegistry then
    if SoftWareReg1.Isexpire(Date) then
    begin
      if MessageDlg('The application is expire, Registry now?', mtWarning, [mbYes, mbNo], 0)=mrYes then
        abort
      else
        Application.Terminate;
    end;    
end;procedure TForm1.Button3Click(Sender: TObject);
begin
  SoftWareReg1.Registried(trim(edit1.text), trim(edit2.text));
end;end.

Answer 2

源代码和调用的例子可以在以下路径下载：http://www.codestudy.net/bbs/dispbbs.asp?boardid=9&rootid=31791&id=31791&star=