Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
Tree234_Map.thy
Sprache: Isabelle
Untersuchungsergebnis.~24~ Download desAda {Ada[115] Abap[1484] [0]}zum Wurzelverzeichnis wechseln
//------------------------------------------------------------------------------
//
//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 (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, LicenseCheckInterval);
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.
[ zur Elbe Produktseite wechseln0.130Quellennavigators
]
|
|
