Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

 FMaxFileHandles : Integer;

 FNetFileDir : String;

 FTableLevel : String;

 FBlockSize : Integer;

 FDefaultDriver : String;

 FStrictIntegrity : Boolean;

 FAutoODBC : Boolean;

 procedure Init;

 procedure SetLocalShare(Value : Boolean);

 procedure SetMinBufSize(Value : Integer);

 procedure SetMaxBufSize(Value : Integer);

 procedure SetSystemLangDriver(Value : String);

 procedure SetParadoxLangDriver(Value : String);

 procedure SetMaxFileHandles(Value : Integer);

 procedure SetNetFileDir(Value : String);

 procedure SetTableLevel(Value : String);

 procedure SetBlockSize(Value : Integer);

 procedure SetDefaultDriver(Value : String);

 procedure SetAutoODBC(Value : Boolean);

 procedure SetStrictIntegrity(Value : Boolean);

 procedure UpdateCFGFile(path, item, value : string);

protected

public

 constructor Create(AOwner: TComponent); override;

 destructor Destroy; override;

published

 property LocalShare : Boolean read FLocalShare write SetLocalShare;

 property MinBufSize : Integer read FMinBufSize write SetMinBufSize;

 property MaxBufSize : Integer read FMaxBufSize write SetMaxBufSize;

 property SystemLangDriver : String read FSystemLangDriver write SetSystemLangDriver;

 property ParadoxLangDriver : String read FParadoxLangDriver write SetParadoxLangDriver;

 property MaxFileHandles : Integer read FMaxFileHandles write SetMaxFileHandles;

 property NetFileDir : String read FNetFileDir write SetNetFileDir;

 property TableLevel : String read FTableLevel write SetTableLevel;

 property BlockSize : Integer read FBlockSize write SetBlockSize;

 property DefaultDriver : string read FDefaultDriver write SetDefaultDriver;

 property AutoODBC : Boolean read FAutoODBC write SetAutoODBC;

 property StrictIntegrity : Boolean read FStrictIntegrity write SetStrictIntegrity;

end;

procedure Register;

implementation

function StrToBoolean(Value : string) : Boolean;

begin

 if (UpperCase(Value) = 'TRUE') or (UpperCase(Value) = 'ON') or (UpperCase(Value) = 'YES') or (UpperCase(Value) = '.T.' ) then Result := True

 else Result := False;

end;

function BooleanToStr(Value : Boolean) : String;

begin

 if Value then Result := 'TRUE'

 else Result := 'FALSE';

end;

procedure Register;

begin

 RegisterComponents('Data Access', [TBDEConfig]);

end;

procedure TBDEConfig.Init;

var

 h: hDBICur;

 pCfgDes: pCFGDesc;

 n, v : string;

begin

 Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'\SYSTEM\INIT', h));

 GetMem(pCfgDes, sizeof(CFGDesc));

 try

  FillChar(pCfgDes^, sizeof(CFGDesc), #0);

  while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin

   n := StrPas(pCfgDes^.szNodeName);

   v := StrPas(pCfgDes^.szValue);

   if n = 'LOCAL SHARE' then FLocalShare := StrToBoolean(v)

   else if n = 'MINBUFSIZE' then FMinBufSize := StrToInt(v)

   else if n = 'MAXBUFSIZE' then FMaxBufSize := StrToInt(v)

   else if n = 'MAXFILEHANDLES' then FMaxFileHandles := StrToInt(v)

   else if n = 'LANGDRIVER' then FSystemLangDriver := v

   else if n = 'AUTO ODBC' then FAutoODBC := StrToBoolean(v)

   else if n = 'DEFAULT DRIVER' then FDefaultDriver := v;

  end;

  if (h <> nil) then DbiCloseCursor(h);

  Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent,'\DRIVERS\PARADOX\INIT', h));

  FillChar(pCfgDes^, sizeof(CFGDesc), #0);

  while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin

   n := StrPas(pCfgDes^.szNodeName);

   v := StrPas(pCfgDes^.szValue);

   if n = 'NET DIR' then FNetFileDir := v

   else if n = 'LANGDRIVER' then FParadoxLangDriver := v;

  end;

  if (h <> nil) then DbiCloseCursor(h);

  Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, '\DRIVERS\PARADOX\TABLE CREATE', h));

  FillChar(pCfgDes^, sizeof(CFGDesc), #0);

  while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin

   n := StrPas(pCfgDes^.szNodeName);

   v := StrPas(pCfgDes^.szValue);

   if n = 'LEVEL' then FTableLevel := v

   else if n = 'BLOCK SIZE' then FBlockSize := StrToInt(v)

   else if n = 'STRICTINTEGRITY' then FStrictIntegrity := StrToBoolean(v);

  end;

 finally

  FreeMem(pCfgDes, sizeof(CFGDesc));

  if (h <> nil) then DbiCloseCursor(h);

 end;

end;

procedure TBDEConfig.SetLocalShare(Value : Boolean);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'LOCAL SHARE', BooleanToStr(Value));

 FLocalShare := Value;

