Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: Lizenz.pas Sprache: Delphi

//------------------------------------------------------------------------------
//
//1.inline scharf machen!
//2 Quersumme scharf machen
//
//------------------------------------------------------------------------------
unit Lizenz;

//------------------------------------------------------------------------------
interface

Uses
  //-------------------------------------------------------
  //local
  //-------------------------------------------------------
  GenDefs, Options, Utilities, Splash, DBAccess, Language,
  //-------------------------------------------------------
  //global
  //-------------------------------------------------------
  Forms, StdCtrls, Controls, Classes, DateUtils, Windows, Math;

//-------------------------------------------------------
//Constants
//-------------------------------------------------------
const
  Codelength = 64;
  MySQLlength = 8;
  Testdays = 10;

  //------------------------------------------------------------------------------
type
  TLizenzForm = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    function AktivierenviaInternet(): boolean;
    function AktivierenviaFile(): boolean;
    function AktivierenviaRegistry(): boolean;
    function AktivierenviaCode(Name, Code: String): boolean;
    function AktivierenGetWinProdId(Ed: Editions): String;
    procedure Button3Click(Sender: TObject);
    procedure TrytoActivate(goon: boolean);
    procedure checklicense(); {$IFNDEF DEBUG}inline; {$ENDIF}
    procedure checklicensesum(); {$IFNDEF DEBUG}inline; {$ENDIF}
    procedure checknetwork(); {$IFNDEF DEBUG}inline; {$ENDIF}
    function decrease(): DWord;
    function checkfilelength(filelen: integer; say: boolean): boolean;
    procedure Honeypot(globtim: Cardinal); {$IFNDEF DEBUG}inline; {$ENDIF}
    procedure Realcheck(globtim: Cardinal);
    procedure ReportData(Ed: Editions);
    function allowedsize(): DWord;
    procedure FormCreate(Sender: TObject);
  public
    goon: boolean;
    UserName, ProductCode: String;
    SQLHost, SQLUser, SQLPassword: String;
  end;

  //------------------------------------------------------------------------------
  //
  //------------------------------------------------------------------------------
var
  Lizenz1: TLizenzForm;

  //------------------------------------------------------------------------------
  //
  //------------------------------------------------------------------------------
implementation

uses
  Messages, SysUtils, Variants, Graphics,
  Strutils, Dialogs, ClipBrd;

{$R *.dfm}

//------------------------------------------------------------------------------
//
//check license sum
//
//------------------------------------------------------------------------------
procedure TLizenzForm.checklicensesum();
var
  ll1, ll2, ll3, ll4, ll7, ll8, rand: integer;
begin
  with Opt.R do
    ll1 := Opt.OptSum(@cc, @inited, @endofopts);
  with Opt.R do
    ll2 := Opt.OptLen(@cc, @inited, @endofopts);
  if ((Opt.R.OptionSum <> ll1) or (Opt.R.OptionLen <> ll2)) and
    not IsDebuggerPresent then begin
    Opt.R.Activated := false;
    errorn(112, 'Lizenz abgelaufen');
    HaltProgram(992);
  end;
  RandSeed := GetCurrentTime;
  rand := random(GetCurrentTime);
  if (rand mod 7 < 0) then begin
    //ll1 := Opt.R.CobolDllLen;
    //ll2 := Opt.R.CobolDllSum;
    ll3 := Opt.R.ObjectLen;
    ll4 := Opt.R.ObjectSum;
    //ll5 := getFileLength(Extensions[1].dllname + dlle);
    //ll6 := getFileSum(Extensions[1].dllname + dlle);
    ll7 := getFileLength(ParamStr(0));
    ll8 := getFileSum(ParamStr(0));
    if (ll3 <> ll7) or (ll4 <> ll8) then begin
      Opt.R.Activated := false;
      Opt.R.Activationstart := false;
      Opt.R.OptionSum := 0;
    end
  end
end;

//------------------------------------------------------------------------------
//
//check for network fake
//
//------------------------------------------------------------------------------
procedure TLizenzForm.checknetwork();
var
  ip: String;
begin
  ip := getIP('cococo.de');
  if ip <> '0' then
    if ip <> '87.230.16.129' then
      Opt.R.Activated := false;
end;

//------------------------------------------------------------------------------
//
//check license
//
//------------------------------------------------------------------------------
procedure TLizenzForm.checklicense();
var
  ll1, ll2, ll3, ll4: integer;
  WI: String;
  TD: TDate;
