|
|
|
|
Quellcode-Bibliothek
© Kompilation durch diese Firma
[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]
Datei:
Options.pas.~128~
Sprache: Unknown
rahmenlose Ansicht.~133~ DruckansichtDelphi {Delphi[106] CS[190] Ada[201]}Entwicklung
unit Options;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, ShellApi, ShlObj, DateUtils,
StrUtils, GenDefs,
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
Utilities, 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 = 'Samples\';
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, ergfile: String[240];
firstlinenames: boolean;
recordnumbersonly: boolean;
recordseparator: String[24];
lineseparator: String[24];
fielddelimiter: String[24];
escapecharacter: String[24];
splitterleft:integer;
decimalpoint:char;
//
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];
UserName: String[KeyMax];
FirstUse: TDate;
LastUse: TDate;
DaysUsed: integer;
DaysEffectivlyUsed: integer;
NextCheck : TDateTime;
Activated: boolean;
Activationstart: 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;
Label5: TLabel;
Edit3: TEdit;
Edit4: TEdit;
Label6: TLabel;
CheckBox2: TCheckBox;
Label7: TLabel;
Edit5: TEdit;
Procedure InitOptions(optionsfilename: PChar);
function netallowed: boolean;
function getSamplesDir(Title: String): String;
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);
procedure Edit3Change(Sender: TObject);
procedure Edit4Change(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure Edit5Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
R: OwnOptions;
oldlanguage: Naturallanguages;
end;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
var
Opt: TOptions;
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.CheckBox2Click(Sender: TObject);
begin
r.recordnumbersonly := CheckBox2.Checked;
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;
CheckBox2.Checked := r.recordnumbersonly;
Edit2.Text := r.lineseparator;
edit3.Text := r.fielddelimiter;
edit4.Text := r.escapecharacter;
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.getSamplesDir(Title: String): String;
var
res: String;
begin
//
res := R.ProgDir + trans(40, 'Beispiele') + '\';
if IsDebuggerPresent then
res := R.ProgDir + 'Testdata\';
result := res
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 + trans(40, 'Beispiele') + '\';
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;
NextCheck := incday(Now, MaxFreeDays);
//-----------------------------------------------------------------------------
//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 := '';
ergfile := '';
recordseparator := ',';
lineseparator := '#13#10';
fielddelimiter := '"';
escapecharacter := '\';
firstlinenames := false;
recordnumbersonly := false;
splitterleft:=0;
decimalpoint:=',';
//
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';
FontStyle:= [];
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
errorn(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
errorn(10, 'Maximal 24 Zeichen');
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit3Change(Sender: TObject);
begin
if Edit3.Text > '' then
Hex2String(Edit3.Text);
if Length(Edit3.Text) <= 24 then
r.fielddelimiter := Edit3.Text
else
errorn(10, 'Maximal 24 Zeichen');
end;
//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit4Change(Sender: TObject);
begin
if Edit4.Text > '' then
Hex2String(Edit4.Text);
if Length(Edit4.Text) <= 24 then
r.escapecharacter := Edit4.Text
else
errorn(10, 'Maximal 24 Zeichen');
end;
procedure TOptions.Edit5Change(Sender: TObject);
begin
if length(edit5.Text)=1 then
r.decimalpoint:=Edit5.Text[1]
else
error();
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.
[ Verzeichnis aufwärts0.327unsichere Verbindung
]
|
|
|
|
|
|
