Eine aufbereitete Darstellung der Quelle

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

products/Sources/formale Sprachen/C/Linux/drivers/usb/serial/   (Columbo Version 0.7©)  Datei vom 24.10.2025 mit Größe 1 kB image not shown  

Bilddatei

Options.pas.~91~


products/Sources/formale Sprachen/Delphi/Bille 0.71/__history/Options.pas.~91~

unit Options; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- interface //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, ShellApi, ShlObj, DateUtils, StrUtils, GenDefs, //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- Utilities, Matching, Language; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- const em = 16000; Agenda = 1; Autor = 2; Columbo = 3; Egmont = 4; Productnumber = chr(Autor + ord('0')); //em=1000; EvaluationPeriod = 30; maxoptsize = 1024 * 1024; optkeylen = 8; Debug = true; Soft = 'Software'; Mickey = 'Microsoft'; ActiveSet = 'Active Setup'; InstalledComp = 'Installed Components'; BigGain = 'Windows\CurrentVersion'; FileMax = 32; KeyMax = 128; KeyMaxLong = 16384; SMacAdr = 'macadr.cmd'; SMacOut = 'macadr.dat'; BorderWidth = 10; largeprime = 1023; histmax = 24; //external values Installkey = ''; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- EditionStrings: array [Editions] of String = ('Shareware', 'Standard', 'Professional', 'Enterprise'); //---------------------------------------------------------------------------- //rtf formats //---------------------------------------------------------------------------- Paragraph = '\par'; SetSize = '\f1\fs'; SetColor = '\cf'; SetNoColor = '\cf0'; Underline = '\ul '; UnderLineOff = '\ulnone'; Bold = '\b'; BoldOff = '\b0'; Strike = '\strike'; StrikeOff = '\strike0'; Italic = '\i'; ItalicOff = '\i0'; Font1 = '\f1 '; Font2 = '\i\f2 '; Font0 = '\i0'; SetBackColor = '\f1\cb1\cf'; SetNoBackColor = ''; //funktioniert nicht Omega = '\u963?'; //Achtung: Zahl (963) ist dezimal Summenzeichen = '\u931?'; //dito Produktzeichen = '\u928?'; //dito //---------------------------------------------------------------------------- //certain keys //---------------------------------------------------------------------------- Key_Return = 13; Key_Enter = 13; Key_LineFeed = 10; Key_BackSpace = 8; Key_Escape = 27; Key_Tab = 9; Key_Blank = 32; Key_F1 = 112; Key_F2 = 113; Key_F3 = 114; Key_F4 = 115; Key_F5 = 116; Key_F6 = 117; Key_F7 = 118; Key_F8 = 119; Key_F9 = 120; Key_F10 = 121; Key_F11 = 122; Key_F12 = 123; Key_Insert = 45; Key_Delete = 46; Key_Up = 38; Key_Down = 40; Key_Left = 37; Key_Right = 39; Key_Ctrl = 17; Key_Shift = 16; crlf = chr(Key_Return) + chr(Key_LineFeed); //---------------------------------------------------------------------------- //Program Parameters //---------------------------------------------------------------------------- Title = 'Bille'; CopyRight = '©'; Trademark = '®'; SOptions = 'BilleOptions.Dat'; SAutor = 'bille.exe'; SamplesDir = 'Workspace\Sample Programs\'; ExecDir = 'Workspace\Object Files\'; Workspace = 'Workspace\'; Remotedirectory = 'Workspace\Remote Files\'; CopyLib = 'Copy Library\'; XMLTagsOrg: array [1 .. 9] of String = ('OVERHEAD', 'HEADLINE', 'DATE', 'ABSTRACT', 'TEXT', 'AUTHOR', 'PICBIG', 'PICCREDIT', 'PICSMALL'); //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- type //---------------------------------------------------------------------------- //Languages and Sounds //---------------------------------------------------------------------------- TransDL = array [1 .. 100] of String; Perspectives = (browseper, editper); Texte = String[KeyMax]; RTFTexte = array [0 .. KeyMaxLong] of char; ArticleType = (Angebote, Aktuelles, Empfehlung, Heute, Gestern, Vorgestern); //---------------------------------------------------------------------------- //Options //---------------------------------------------------------------------------- OwnOptions = record case boolean of false: (cc: array [0 .. maxoptsize] of ansichar); true: (CheckSum: LongInt; OptionSum: LongInt; OptionLen: LongInt; inited: ansichar; Callcount: LongInt; Version: string[24]; Objectdate: TDate; ObjectLen: LongInt; ObjectSum: LongInt; OptionsDlllen: LongInt; OptionsDllsum: LongInt; OptionsDllDate: TDate; WindowsProductId: string[24]; Netpermanentallowed: boolean; Triangletime: integer; Fingertime: integer; SecretKey: String[48]; // leftfile, rightfile: String[240]; firstlinenames: boolean; recordseparator: String[24]; lineseparator:String[24]; // language: Naturallanguages; LocalDir: Texte; BackgroundColor: TColor; ButtonColor: TColor; ButtonSize: integer; FontName: String[48]; Font2Name: String[48]; FontColor: TColor; FontStyle: TFontStyles; FontSize: integer; Width: integer; Height: integer; BWidth: integer; BHeight: integer; Top: integer; Left: integer; Horsplitter: integer; VerSplitter: integer; ProgDir: String[KeyMax]; Workspace: String[KeyMax]; homedir: String[KeyMax]; SampleDir: String[KeyMax]; ExportDir: String[KeyMax]; ExecDir: String[KeyMax]; FirstUse: TDate; LastUse: TDate; DaysUsed: integer; DaysEffectivlyUsed: integer; Activated: boolean; Edition: Editions; Ablauf: TDate; FuncSearch: word; FuncReplace: word; FuncContReplace: word; FuncHelp: word; endofopts: ansichar;) end; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- TOptions = class(TForm) OKButton: TButton; Label3: TLabel; Label4: TLabel; Edit1: TEdit; Button2: TButton; Reset: TButton; Bevel1: TBevel; CheckBox1: TCheckBox; Label1: TLabel; Sprache: TLabel; Panel1: TPanel; Label2: TLabel; Edit2: TEdit; ComboBox1: TComboBox; Procedure InitOptions(optionsfilename: PChar); function netallowed: boolean; Procedure DefaultOptions(); procedure ResetClick(Sender: TObject); procedure OKButtonClick(Sender: TObject); function Lengthrtf(T: RTFTexte): LongInt; function OptLen(Start, Init, Ende: Pointer): LongInt; function OptSum(Start, Init, Ende: Pointer): LongInt; Procedure GetOptions(optionsfilename: PChar); Procedure PutOptions(optionsfilename: PChar); //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- function SetDaysUsed(Installkey: String; SK: String; Productnumber: char): boolean; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- function GetSecrets(Installkey: String; SK: String; Productnumber: char): integer; procedure setsecrets(Installkey: String; DaysUsed: integer; Productnumber: char); procedure FormShow(Sender: TObject); procedure CheckBox1Click(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure ComboBox1Click(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure FormHide(Sender: TObject); private { Private declarations } public { Public declarations } R: OwnOptions; oldlanguage: Naturallanguages; end; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- var Version: String; SavOptionsfilename: String; StartFolder: String; BatchRun, Recursive: boolean; LogFileOpen: boolean; LogFile: TExt; Im_Root: integer; Im_Branch: integer; Im_Level: integer; Im_State: integer; im_Error: integer; Dom: array [0 .. 2] of char; P6, P7: PChar; InitialMemory: LongInt; MS: TMemoryStatus; Lizenzmeldung: boolean; Opening, Closing, Loading: boolean; Inspectorkey: String; DiskType: integer; netflag: boolean; // webserver: String; ftpserver: String; login: String; passwort: String; homedir: String; picsmalldir: String; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- implementation function _getoptions(optsize: integer; optionsfilename: PChar; Opt: Pointer; callkey: integer): integer; cdecl; external OptionDll name '_getoptions'; function _putoptions(optsize: integer; optionsfilename: PChar; Opt: Pointer; callkey: integer): integer; cdecl; external OptionDll name '_putoptions'; function _activate(var sin: PAnsiChar; var sout: PAnsiChar; key: PAnsiChar) : integer; cdecl; external OptionDll name '_activate'; function _patchoptions(optsize: integer; optionsfilename: PChar; Opt: Pointer; callkey: integer; ipaddr: PChar; winprodid: PChar; diskid: PChar; edit: PChar) : integer; cdecl; external OptionDll name '_patchoptions'; {$R *.dfm} //------------------------------------------------------------------ //- Procedure PutOptions //- set Options //------------------------------------------------------------------ function TOptions.Lengthrtf(T: RTFTexte): LongInt; var l, e: integer; begin e := 0; for l := 0 to KeyMaxLong do if T[l] = chr(0) then e := l; Lengthrtf := e end; //---------------------------------------------------------------- } //- //- //---------------------------------------------------------------- } procedure TOptions.ComboBox1Click(Sender: TObject); begin if ComboBox1.ItemIndex = 0 then r.language := german else r.language := english; end; //---------------------------------------------------------------- } //function OptLen - } //set Options.R. - } //---------------------------------------------------------------- } function TOptions.OptLen(Start, Init, Ende: Pointer): LongInt; var B1, B2, B3: LongInt; ret: LongInt; begin B1 := DWord(Start); B2 := DWord(Init); B3 := DWord(Ende); ret := B3 - B1 + 1; with R do ret := ret + B2 - B1; Result := ret end; //---------------------------------------------------------------- //function CheckSumme //set Options.R. //---------------------------------------------------------------- function TOptions.OptSum(Start, Init, Ende: Pointer): LongInt; const max = 1000000; type PA = array [0 .. max] of byte; var P: ^PA; i, lbd, hbd: LongInt; CS: LongInt; B1, B2, B3: LongInt; begin P := Init; B1 := DWord(Start); B2 := DWord(Init); B3 := DWord(Ende); lbd := B2 - B1; hbd := B3 - B1; hbd := (hbd div 8 + 1) * 8; if max < hbd - lbd then HaltProgram(771); CS := 0; For i := lbd + 1 to hbd - 1 do CS := (CS + P^[i]) mod largeprime; OptSum := CS; end; //---------------------------------------------------------------- //test if net allowed // //---------------------------------------------------------------- function TOptions.netallowed: boolean; var bu: integer; begin if not(netflag or R.Netpermanentallowed) then begin bu := ask(105, 'In das Internet gehen?', ' ', [mbYes, mbNo, mbYestoAll]); netflag := bu in [mrYes, mrYesToAll]; if bu = mrYesToAll then R.Netpermanentallowed := true; end; Result := netflag; end; //---------------------------------------------------------------- } // //-------------------------------------------------------------- } procedure TOptions.FormHide(Sender: TObject); begin //ComboBox1Click(nil); end; //---------------------------------------------------------------- } // //-------------------------------------------------------------- } procedure TOptions.FormShow(Sender: TObject); var foreign:String; begin oldlanguage:=r.language; ModalResult := mrCancel; ComboBox1.Items.Clear; ComboBox1.Items.Add('deutsch'); foreign:=trans(1,'english'); ComboBox1.Items.Add(foreign); if r.language = german then ComboBox1.ItemIndex := 0 else ComboBox1.ItemIndex := 1; Edit1.Text := r.recordseparator; CheckBox1.Checked := r.firstlinenames; Edit2.Text:=r.lineseparator; end; //---------------------------------------------------------------- } //Procedure getOptions - } //set Options - } //---------------------------------------------------------------- } Procedure TOptions.GetOptions(optionsfilename: PChar); var callkey, oplen, opsum: LongInt; begin //define secure(a,b) if (!(b==a%63)) {exit(-911);} SavOptionsfilename := optionsfilename; with R do oplen := OptLen(@cc, @inited, @endofopts); callkey := (oplen div 8 + 1) * 8; //_patchoptions(callkey,optionsfilename,@R.CC,callkey mod 63,'87.16.230.129','55375-oem-0044992-91858',nil,nil); _getoptions(callkey, optionsfilename, @R.cc, callkey mod 63); if R.OptionLen <> oplen then HaltProgram(778); with R do opsum := OptSum(@cc, @inited, @endofopts); if R.OptionSum <> opsum then HaltProgram(779); end; //---------------------------------------------------------------- } //Procedure PutOptions - } //set Options - } //---------------------------------------------------------------- } Procedure TOptions.PutOptions(optionsfilename: PChar); var callkey, oplen: LongInt; begin //define secure(a,b) if (!(b==a%63)) {exit(-911);} with R do begin OptionSum := OptSum(@cc, @inited, @endofopts); OptionLen := OptLen(@cc, @inited, @endofopts); SavOptionsfilename := optionsfilename; oplen := OptLen(@cc, @inited, @endofopts); end; callkey := (oplen div 8 + 1) * 8; _putoptions(callkey, optionsfilename, @R.cc, callkey mod 63); end; //----------------------------------------------------------------- //Procedure getOptions - //set Options - //----------------------------------------------------------------- Procedure TOptions.InitOptions(optionsfilename: PChar); var ODate: TDate; OVers: String; begin Version := getFileVersion(ParamStr(0)); if Not FileExists(optionsfilename) then begin CreateDir(ExtractFileDir(optionsfilename)); DefaultOptions(); PutOptions(optionsfilename) end else begin GetOptions(optionsfilename); //check options version ODate := getFileAge(ParamStr(0)); if DaysBetween(ODate, R.Objectdate) > 0 then begin inform(97, 'Die Optionen müssen zurückgestzt werden wegen des neuen Dateidatums ', DateToStr(ODate)); DeleteFile(PChar(optionsfilename)); DefaultOptions(); Width := screen.Width div 2; Height := screen.Height div 2; end; OVers := Utilities.getFileVersion(ParamStr(0)); if OVers > R.Version then begin inform(98, 'Die Optionen müssen zurückgestzt werden wegen der neuen Dateiversion ', OVers); DeleteFile(PChar(optionsfilename)); DefaultOptions(); Width := screen.Width div 2; Height := screen.Height div 2; end; end; // R.Callcount := R.Callcount + 1; netflag := false; end; //------------------------------------------------------------------ } //- keep track of daysused ue - } //- - } //------------------------------------------------------------------ } function TOptions.SetDaysUsed(Installkey: String; SK: String; Productnumber: char): boolean; var key: integer; re: boolean; begin re := true; if Installkey > '' then begin If DateOf(Now) >= R.FirstUse then R.LastUse := DateOf(Now); key := GetSecrets(Installkey, SK, Productnumber); if (key <> R.DaysUsed) then begin //Error(111,'Schlüssel ungleich'); re := false; end; R.DaysUsed := DaysBetween(R.LastUse, R.FirstUse); if dayof(Now) <> dayof(R.LastUse) then R.DaysEffectivlyUsed := R.DaysEffectivlyUsed + 1; setsecrets(Installkey, R.DaysUsed, Productnumber); end; SetDaysUsed := re; end; //------------------------------------------------------------------ //Procedure DefaultOptions - //set Options - //------------------------------------------------------------------ procedure TOptions.CheckBox1Click(Sender: TObject); begin R.firstlinenames := CheckBox1.Checked; end; //------------------------------------------------------------------ //Procedure DefaultOptions - //set Options - //------------------------------------------------------------------ Procedure TOptions.DefaultOptions(); const //production cwebserver = 'www.server.de'; //www.center-apotheke.de cftpserver = 'ftp.server.de'; //ftp.center-apotheke.de clogin = 'Benutzer'; //'centerapotheke'; cpasswort = 'Kennwort'; //md4989 chomedir = '/Verzeichnis/'; // /Center-Apotheke/ cartikeldir = 'Artikel/'; cpicsmalldir = 'Artikel\small\'; //test dwebserver = 'localhost:8080'; dftpserver = 'localhost'; dlogin = 'jens'; dpasswort = 'jdd878'; dhomedir = '/Center-Apotheke/'; dartikeldir = 'Artikel/'; dpicsmalldir = 'Artikel\small\'; var i, n: integer; Prog, Ofile: String; begin with R do begin n := OptLen(@cc, @inited, @endofopts); for i := 1 to n do cc[i] := chr(0); //software data Callcount := 0; Version := Utilities.getFileVersion(ParamStr(0)); Objectdate := Utilities.getFileAge(ParamStr(0)); ObjectLen := Utilities.getFileLength(ParamStr(0)); ObjectSum := Utilities.getFileSum(ParamStr(0)); // Ofile := ExtractfilePath(ParamStr(0)) + OptionDll; OptionsDlllen := getFileLength(Ofile); OptionsDllsum := getFileSum(Ofile); OptionsDllDate := trunc(Utilities.getFileAge(Ofile)); // WindowsProductId := GetWinProductId; //installation ProgDir := ExtractfilePath(ParamStr(0)); SampleDir := ProgDir + SamplesDir; Workspace := ProgDir + Workspace; ExecDir := ProgDir + ExecDir; ExportDir := GetCurrentDir; //----------------------------------------------------------------------------- //Licensing //----------------------------------------------------------------------------- Activated := false; FirstUse := DateOf(Now); LastUse := DateOf(Now); DaysEffectivlyUsed := 0; DaysUsed := 0; Edition := Shareware; Activated := false; //----------------------------------------------------------------------------- //optionen //----------------------------------------------------------------------------- Netpermanentallowed := false; language := german; if FileExists(CommonOptionsDir(Application.Title) + 'en') then language := english; LocalDir := ExtractfilePath(optionsfilename(Title)); if not DirectoryExists(LocalDir) then CreateDir(LocalDir); // leftfile := ''; rightfile := ''; recordseparator := ','; lineseparator:='#13#10'; // Width := 650; Height := 360; BWidth := 800; BHeight := 600; Horsplitter := Height div 3; VerSplitter := Width div 3; Top := (screen.Height) div 8; Left := (screen.Width div 2) - (Width div 2); // Prog := ProgDir + SAutor; BackgroundColor := clWhite; ButtonSize := 5; FontName := 'Fixedsys'; FontName := 'Courier New'; FontSize := 9; Edition := Shareware; FuncHelp := Key_F1; FuncSearch := Key_F3; FuncReplace := Key_F4; FuncContReplace := Key_F5; FuncHelp := Key_F1; endofopts := 'x'; inited := 'j'; CheckSum := 0; end; end; //------------------------------------------------------------------------------ // //------------------------------------------------------------------------------ procedure TOptions.Edit1Change(Sender: TObject); begin if Edit1.Text > '' then Hex2String(Edit1.Text); if Length(edit1.Text) <= 24 then r.recordseparator := Edit1.Text else ShowMessage(trans(10, 'Maximal 24 Zeichen')); end; //------------------------------------------------------------------------------ // //------------------------------------------------------------------------------ procedure TOptions.Edit2Change(Sender: TObject); begin if Edit2.Text > '' then Hex2String(Edit2.Text); if Length(edit2.Text) <= 24 then r.lineseparator := Edit2.Text else ShowMessage(trans(10, 'Maximal 24 Zeichen')); end; //------------------------------------------------------------------------------ //externalcode from delphi.about.com -- Windows Code !! //------------------------------------------------------------------------------ function BrowseDialogCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: lParam) : integer stdcall; var wa, rect: TRect; dialogPT: TPoint; begin //center in work area if uMsg = BFFM_INITIALIZED then begin wa := screen.WorkAreaRect; GetWindowRect(Wnd, rect); dialogPT.x := ((wa.Right - wa.Left) div 2) - ((rect.Right - rect.Left) div 2); dialogPT.Y := ((wa.Bottom - wa.Top) div 2) - ((rect.Bottom - rect.Top) div 2); MoveWindow(Wnd, dialogPT.x, dialogPT.Y, rect.Right - rect.Left, rect.Bottom - rect.Top, true); SendMessage(Wnd, BFFM_SETSELECTION, 1, integer(@StartFolder[1])); end; Result := 0; end; //------------------------------------------------------------------------------ //externalcode from delphi.about.com -- Windows Code !! //------------------------------------------------------------------------------ function BrowseDialog(const Title: string; const Flag: integer): string; var lpItemID: PItemIDList; BrowseInfo: TBrowseInfo; DisplayName: array [0 .. MAX_PATH] of char; TempPath: array [0 .. MAX_PATH] of char; begin Result := ''; FillChar(BrowseInfo, SizeOf(TBrowseInfo), #0); with BrowseInfo do begin hwndOwner := Application.Handle; pszDisplayName := @DisplayName; lpszTitle := PChar(Title); ulFlags := Flag; lpfn := BrowseDialogCallBack; end; lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemID <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); Result := TempPath; GlobalFreePtr(lpItemID); end; end; //---------------------------------------------------------------------------- //Zurücksetzen //---------------------------------------------------------------------------- procedure TOptions.ResetClick(Sender: TObject); begin if ask(99, 'Wirklich alles löschen?', '', []) = mrYes then begin screen.Cursor := crHourGlass; DefaultOptions(); PutOptions(PChar(optionsfilename(Title))); screen.Cursor := crDefault; inform(100, 'Bitte starten Sie das Programm erneut.', ''); ExitProcess(711); end; end; //---------------------------------------------------------------------------- // //---------------------------------------------------------------------------- procedure TOptions.OKButtonClick(Sender: TObject); begin //inherited; Close(); ModalResult := mrOK; end; //----------------------------------------------------------------- //function setsecrets - //- //----------------------------------------------------------------- function TOptions.GetSecrets(Installkey: String; SK: String; Productnumber: char): integer; var r2: integer; begin r2 := -1; if DiskType <> DRIVE_REMOVABLE then begin //r1:=GetSecretRegistryValue(Installkey,Productnumber); //r2:=GetSecretFile(Installkey,SK,Productnumber); //if r1<>r2 then //r2:=-1; end; GetSecrets := r2 end; //------------------------------------------------------------------ //Procedure Setl //moving of short arrays //------------------------------------------------------------------ procedure TOptions.setsecrets(Installkey: String; DaysUsed: integer; Productnumber: char); begin //empry end; //---------------------------------------------------------------------------- //Procedure KeyFile //set Cryptokey // //---------------------------------------------------------------------------- Function KeyFile(var key: array of char): String; var i, nu: integer; KeyF: String; begin KeyF := getDiskId(PChar(MidStr(GetCurrentDir, 1, 3))); KeyF := StringReplace(KeyF, ' ', 'X', [rfReplaceAll]); KeyF := 'O' + KeyF; for i := 1 to length(KeyF) do begin nu := (ord(KeyF[i]) + 7) mod 26; nu := nu + ord('a'); KeyF[i] := chr(nu); end; KeyFile := 'F' + KeyF + '.key'; end; //------------------------------------------------------------------ } //- - } //- Ende dieser Quelle - } //- - } //------------------------------------------------------------------ } end.

                                                                                                                                                                                                                                                                                                                                                                                                     

Neuigkeiten

     Aktuelles
     Motto des Tages

letze Version des Elbe Quellennavigators

Jenseits des Üblichen ....

Besucher

Besucher
Statistik
#Sources=1126864
#Domains=2039723