Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: Options.pas Sprache: Delphi

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;
          recordseparator: String[24];
          lineseparator: String[24];
          fielddelimiter: String[24];
          escapecharacter: String[24];
          splitterleft: integer;
          decimalpoint: char;
          searchstring: String[24];
          recordnumbersonly: boolean;
          leftkeys: String[24];
          rightkeys: String[24];
          Colwidths: array [1 .. 2, 0 .. 100] of integer;
          Colleftfile, Colrightfile: String[240];
          PreferedColumn: integer;
          regexsearch: String[240];
          //
          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;
    Panel2: TPanel;
    Label8: TLabel;
    Label9: TLabel;
    Edit6: TEdit;
    Edit7: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Edit8: TEdit;
    Edit9: 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);
    Procedure PanEnable();
    procedure Edit6Change(Sender: TObject);
    procedure Edit7Change(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;
  panenable();
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;
  Panenable();
  Edit2.Text := r.lineseparator;
  edit3.Text := r.fielddelimiter;
  edit4.Text := r.escapecharacter;
  edit5.Text := r.decimalpoint;
  Edit6.Text := r.leftkeys;
  Edit7.Text := r.rightkeys;
end;

//---------------------------------------------------------------- }
//
//---------------------------------------------------------------- }
Procedure TOptions.PanEnable();
begin
  with Panel2 do begin
    label8.Enabled := r.recordnumbersonly;
    label9.Enabled := r.recordnumbersonly;
    Edit6.Enabled := r.recordnumbersonly;
    Edit7.Enabled := r.recordnumbersonly;
  end;
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ückgesetzt 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, j, 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 := '';
    lineseparator := '#13#10';
    fielddelimiter := '"';
    escapecharacter := '\';
    firstlinenames := false;
    recordnumbersonly := false;
    leftkeys := '1';
    rightkeys := '1';
    splitterleft := 0;
    if language = english then begin
      decimalpoint := '.';
      recordseparator := ';';
    end
    else begin
      recordseparator := ',';
      decimalpoint := ',';
    end;
    searchstring := '';
    for i := 1 to 2 do
      for j := 0 to length(Colwidths) - 1 do
        Colwidths[i, j] := 0;
    //
    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 (Edit3.Text <> opt.R.decimalpoint) then
    r.fielddelimiter := Edit3.Text
  else
    errorn(10, 'Maximal 1 Zeichen, ungleich Begrenzer');
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 1 Zeichen, ungleich Begrenzer');
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit5Change(Sender: TObject);
begin
  if (length(edit5.Text) = 1) and (Edit5.Text <> opt.R.fielddelimiter) then
    r.decimalpoint := Edit5.Text[1]
  else
    errorn(55, 'Nur ein Zeichen');
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
function checkexpress(S: String): boolean;
const
  seq = ['0' .. '9', ','];
var
  i, ll: integer;
  res: boolean;
begin
  res := true;
  ll := length(S);
  for i := 1 to ll do
    res := res and CharInSet(S[i], seq);
  if (ll > 0) and ((S[ll] = ',') or (S[ll] = ',')) then
    res := false;
  if S='0' then res:=false;
  result := res
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit6Change(Sender: TObject);
begin
  edit6.Font.Color := clBlack;
  if checkexpress(edit6.Text) then
    r.leftkeys := edit6.Text
  else
    edit6.font.Color := clRed;
end;

//------------------------------------------------------------------------------
//
//------------------------------------------------------------------------------
procedure TOptions.Edit7Change(Sender: TObject);
begin
  edit7.Font.Color := clBlack;
  if checkexpress(edit7.Text) then
    r.rightkeys := edit7.Text
  else
    edit7.font.Color := clRed;
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.40 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.