begin
  //
  if (Opt.R.Activationstart <> Opt.R.Activated) then begin
    //Splashform.setInfo(trans(149, 'es wird gesäubert'));
    //SplashForm1.init(15);
    //SplashForm1.Progress(7);
    Cursor := crHourGlass;
    ll3 := Opt.R.ObjectLen;
    ll4 := Opt.R.ObjectSum;
    if (not IsDebuggerPresent) and ((ll3 <> getFileLength(ParamStr(0))) or (ll4 <> getFileSum(ParamStr(0))))
    then begin
      //SplashForm1.Progress(9);
      Opt.R.Activated := false;
      Opt.R.Activationstart := false;
      Opt.R.OptionSum := 0;
      TrytoActivate(false);
    end
    else
      Opt.R.Activationstart := Opt.R.Activated;
  end;
  WI := GetWinProductId;
  TD := today;
  if (WI <> Opt.R.WindowsProductId) or (Opt.R.LastUse > TD) then begin
    Opt.R.Activated := false;
    Opt.R.Edition := Standard;
    TrytoActivate(false);
  end;
  //check after n days (like Windows does)
  if (Now > Opt.R.NextCheck) then begin
    ll1 := getFileLength(ParamStr(0));
    ll2 := getFileSum(ParamStr(0));
    ll3 := Opt.R.ObjectLen;
    ll4 := Opt.R.ObjectSum;
    if (ll3 <> ll1) or (ll4 <> ll2) or
      (GetWinProductId <> Opt.R.WindowsProductId) then
      TrytoActivate(false)
    else
      Opt.R.NextCheck := incday(Now, MaxFreeDays);
  end;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
function TLizenzForm.AktivierenviaInternet(): boolean;
var
  Prod: String;
  Edit: String;
  E: Editions;
  found: boolean;
begin
  found := false;
  //SQLSelect(Code,Prod,Edit);
  if Prod = Application.Title then begin
    for E := low(Editions) to High(Editions) do
      if EditionStrings[E] = Edit then begin
        Opt.R.Edition := E;
        Opt.R.Activated := true;
        Opt.PutOptions(PChar(Optionsfilename(Application.Title)));
        Close();
        inform(54, 'Software wurde aktiviert. Bitte neu starten', '');
        found := true;
      end;
    //SQLUpdate(Code,GetWinProductId,'IP',getCPUID,getDiskId(GetCurrentdir()),'');
  end;
  AktivierenviaInternet := found;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
procedure TLizenzForm.ReportData(Ed: Editions);
begin
  //if (daysbetween(Opt.R.LastDllReport, Now) > 5) and (Ed <= Professional) then
  //begin
    //SQLConnect(SQLHost, SQLUser, SQLPassword);
    //if SQLInsert() < 0 then
     // SQLUpdate();
  //end;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
function TLizenzForm.AktivierenGetWinProdId(Ed: Editions): String;
var
  Inp, Erg, Key: array [0 .. 64] of Char;
  Pin, Pout: PChar;
  C3, Edit, mke: String;
  i: integer;
begin
  //make key
  mke := '';
  for i := 1 to 8 do
    mke := mke + chr(ord(i - 1) + ord('a'));
  strpcopy(Key, mke); //secret key  'abcdefgh'
  Pin := @Inp;
  Pout := @Erg;
  //Pkey := @Key;
  //code to get winprodid
  Edit := EditionStrings[Ed];
  C3 := GetWinProductId() + '-' + Edit;
  if Length(C3) > Codelength then
    errorn(116, 'Code zu lang!');
  while Length(C3) < Codelength do
    C3 := C3 + ' ';
  strpcopy(Pout, '');
  strpcopy(Pin, PChar(C3));
  //Opt.DoActivate(Pin, Pout, Pkey);
  strpcopy(Pin, '');
  AktivierenGetWinProdId := Pout;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
function TLizenzForm.AktivierenviaCode(Name, Code: String): boolean;
var
  Inp, Erg, Win, Key: array [0 .. 128] of Char;
  E: Editions;
  found, nameeq, appliceq, versioneq, lenerror: boolean;
  Pin, Pout, Pwin: PChar;
  C1, C2, Edit, Version, Applic, mke, CodeName: String;
  i, j: integer;
