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


Quelle  Options.pas.~80~   Sprache: unbekannt

 
Spracherkennung für: .~80~ vermutete Sprache: Unknown {[0] [0] [0]} [Methode: Schwerpunktbildung, einfache Gewichte, sechs Dimensionen]

unit Options;

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

//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,
  Utilities, StdCtrls, Buttons, ShellApi, ShlObj, DateUtils, StrUtils, GenDefs,
  language, ExtCtrls, ComCtrls;

//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
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;
          separator: String[24];
          lineend: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 Hex2String(S: String):String;
    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.separator;
  CheckBox1.Checked := r.firstlinenames;
  Edit2.Text:=r.lineend;
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 := '';
    separator := ',';
    lineend:='#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;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
function TOptions.Hex2String(S: String):String;
var i,ll,code:integer;OS:String;
begin
  OS:='';
  if S > '' then begin
    i:=0;
    ll:=Length(S);
    while i<ll do begin
      i:=i+1;
      if S[i]='#' then begin
        code:=0;i:=i+1;
        while (i<ll) and CharInSet(S[i],['0'..'9']) do begin
          code:=10*code+ord(S[i])-ord('0');
          i:=i+1;
        end;
       if code=0 then
       ShowMessage(trans(31, 'Zeichen #00 ist ungültig'))
        else OS:=OS+chr(code);
      end else
      OS:=OS+S[i];
    end;
  end;
  result:=OS
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit1Change(Sender: TObject);
begin
  if Edit1.Text > '' then
    Edit1.Text:=Hex2String(Edit1.Text);
    if Length(edit1.Text) <= 24 then
      r.separator := Edit1.Text
    else
      ShowMessage(trans(10, 'Maximal 24 Zeichen'));
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit2Change(Sender: TObject);
begin
  if Edit2.Text > '' then
    Edit2.Text:=Hex2String(Edit2.Text);
    if Length(edit2.Text) <= 24 then
      r.lineend := 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.

[ Dauer der Verarbeitung: 0.75 Sekunden  ]

                                                                                                                                                                                                                                                                                                                                                                                                     


Neuigkeiten

     Aktuelles
     Motto des Tages

Software

     Produkte
     Quellcodebibliothek

Aktivitäten

     Artikel über Sicherheit
     Anleitung zur Aktivierung von SSL

Muße

     Gedichte
     Musik
     Bilder

Jenseits des Üblichen ....

Besucherstatistik

Besucherstatistik

Monitoring

Montastic status badge