end;

procedure TBDEConfig.SetMinBufSize(Value : Integer);

begin

UpdateCfgFile('\SYSTEM\INIT', 'MINBUFSIZE', IntToStr(Value));

 FMinBufSize := Value;

end;

procedure TBDEConfig.SetMaxBufSize(Value : Integer);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'MAXBUFSIZE', IntToStr(Value));

 FMaxBufSize := Value;

end;

procedure TBDEConfig.SetSystemLangDriver(Value : String);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'LANGDRIVER', Value);

 FSystemLangDriver := Value;

end;

procedure TBDEConfig.SetParadoxLangDriver(Value : String);

begin

 UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'LANGDRIVER', Value);

 FParadoxLangDriver := Value;

end;

procedure TBDEConfig.SetMaxFileHandles(Value : Integer);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'MAXFILEHANDLES', IntToStr(Value));

 FMaxFileHandles := Value;

end;

procedure TBDEConfig.SetNetFileDir(Value : String);

begin

 UpdateCfgFile('\DRIVERS\PARADOX\INIT', 'NET DIR', Value);

 FNetFileDir := Value;

end;

procedure TBDEConfig.SetTableLevel(Value : String);

begin

 UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'LEVEL', Value);

 FTableLevel := Value;

end;

procedure TBDEConfig.SetBlockSize(Value : Integer);

begin

 UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'BLOCK SIZE', IntToStr(Value));

 FBlockSize := Value;

end;

procedure TBDEConfig.SetStrictIntegrity(Value : Boolean);

begin

 UpdateCfgFile('\DRIVERS\PARADOX\TABLE CREATE', 'STRICTINTEGRITY', BooleanToStr(Value));

 FStrictIntegrity := Value;

end;

procedure TBDEConfig.SetDefaultDriver(Value : String);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'DEFAULT DRIVER', Value);

 FDefaultDriver := Value;

end;

procedure TBDEConfig.SetAutoODBC(Value : Boolean);

begin

 UpdateCfgFile('\SYSTEM\INIT', 'AUTO ODBC', BooleanToStr(Value));

 FAutoODBC := Value;

end;

procedure TBDEConfig.UpdateCFGFile;

var

 h : hDbiCur;

 pCfgDes: pCFGDesc;

 pPath : array[0..127] of char;

begin

 StrPCopy(pPath,Path);

 Check(DbiOpenCfgInfoList(nil, dbiREADWRITE, cfgPersistent, pPath, h));

 GetMem(pCfgDes, sizeof(CFGDesc));

 try

  FillChar(pCfgDes^, sizeof(CFGDesc), #0);

  while (DbiGetNextRecord(h, dbiWRITELOCK, pCfgDes, nil) = DBIERR_NONE) do begin

   if StrPas(pCfgDes^.szNodeName) = item then begin

    StrPCopy(pCfgDes^.szValue, value);

    Check(DbiModifyRecord(h, pCfgDes, True));

   end;

  end;

 finally

  FreeMem(pCfgDes, sizeof(CFGDesc));

  if (h <> nil) then DbiCloseCursor(h);

 end;

end;

constructor TBDEConfig.Create(AOwner: TComponent);

begin

 inherited Create(AOwner);

 Init;

end;

destructor TBDEConfig.Destroy;

begin

 inherited Destroy;

end;

end.