begin
  found := false;
  //make key
  mke := '';
  for i := 1 to 8 do
    mke := mke + chr(ord(i - 1) + ord('a'));
  strpcopy(Key, mke); //secret key  'abcdefgh'
  Pin := @Inp;
  Pout := @Erg;
  //Pkey := @Key;
  Pwin := @Win;
  //-------------------------------------------------
  //get product ID
  //-------------------------------------------------
  strpcopy(Pwin, GetWinProductId());
  //now decode Code
  strpcopy(Pin, '');
  strpcopy(Pout, PChar(Code));
  lenerror := true;
  if Length(Code) mod 8 = 0 then begin
    //Opt.DoActivate(Pin, Pout, Pkey);
    lenerror := false;
  end;
  //compare WinproductId
  C1 := Pwin;
  C2 := Trim(Pin);
  //extract Editiomn
  i := Length(C2);
  while (i > 0) and CharinSet(C2[i], ['a' .. 'z', 'A' .. 'Z',
    '0' .. '9', ' ']) do
    i := i - 1;
  CodeName := MidStr(C2, i + 1, Length(C2) - i);
  //extract Edition
  i := i - 2;
  j := i;
  while (i > 0) and CharinSet(C2[i], ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) do
    i := i - 1;
  Edit := MidStr(C2, i + 1, j - i + 1);
  //extract Name
  i := i - 2;
  j := i;
  while (i > 0) and CharinSet(C2[i], ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) do
    i := i - 1;
  Applic := MidStr(C2, i + 1, j - i + 1);
  //extract Version
  //i := j;
  //j := i;
  //while (i > 0) and CharinSet(C2[i], ['a' .. 'z', 'A' .. 'Z', '0' .. '9']) do
  //i := i - 1;
  //Version := MidStr(C2, i + 1, j - i + 1);
  //now compare
  Version := Opt.R.Version;
  //
  Name := Trim(Name);
  CodeName := Trim(CodeName);
  nameeq := LowerCase(Name) = LowerCase(CodeName);
  appliceq := LowerCase(Applic) = LowerCase(Application.Title);
  versioneq := LowerCase(Version) = LowerCase(Opt.R.Version);
  if not lenerror then
    if nameeq then
      if appliceq then
        if versioneq then begin
          C2 := MidStr(C2, 1, i - 1);
          //get ProductId
          if LowerCase(C1) = LowerCase(C2) then begin
            for E := low(Editions) to High(Editions) do
              if EditionStrings[E] = Edit then begin
                //SplashForm1.ChangeInfo(trans(467, 'Aktivierung'));
                //SplashForm1.init(15);
                Opt.R.UserName:= Name;
                Opt.R.Edition := E;
                Opt.R.Activated := true;
                Opt.R.ObjectLen := getFileLength(ParamStr(0));
                //SplashForm1.Progress(3);
                Opt.R.ObjectSum := getFileSum(ParamStr(0));
                //SplashForm1.Progress(7);
                Opt.PutOptions(PChar(Optionsfilename(Application.Title)));
                Close();
                inform(55, 'Software wurde aktiviert. Bitte neu starten', '');
                HaltProgram(0);
              end;
          end;
        end;
  result := found;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
function TLizenzForm.AktivierenviaFile(): boolean;
var
  License: TextFile;
  found: boolean;
  Licname: String;
  Name, Code: String;
begin
  Licname := Opt.R.ProgDir + Application.Title + '.lic';
  Code := '';
  AssignFile(License, Licname);
  if fileexists(Licname) then begin
    Reset(License);
    Readln(License, Name);
    Readln(License, Code);
    CloseFile(License);
    found := AktivierenviaCode(Name, Code);
    if not found then
      inform(526, 'falsche Registrierungsdaten in Datei', '');
  end
  else begin
    Code := '';
    found := false;
  end;
  result := found;
end;

//------------------------------------------------------------------------------
//
//activate via Internet
//
//------------------------------------------------------------------------------
function TLizenzForm.AktivierenviaRegistry(): boolean;
var
  found: boolean;
  Lickey, FoundKey, FoundName: String;
begin
  found := false;
  Lickey := 'Software\' + Publisher + '\' + Application.Title;
  FoundKey := GetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'ProductCode');
  FoundName := GetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'User');
  if (FoundKey <> ProductCode) and (ProductCode > '') then begin
    found := AktivierenviaCode(UserName, ProductCode);
    if found then
      SetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'ProductCode', ProductCode)
    else begin
      inform(516, 'falsche Registrierungsdaten eingegeben', '');
      SetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'ProductCode', '');
    end;
  end
  else if (FoundKey <> '') and (FoundName <> '') and not Opt.R.Activated then
  begin
    found := AktivierenviaCode(FoundName, FoundKey);
    if not found then
      SetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'ProductCode', '');
    if not found then begin
      inform(527, 'falsche Registrierungsdaten vorhanden',
        FoundName + '/' + FoundKey);
      SetRegistryValue(HKEY_LOCAL_MACHINE, Lickey, 'ProductCode', '');
    end;
  end;
  result := found;
end;

//------------------------------------------------------------------------------
//
//check edition
//
//------------------------------------------------------------------------------
procedure TLizenzForm.TrytoActivate(goon: boolean);
begin
  dostop := not goon;
  if not AktivierenviaRegistry() then
    if not AktivierenviaFile() then
      if not goon then begin
        ShowModal();
        if ModalResult = mrCancel then
          HaltProgram(222);
      end;
end;

//------------------------------------------------------------------------------
//
//check edition
//
//------------------------------------------------------------------------------
procedure TLizenzForm.Button1Click(Sender: TObject);
begin
  UserName := Edit1.Text;
  ProductCode := Edit2.Text;
  AktivierenviaRegistry();
end;

//------------------------------------------------------------------------------
//
//check edition
//
//------------------------------------------------------------------------------
procedure TLizenzForm.Button2Click(Sender: TObject);
begin
  if dostop then
    HaltProgram(0);
end;

//------------------------------------------------------------------------------
//
//check edition
//
//------------------------------------------------------------------------------
procedure TLizenzForm.Button3Click(Sender: TObject);
begin
  if Opt.netallowed then
    Browser('https://cococo.de/Context_IT_GmbH/index.jsp?content=license&detail='
      + Application.Title);
end;

//--------------------------------------------------------------
//licensecheck
//wirkungslos, es sei denn es wäre gehackt worden
//--------------------------------------------------------------
procedure TLizenzForm.Honeypot(globtim: Cardinal);
begin
  if (not Opt.R.Activated) then
    if (Opt.R.DaysUsed > Testdays) then
      if (globtim * 60 > decrease()) then begin
        //showmessage('Daysused='+IntToStr(Opt.R.DaysUsed));
        HaltProgram(883);
      end;
end;

//--------------------------------------------------------------
//calculate filesize limit in kB
//--------------------------------------------------------------
function TLizenzForm.decrease(): DWord;
//var
  //MS: TMemoryStatus;
  //filesize: DWord;
begin
  //if (Opt.R.DaysUsed < 5) or opt.R.Activated then begin
    //GlobalMemoryStatus(MS);
    //filesize := longint(MS.dwTotalPhys)
    //filesize := absolutemax
  //end
  //else begin
    //case Opt.R.DaysUsed - 5 of
      //0: filesize := 10 * initmaxfilesize;
      //1: filesize := 8 * initmaxfilesize;
      //2: filesize := 6 * initmaxfilesize;
      //3: filesize := 4 * initmaxfilesize;
      //4: filesize := 2 * initmaxfilesize
    //else filesize := initmaxfilesize
    //end;
  //end;
  //result := filesize
  result:=0
end;

//--------------------------------------------------------------
//create
//--------------------------------------------------------------
procedure TLizenzForm.FormCreate(Sender: TObject);
begin
  ProductCode := '';
  UserName := '';
end;

//--------------------------------------------------------------
//licensecheck
//wirkungslos, es sei denn es wäre gehackt worden
//--------------------------------------------------------------
procedure TLizenzForm.Realcheck(globtim: Cardinal);
begin
  if (not Opt.R.Activated) and (Opt.R.DaysUsed > Testdays) and
    (globtim * 60 > decrease()) then
    Close();
  //if (not Opt.R.Activated) and (Opt.R.DaysUsed > Testdays) then
  //ReportData(opt.R.Edition);
end;

//------------------------------------------------------------------------------
//
//check file size
//
//------------------------------------------------------------------------------
function TLizenzForm.allowedsize(): DWord;
//var
  //limitedsize: DWord;
begin
  //if Opt.R.Activated then
    //limitedsize := decrease()
  //else
    //limitedsize := min(decrease(), reasonablesize)
    ;
  //result := limitedsize
  result:=0
end;

//------------------------------------------------------------------------------
//
//check file size
//
//------------------------------------------------------------------------------
function TLizenzForm.checkfilelength(filelen: integer; say: boolean): boolean;
var
  allow: boolean;
  als: integer;
begin
  allow := true;
  als := allowedsize();
  if (not Opt.R.Activated) and (Opt.R.DaysUsed > Testdays) and (filelen > als)
  then begin
    if say then begin
      inform(162, 'Dieses ist eine eingeschränkte Version von ' +
        Application.Title + '.' + crlf +
        ' Bitte schauen Sie einmal unter Hilfe:Vollständige Lizenz nach,' + crlf
        + 'wie man eine Lizenz erhält. Max=', storageunit(allowedsize()));
    end;
    allow := false
  end;
  result := allow
end;

//------------------------------------------------------------------}
//
//Ende dieser Quelle                                           -}
//
//-----------------------------------------------------------------}
end.

¤ Dauer der Verarbeitung: 0.19 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.