Fórum Registrar o sistema no registro no Windows #310534

unit ExpirationControl;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry;

type
  TExpirationControl = class(TComponent)
  private
    { Private declarations }
    FUltimaExecucao: TDateTime;
    FHoje: TDateTime;
    FValidate: Integer;
    FNomeProduto: String;
    FVersaoProduto: String;
    FBuilt: String;
    FHistorico: TStrings;
    procedure SetHistorico(Value: TStrings);
    procedure SetNomeProduto(Value: String);
    procedure SetVersaoProduto(Value: String);
    procedure SetBuilt(Value: String);

  protected
    { Protected declarations }
  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    Destructor Destroy; override;
    procedure MontaTitulo;
    procedure WMTIMECHANGE(var Message: TWMTIMECHANGE);
    message WM_TIMECHANGE;
  published
    { Published declarations }
    property ProductName: String read FNomeProduto write SetNomeProduto;
    property ProductVersion: String read FVersaoProduto write SetVersaoProduto;
    property BuiltBy: String read FBuilt write SetBuilt;
    property ValidateDays: Integer read FValidate write FValidate;
    property Historical: TStrings read FHistorico write SetHistorico;
    function DateIsValid: Boolean;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents(´Zanela´, [TExpirationControl]);
end;

{ TExpirationControl }

constructor TExpirationControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
  FHistorico:= TStringList.Create;
end;

destructor TExpirationControl.Destroy;
begin
FHistorico.Free;
inherited Destroy;
end;

function TExpirationControl.DateIsValid: Boolean;
var Registro: TRegistry;
lSucesso: Boolean;
begin
lSucesso:= false;
Registro:= TRegistry.Create;
  FHoje:= Trunc(Date);
  try
  Registro.RootKey:= HKEY_CURRENT_USER;
    if not Registro.OpenKey(´ExpirationControl´,false) then
    begin
Registro.OpenKey(´ExpirationControl´,true);
      Registro.WriteDate(´StoredDate´, FHoje);
      Registro.WriteDate(´InstallationDate´, FHoje);
      lSucesso:= true;
    end else
    begin
    if (Registro.ReadDate(´StoredDate´)>FHoje) then
      begin
      FUltimaExecucao:= Registro.ReadDate(´StoredDate´);
      lSucesso:= false;
      end else
      begin
      Registro.WriteDate(´StoredDate´, FHoje); // Atualiza a data da última execução no registro
        FUltimaExecucao:= Registro.ReadDate(´StoredDate´); //
        lSucesso:= true;
end;
      if lSucesso Then
      begin
        if ((Registro.ReadDate(´InstallationDate´)+FValidate)<=FHoje) then lSucesso:= false;
      end;
    end;
  finally
  Registro.Free;
    Result:= lSucesso;
  end;

end;

procedure TExpirationControl.SetHistorico(Value: TStrings);
begin
  if FHistorico.Text <> Value.Text then
  begin
    try
      FHistorico.Assign(Value);
    finally
    end;
  end;
end;

procedure TExpirationControl.SetNomeProduto(Value: String);
begin
if FNomeProduto <> Value then FNomeProduto := Value;
  MontaTitulo;
end;

procedure TExpirationControl.MontaTitulo;
var cTitulo: String;
begin
cTitulo:= ´´;
if FNomeProduto<>´´ then cTitulo := cTitulo + FNomeProduto;
  if FVersaoProduto<>´´ then cTitulo := cTitulo + ´ - ´ + FVersaoProduto;
  if FBuilt<>´´ then cTitulo := cTitulo + ´ - Built by ´ + FBuilt;
Application.Title:= cTitulo;
end;

procedure TExpirationControl.SetBuilt(Value: String);
begin
if FBuilt  <> Value then FBuilt := Value;
  MontaTitulo;
end;

procedure TExpirationControl.SetVersaoProduto(Value: String);
begin
if FVersaoProduto <> Value then FVersaoProduto := Value;
  MontaTitulo;
end;

procedure TExpirationControl.WMTIMECHANGE(var Message: TWMTIMECHANGE);
begin
//if not DateIsValid then halt;
ShowMessage(´Ok´);
end;

end.