alg_main.pas

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

unit alg_main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, ComCtrls, StdCtrls, FGIntRSA, FGInt;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    rs1: TEdit;
    rs2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Key1: TEdit;
    Key2: TEdit;
    Button2: TButton;
    Button3: TButton;
    Label5: TLabel;
    fName: TEdit;
    Button4: TButton;
    OD: TOpenDialog;
    Label6: TLabel;
    Date: TDateTimePicker;
    Label7: TLabel;
    code: TEdit;
    rbstr: TRadioButton;
    rbfile: TRadioButton;
    ExDataF: TEdit;
    ExDataS: TEdit;
    Button5: TButton;
    Button7: TButton;
    SD: TSaveDialog;
    TabSheet3: TTabSheet;
    Label8: TLabel;
    LName: TEdit;
    Button6: TButton;
    Button8: TButton;
    Lb: TListBox;
    Label9: TLabel;
    TabSheet4: TTabSheet;
    Panel2: TPanel;
    Image1: TImage;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Bevel1: TBevel;
    Label15: TLabel;
    DataS: TEdit;
    Bevel2: TBevel;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Label12MouseEnter(Sender: TObject);
    procedure Label12MouseLeave(Sender: TObject);
    procedure Label12Click(Sender: TObject);
  private
    { Private declarations }
    n,e,d : TFGInt;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation
uses crc32, artlicense, shellapi;

{$R *.dfm}

function randomstring : string;
var len,i:integer;
begin
 len := 12 + random(5);
 setlength(Result,len);
 for i:=1 to len do
  Result[i] := chr(32+random(223));
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
 randomize;
 rs1.Text := randomstring;
 rs2.Text := randomstring;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
    s : string;
begin
 RSAGenerate(rs1.Text, rs2.Text, n, e, d);
 FGIntToHexString(n, s);
 key2.Text := s;
 FGIntToHexString(d, s);
 key1.Text := s;
end;

procedure TMainForm.Button3Click(Sender: TObject);
begin
 close;
end;

procedure TMainForm.Button4Click(Sender: TObject);
begin
 od.Filter := 'Exe files|*.exe|All files|*.*';
 od.DefaultExt := '.exe';
 od.Title := 'Select Exe file';
 if od.Execute then fname.Text := OD.FileName;
end;

procedure TMainForm.Button5Click(Sender: TObject);
begin
 od.Filter := 'All files|*.*';
 od.DefaultExt := '';
 od.Title := 'Select Data file';
 if od.Execute then exdataf.Text := OD.FileName;
end;

function ToString(var param; size : byte):string;
var i:integer;
begin
 setlength(result,size);
 for i:=0 to size-1 do
   result[i+1] := (pchar(@param))[i];
end;

procedure TMainForm.Button7Click(Sender: TObject);
var s:string;
    dat : TDateTime;
    ff:Tsearchrec;
    x,crc : LongWord;
    i: integer;
    data, exdata : string;
    f : Tfilestream;
begin
 if (key1.Text = '') or (Key2.Text = '') then
 begin
  Application.MessageBox('Generate keys first!','No keys',mb_iconstop);
  exit;
 end;
 if not fileexists(fname.Text) then
 begin
  Application.MessageBox('Specify existing exe file!','No file',mb_iconstop);
  exit;
 end;
 dat := date.DateTime;
 findfirst(fname.Text,0,ff);
 x := ff.size;
 findclose(ff);
 crc32file(fname.Text, crc);

 s := 'ArtLicense'+
      ToString(dat,sizeof(tdatetime))+
      ToString(x,sizeof(LongWord))+
      ToString(crc,sizeof(LongWord));
 x := length(code.text);
 s := s + ToString(x,sizeof(LongWord));
 if x > 0 then s := s + code.Text;

 data := datas.Text;

 if rbstr.Checked then exdata := exdatas.Text
 else
 begin
  f := tfilestream.Create(exdataf.text,fmOpenRead);
  x := f.size;
  if x > 0 then
  begin
   setlength(exdata,x);
   f.Read(exdata[1],x);
  end;
   f.Free;
 end;

 x := length(data);
 s := s + ToString(x,sizeof(LongWord));
 if x > 0 then s := s + data;

 HexStringToFGInt(key2.Text, n);
 HexStringToFGInt(key1.Text, d);

 RSAEncrypt(s,d,n,s);
// RSADecrypt(s,e,n,no,no,no,no,s);

 if sd.Execute then
 begin
  f := tfilestream.Create(sd.FileName,fmCreate);
  i := length(s);
  f.Write(i,sizeof(i));
  s := s + exdata;
  f.Write(s[1],length(s));
  f.Free;
  f := tfilestream.Create(changefileext(sd.FileName,'.info'),fmCreate);
  s := 'License Key (to encrypt):'#13#10+Key1.Text+
       #13#10'TArtLicense Key (to decrypt):'#13#10+Key2.Text;
  f.Write(s[1],length(s));
  f.Free;
  Lname.Text := sd.FileName;
 end;

end;

procedure TMainForm.Button6Click(Sender: TObject);
begin
 od.Filter := 'License files (*.lic)|*.lic|All files|*.*';
 od.DefaultExt := '.lic';
 od.Title := 'Select License file';
 if od.Execute then lname.Text := OD.FileName;
end;

procedure TMainForm.Button8Click(Sender: TObject);
var Lic : TArtLicense;
begin
 if fileexists(Lname.text) and (key1.Text <> '') then
 begin
  Lb.Clear;
  Lic := TArtLicense.Create(nil);
  Lic.LicFile := Lname.Text;
  Lic.Key := key2.Text;
  try
   Lb.Items.Add('Date       : '+formatdatetime(ShortDateFormat,Lic.LicInfo.date));
   Lb.Items.Add('File size  : '+inttostr(Lic.LicInfo.size));
   Lb.Items.Add('CRC        : '+inttohex(Lic.LicInfo.crc,8));
   Lb.Items.Add('Code string: '+Lic.LicInfo.code);
   Lb.Items.Add('Data string: '+Lic.LicInfo.data);
   Lb.Items.Add('ExData string: '+Lic.GetExDataString);
  except
   Lb.Items.Add('Wrong Lic file!');
  end;
  FreeandNil(Lic);
 end;
end;

procedure TMainForm.Label12MouseEnter(Sender: TObject);
begin
 (sender as TLabel).Font.Style := [fsunderline];
end;

procedure TMainForm.Label12MouseLeave(Sender: TObject);
begin
 (sender as TLabel).Font.Style := [];
end;

procedure TMainForm.Label12Click(Sender: TObject);
begin
 ShellExecute(handle,'open',pchar((sender as TLabel).Caption),'','',sw_show)
end;

end.