⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 artlicense.pas

📁 very simple nonvisual Delphi component useful for shareware program developing. It uses crypted lic
💻 PAS
字号:
//TArtLicense v1.1 
//
//
//--------------------------------------------------------------------------------
//
//TArtLicense - very simple nonvisual Delphi component useful for shareware program developing.
//It uses crypted license files containing information about exe file (size and crc), expired date and any 
//additional information.
//As TArtLicense uses RSA asymmetric algorithm and TArtLicense knows only decryption key, nobody can change 
//information inside license file. 
//
//Archive also includes source code of ArtLicGenerator (program to generate license files compatible with 
//TArtLicense). 
//
//Warning! TArtLicense Component v1.1 is not understand license files, created for previous version. 
//
//
//--------------------------------------------------------------------------------
//Description 
//Properties: 
//
//propertyLicInfo : TArtLicInfo; - Contains decrypted license information. 
//
//TArtLicInfo = record date : TDatetime; - expired date size : LongWord; - exe file size crc : LongWord; - 
//crc of exe file code : string; - license code data : string; - any additional data end; 
//
//Published properties: 
//
//property LicFile : string; - specifies license file name. 
//
//property Message : string; - message to show if license is invalid and Action property set to 
//etShowMessageAndTerminate; 
//
//property Action : TArtLicErrType; - specifies what Test procedure should do if license file is invalid. 
//
//type TArtLicErrType = (etSilent, etException, etTerminate, etShowMessageAndTerminate); 
//
//etSilent - simply return false 
//etException - raise exception of EArtLicViolation type 
//etTerminate - terminate program 
//etShowMessageAndTerminate - show message and terminate program 
//property Code : string; - license code 
//
//property UseSize : boolean; - test size and crc of exe file and specified in license file 
//
//property UseDate : boolean; - test date specified by TestDate property and license expired date 
//
//property TestDate : TDateTime; - date to test with license expired date 
//
//property Key : string; - decryption key (hex string). 
//
//property Data : string; - returns data contained in license file as string (same as GetDataString) 
//
//property ExData : string; - returns additional (not encrypted) data contained in license file as string 
//(same as GetExDataString) 
//
//Methods: 
//
//function Test : boolean; - Test license file specified by LicFile property 
//
//function GetInfo : TArtLicInfo; - returns decrypted license information (equal to LicInfo). 
//
//function GetDataString : string; - returns data contained in license file as string (same as Data) 
//
//function GetDateSize : integer; - returns size of additional data in license file 
//
//procedure GetData(var buff); - write data to buffer of any type. 
//
//function GetExDataString : string; - returns additional (not encrypted) data contained in license file 
//as string (same as Data) 
//
//function GetExDateSize : integer; - returns size of additional (not encrypted) data in license file 
//
//procedure GeExtData(var buff); - write additional (not encrypted) data to buffer of any type. 
//
//
//--------------------------------------------------------------------------------
//How to use 
//Set LicFile property to license file name. Specify license code. License code can contain any 
//information and should coincide with one in license file. For example it can determine application 
//version license intended for or depends on hardware configuration (n.b. you can use THDDInfo component 
//to obtain s/n of hard drive). In last case license file will be bound to the specific computer and can't 
//be used on other one. 
//
//If you want to test exe file size and crc number set UseSize property to true. This verifies that exe 
//file is unchanged. 
//
//If you want test expired date, set TestDate property to current date (or any other desirable value) 
//and UseDate property to true. 
//
//Set Key property to decryption key. 
//
//Call Test method to verify license. If license file contains valid information (code, date, file size 
//and crc) Test method returns true. Depending on value of Action property Test method can simply return 
//false (Action = etSilent), raise exception of EArtLicViolation type (etException), terminate program 
//(etTerminate) or show message specified by Message property and then terminate program 
//(etShowMessageAndTerminate). 
//
//To get license information use LicInfo or Data property or GetInfo and GetDataString methods. 
//If information in license file is not of string type, you can use GetDateSize method to obtain size 
//of data and GetData method to copy data into buffer of any type. 
//
//License file can contain additional (not encrypted) data. To obtane additional data use ExData 
//property or ExGetInfo and ExGetDataString methods. If additional information is not of string type, 
//you can use GetExDateSize method to obtain size of additional data and GetExData method to copy data 
//into buffer of any type. Of corse to protect your data you can store all you additional information 
//inside Data field, but as symmetric encryption algorithms are much faster than RSA, it is reasonable 
//to encrypt additional data with symmetric encryption algorithm and place only the key into Data field 
//of license file. See Demo for example of implementing this scheme. 
//
//To create license file use ArtLicGenerator program. 
//
//
//--------------------------------------------------------------------------------
//Author 
//Artem V. Parlyuk, e-mail:artsoft@nm.ru, http://artsoft.nm.ru 
//
//RSA implementation is made by Walied Othman, to contact him mail to Walied.Othman@Student.KULeuven.ac.be 
//or Triade@ace.Ulyssis.Student.KULeuven.ac.be 
//
//Crc32 unit by Andrew Rubin 
//
//--------------------------------------------------------------------------------
//LICENSE AND DISCLAIMER AGREEMENT 
//
//IMPORTANT - READ CAREFULLY 
//
//This license and disclaimer statement constitutes a legal agreement ("License Agreement") 
//between you (either as an individual or a single entity) and Artem Parlyuk (the "Author"), 
//for this software product in this particular case TArtLicense Delphi component ("Software"), 
//including any software, media, and accompanying on-line or printed documentation. 
//
//BY DOWNLOADING, INSTALLING, COPYING, OR OTHERWISE USING THE SOFTWARE, YOU AGREE TO BE BOUND 
//BY ALL OF THE TERMS AND CONDITIONS OF THIS LICENSE AND DISCLAIMER AGREEMENT. 
//If you do not agree with the terms and conditions of this agreement, you must promptly cease all 
//use of the software and destroy all copies of this software and all of its component parts in your 
//possession or under your control. 
//
//This Software is owned by Author and is protected by copyright law and international copyright treaty. 
//
//This Software is freeware. You are granted the permission to use Software in your own applications 
//for private or commercial purposes, provided your software contains the copyright notice "TArtLicense 
//Delphi component Copyright (c) by Artem Parlyuk" and link to the Author site (http://artsoft.nm.ru) 
//and Author e-mail (mailto:artsoft@nm.ru) . 
//
//You can freely distribute copies of the main archive as long as no alterations are made to the 
//contents and no charge is raised except a reasonable fee for distributing costs. You may not remove 
//copyright notices from copies of the Software. You may not claim this Software as written by anyone 
//but Author, Artem Parlyuk. 
//
//The author has taken all possible care to ensure the software is error-free, however the author 
//disavows any potential liability arising from any use of the software. This software is provided 
//"as is" and without any warranties expressed or implied, including, but not limited to, implied 
//warranties of fitness for a particular purpose, and non-infringement. You expressly acknowledge 
//and agree that use of the Software is at your sole risk. 
//
//In no event shall the author be liable for any damages whatsoever (including, without limitation, 
//damages for loss of business profits, business interruption, loss of business information, or other 
//pecuniary loss) arising out of the use of or inability to use this software or documentation, even 
//if the author has been advised of the possibility of such damages. 
//
//Any feedback given to the Author will be treated as non-confidential. The Author may use any 
//feedback free of charge without limitation. 
//--------------------------------------------------------------------------------



unit ArtLicense;

interface

uses
  SysUtils, Classes, FGInt;


type TArtLicErrType = (
                    etSilent,
                    etException,
                    etTerminate,
                    etShowMessageAndTerminate
                    );
 type
 EArtLicViolation = class(Exception)
 end;

 TArtLicInfo = record
  date : TDatetime;
  size : LongWord;
  crc : LongWord;
  code : string;
  data : string;
 end;

 type
  TArtLicense = class(TComponent)
  private
    flicfile : string;
    ferrtype : TArtLicErrType;
    fcode : string;
    fusesize : boolean;
    fusedate : boolean;
    fmessage : string;
    fedate	 : TDateTime;
    fmodb : string;
    expb, modb : TFGInt;
    fInfo : TArtLicInfo;
    floaded : boolean;
    fExData : string;
    { Private declarations }
  protected
    { Protected declarations }
    procedure SetKey(s:string);
    procedure SetLicFile(s:string);
    procedure LoadLicense;
  public
    { Public declarations }
    function Test : boolean;
    procedure GetData(var buff);
    function GetDataString : string;
    procedure GetExData(var buff);
    function GetExDataString : string;
    function GetDateSize : integer;
    function GetExDateSize : integer;
    function GetInfo : TArtLicInfo;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    property LicInfo : TArtLicInfo read GetInfo;
  published
    { Published declarations }
    property LicFile : string read flicfile write SetLicFile;
    property Message : string read fmessage write fmessage;
    property Action : TArtLicErrType read ferrtype write ferrtype default etsilent;
    property Code : string read fcode write fcode;
    property UseSize : boolean read fusesize write fusesize default false;
    property UseDate : boolean read fusedate write fusedate default false;
    property TestDate : TDateTime read fedate write fedate;
    property Key : string read fmodb write SetKey;
    property Data : string read GetDataString;
    property ExData : string read GetExDataString;
  end;

procedure Register;

implementation
uses forms,windows,FGIntRSA, crc32;

type PLongWord = ^LongWord;

procedure Register;
begin
  RegisterComponents('Art', [TArtLicense]);
end;

destructor TArtLicense.Destroy;
begin
  FGIntDestroy(modb);
  FGIntDestroy(expb);
  inherited Destroy;
end;

constructor TArtLicense.Create(AOwner:TComponent);
begin
 inherited Create(AOwner);
 ferrtype := etsilent;
 fmessage := 'License has expired!';
 floaded := false;
 Base10StringToFGInt('65537', expb);
end;

procedure TArtLicense.GetData(var buff);
begin
 if not floaded then LoadLicense;
 if length(fInfo.data) > 0 then move(fInfo.data[1],buff,length(fInfo.data));
end;

procedure TArtLicense.GetExData(var buff);
begin
 if not floaded then LoadLicense;
 if length(fExData) > 0 then move(fExData[1],buff,length(fExData));
end;


procedure TArtLicense.SetLicFile(s:string);
begin
 flicfile := s;
 floaded := false;
end;


function TArtLicense.GetInfo:TArtLicInfo;
begin
 if not floaded then LoadLicense;
 result := fInfo;
end;


function TArtLicense.GetDataString : string;
begin
 if not floaded then LoadLicense;
 Result := fInfo.data;
end;

function TArtLicense.GetExDataString : string;
begin
 if not floaded then LoadLicense;
 Result := fExData;
end;


function TArtLicense.GetDateSize : integer;
begin
 if not floaded then LoadLicense;
 Result := length(fInfo.data);
end;

function TArtLicense.GetExDateSize : integer;
begin
 if not floaded then LoadLicense;
 Result := length(fExData);
end;


procedure TArtLicense.SetKey(s:string);
begin
 if fmodb <> s then
 begin
  fmodb := s;
  HexStringToFGInt(s,modb);
 end;
end;


procedure TArtLicense.LoadLicense;
var f : Tfilestream;
    i,p,fs:integer;
    s : string;
    Nilgint : TFGInt;
begin
 floaded := false;
 f := tfilestream.Create(flicfile,fmOpenRead);
 fs := f.size - sizeof(integer);
 f.Read(i, sizeof(integer));
 if (i <= 0) or (i > 65535) then raise EArtLicViolation.Create(fmessage);
 setlength(s,i);
 f.Read(s[1],i);

 i := fs - i;
 if i > 0 then
 begin
  setlength(fexdata,i);
  f.Read(fexdata[1],i);
 end;

 f.Free;
 p := 11;
 RSADecrypt(s,expb,modb,Nilgint,Nilgint,Nilgint,Nilgint,s);
 FGIntDestroy(nilgint);
 if copy(s,1,10) <> 'ArtLicense' then
   raise EArtLicViolation.Create(fmessage);

 fInfo.date := (PDouble(@s[p]))^;
 inc(p,sizeof(Double));
 fInfo.size := (PLongWord(@s[p]))^;
 inc(p,sizeof(LongWord));
 fInfo.crc := (PLongWord(@s[p]))^;
 inc(p,sizeof(LongWord));
 i := (PInteger(@s[p]))^;
 inc(p,sizeof(Integer));
 if i > 0 then
 begin
  fInfo.code := copy(s,p,i);
  inc(p,i);
 end
 else
  fInfo.code := '';

 i := (PInteger(@s[p]))^;
 inc(p,sizeof(Integer));
 if i > 0 then
  fInfo.data := copy(s,p,i)
 else
  fInfo.data := ''; 
 floaded := true;
end;

function TArtLicense.Test:boolean;
var  ff:Tsearchrec;
     x : integer;
     crc : LongWord;
begin
result := true;
try

 if not floaded then LoadLicense;

 if fusesize then
 begin
  findfirst(Application.ExeName,0,ff);
  x := ff.size;
  sysutils.findclose(ff);
  if fInfo.size <> x then
  begin
   raise EArtLicViolation.Create(fmessage);
  end;
  CrC32File(paramstr(0),crc);
  if crc <> fInfo.crc then
     raise EArtLicViolation.Create(fmessage);
 end;

 if fusedate and (fedate > fInfo.date) then
    raise EArtLicViolation.Create(fmessage);

 if fInfo.code <> fcode then
    raise EArtLicViolation.Create(fmessage);

 except
  result := false;
   case ferrtype of
     etException: raise;
     etTerminate:
     begin
      Application.terminate;
      abort;
     end;
     etShowMessageAndTerminate:
     begin
      Application.MessageBox(pchar(fmessage),pchar(extractfilename(Application.exename)),mb_iconstop);
      Application.terminate;
      abort;
     end;
   end;
 end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -