main.pas

very simple nonvisual Delphi component useful for shareware program developing. It uses crypted lic

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls, ArtLicense;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    InstallLicense1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    About1: TMenuItem;
    Aboutdemo1: TMenuItem;
    Functionality1: TMenuItem;
    Basic1: TMenuItem;
    SimpleM: TMenuItem;
    SpecialM: TMenuItem;
    ProM: TMenuItem;
    Panel1: TPanel;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Panel2: TPanel;
    ProB: TButton;
    Panel3: TPanel;
    SpecialB: TButton;
    Panel4: TPanel;
    SimpleC: TLabel;
    SimpleI: TLabel;
    SimpleB: TButton;
    Panel5: TPanel;
    Label9: TLabel;
    Label10: TLabel;
    SpecialC: TLabel;
    SpecialI: TLabel;
    ProC: TLabel;
    ProI: TLabel;
    OD: TOpenDialog;
    Lic: TArtLicense;
    Panel6: TPanel;
    Label3: TLabel;
    Ex: TLabel;
    procedure Exit1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SimpleBClick(Sender: TObject);
    procedure SpecialBClick(Sender: TObject);
    procedure ProBClick(Sender: TObject);
    procedure InstallLicense1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Aboutdemo1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function XorDecode(s,pass:string):string;
var i,k:integer;
begin
 result := '';
 i := 1;
 k := 1;
 while i <= length(s) do
 begin
  result := result + chr(ord(s[i]) xor ord(pass[k]));
  inc(k);
  if k > length(pass) then k := 1;
  inc(i);
 end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
 Close;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Application.MessageBox('Basic functionality','Basic functionality',mb_iconinformation);
end;

procedure TForm1.SimpleBClick(Sender: TObject);
begin
 Application.MessageBox('Simple functionality','Simple functionality',mb_iconinformation);
end;

procedure TForm1.SpecialBClick(Sender: TObject);
begin
 Application.MessageBox('Special functionality','Special functionality',mb_iconinformation);
end;

procedure TForm1.ProBClick(Sender: TObject);
begin
 Application.MessageBox('Pro functionality','Pro functionality',mb_iconinformation);
end;

procedure TForm1.InstallLicense1Click(Sender: TObject);
var lev : integer;
    pass,code : string;
begin
 if od.Execute then
 begin
  Lic.LicFile := od.FileName;
  if not Lic.Test then
  begin
   try
    if Lic.LicInfo.date < Lic.TestDate then
     Application.MessageBox('License has expired!','Error',mb_iconstop)
    else
    if Lic.LicInfo.code <> lic.Code then
     Application.MessageBox('Wrong license code!','Error',mb_iconstop)
   except
    Application.MessageBox('Invalid license file!','Error',mb_iconstop)
   end;
   SimpleB.Enabled := false;
   SimpleC.Font.Color := clBtnShadow;
   SimpleI.Font.Color := clBtnShadow;
   SimpleM.Enabled := false;
   SpecialB.Enabled := false;
   SpecialC.Font.Color := clBtnShadow;
   SpecialI.Font.Color := clBtnShadow;
   SpecialM.Enabled := false;
   ProB.Enabled := false;
   ProC.Font.Color := clBtnShadow;
   ProI.Font.Color := clBtnShadow;
   ProM.Enabled := false;
  end
  else
  begin
   lev := -1;
   pass := copy(lic.LicInfo.data,1,8);
   Ex.Caption := XorDecode(lic.ExData,pass);
   code := copy(lic.LicInfo.data,9,length(lic.LicInfo.data)-8);
   if code = 'simple' then lev := 1
   else
   if code = 'special' then lev := 2
   else
   if code = 'pro' then lev := 3;

   if lev = -1 then
   begin
    Application.MessageBox('No data in license!','Error',mb_iconstop);
    SimpleB.Enabled := false;
    SimpleC.Font.Color := clBtnShadow;
    SimpleI.Font.Color := clBtnShadow;
    SimpleM.Enabled := false;
    SpecialB.Enabled := false;
    SpecialC.Font.Color := clBtnShadow;
    SpecialI.Font.Color := clBtnShadow;
    SpecialM.Enabled := false;
    ProB.Enabled := false;
    ProC.Font.Color := clBtnShadow;
    ProI.Font.Color := clBtnShadow;
    ProM.Enabled := false;
    exit;
   end;

   if lev in [1,3] then
   begin
    SimpleB.Enabled := true;
    SimpleC.Font.Color := clblack;
    SimpleI.Font.Color := clblack;
    SimpleM.Enabled := true;
   end
   else
   begin
    SimpleB.Enabled := false;
    SimpleC.Font.Color := clBtnShadow;
    SimpleI.Font.Color := clBtnShadow;
    SimpleM.Enabled := false;
   end;

   if lev in [2,3] then
   begin
    SpecialB.Enabled := true;
    SpecialC.Font.Color := clblack;
    SpecialI.Font.Color := clblack;
    SpecialM.Enabled := true;
   end
   else
   begin
    SpecialB.Enabled := false;
    SpecialC.Font.Color := clBtnShadow;
    SpecialI.Font.Color := clBtnShadow;
    SpecialM.Enabled := false;
   end;

   if lev = 3 then
   begin
    ProB.Enabled := true;
    ProC.Font.Color := clblack;
    ProI.Font.Color := clblack;
    ProM.Enabled := true;
   end
   else
   begin
    ProB.Enabled := false;
    ProC.Font.Color := clBtnShadow;
    ProI.Font.Color := clBtnShadow;
    ProM.Enabled := false;
   end;

   Application.MessageBox( pchar(Uppercase(code)+
      ' license has been installed!'),'Ok',mb_iconinformation);


  end;
 end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 Lic.TestDate := Now;
end;

procedure TForm1.Aboutdemo1Click(Sender: TObject);
begin
   Application.MessageBox(
    'TArtLicense Demo'#13#10'(c) Artem Parlyuk, 2005    '#13#10'e-mail: [e-mail]',
    'About',mb_iconinformation);

end;

end.