Delphi World - Изменение конфигурации IDAPI
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Изменение конфигурации IDAPI

Автор: Eryk Bottomley

Возможно ли установить параметр MAXFILEHANDLES в IDAPI.CFG посредством Delphi?

Да. Следующий компонент показывает как это можно сделать (а также изменить другие параметры):


unit CFGTOOL;

interface

uses SysUtils, Classes, DB, DbiProcs, DbiTypes, DbiErrs;

type
  TBDEConfig = class(TComponent)
  private
    FLocalShare: Boolean;
    FMinBufSize: Integer;
    FMaxBufSize: Integer;
    FSystemLangDriver: string;
    FParadoxLangDriver: string;
    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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования