Eine aufbereitete Darstellung der Quelle

 
     
 
 
Anforderungen  |   Konzepte  |   Entwurf  |   Entwicklung  |   Qualitätssicherung  |   Lebenszyklus  |   Steuerung
 
 
 
 
Benutzer

products/Sources/formale Sprachen/C/LibreOffice/icon-themes/breeze_svg/cmd/   (LibreOffice Version 25.8.3.2©)  Datei vom 5.10.2025 mit Größe 571 B image not shown  

Bilddatei

Lizenz.pas.~8~


products/Sources/formale Sprachen/Delphi/Bille 0.71/__history/Lizenz.pas.~8~

//------------------------------------------------------------------------------ // //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, ll5, ll6, 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 (ll1 <> ll5) or (ll2 <> ll6) or (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, Pkey: 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, Pkey: 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); setl(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.ProgramDir + 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 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 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.

                                                                                                                                                                                                                                                                                                                                                                                                     

Neuigkeiten

     Aktuelles
     Motto des Tages

Open Source Software

     Quellcodebibliothek
     Eigene Quellcodes
     Fremde Quellcodes
     Suchen
Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik
Statistik
#Sources=1127926
#Domains=2039723