以程式更改 BDE 參數 (適用於 BDE 4.50 或之前的版本)

procedure SetConfigParameter2(Param: string; Value: string);
var
  hCfg: hDBICfg;
  Config: SYSConfig;
  Path, Option: string;
  ParamCount, I: word;
  pFields, pFld: pFLDDesc;
  pRecBuf, pRec: pBYTE;
  Found, SelfInitialized: boolean;
  rslt: DBIResult;

begin
  {$Ifdef WIN32}
  hCfg := nil; pFld := nil; pRec := nil; 
  Found := False; 
  SelfInitialized := False;
  try
    if Pos(';', Param) = 0 then
      raise EDatabaseError.Create(
       'Invalid parameter passed to function. There must ' +
       'be a semi-colon delimited sting passed');
    Path := Copy(Param, 0, Pos(';', Param) - 1);
    Option := Copy(Param, Pos(';', Param) + 1, 
                   Length(Param) - Pos(';', Param));

    rslt := DbiGetSysConfig(Config);
    if rslt <> DBIERR_NONE then
    begin
      if rslt = DBIERR_NOTINITIALIZED then // Engine not initialized...
      begin
        SelfInitialized := True;
        DbiInit(nil);
        Check(DbiGetSysConfig(Config));
      end
      else
        Check(rslt);
    end;
    (* DbiOpenConfigFile is defined as such:
        function DbiOpenConfigFile (            // Open/Create config
              pszDirPath    : PChar;            // Directory 
              bCreate       : Bool;             // TRUE to create/overwrite 
        var   hCfg          : hDBICfg           // Handle to config 
                           ): DBIResult stdcall; *)
    Check(DbiOpenConfigFile(Config.szIniFile, FALSE, hCfg));

    (* DbiCfgGetRecord is defined as such:
        function DbiCfgGetRecord (              { Get a record }
              hCfg          : hDBICfg;          { Config Handle/NULL }
              pszCfgPath    : PChar;            { Path }
        var   iFields       : Word;             { Returned nbr of fields }
              pfldDesc      : pFLDDesc;         { Field descriptors }
              pRec          : Pointer           { Field values }
                           ): DBIResult stdcall; *)
    { Call it without the field and record buffer to get the count... }
    Check(DbiCfgGetRecord(hCfg, PChar(Path), ParamCount, nil, nil));

    pFields := AllocMem(ParamCount * sizeof(FLDDesc));
    pFld := pFields;
    pRecBuf := AllocMem(10000);
    pRec := pRecBuf;

    { Get the node values... }
    Check(DbiCfgGetRecord(hCfg, PChar(Path), ParamCount, pFields, pRecBuf));

    for I := 0 to ParamCount - 1 do
    begin
      if pFields^.szName = Option then
      begin
        StrPCopy(PChar(pRecBuf), Value);

        (* DbiCfgModifyRecord is defines as such:
             function DbiCfgModifyRecord (           { Modify a record }
                   hCfg          : hDBICfg;          { Config Handle/NULL }
                   pszCfgPath    : PChar;            { Path }
                   iFields       : Word;             { Nbr of fields }
                   pfldDesc      : pFLDDesc;         { Field descriptors }
                   pRec          : Pointer           { Data values }
                ): DBIResult stdcall; *)
        Check(DbiCfgModifyRecord(hCfg,  PChar(Path), ParamCount, pFld,
pRec));

        Found := True;
      end;
      Inc(pFields);
      Inc(pRecBuf, 128);
    end;
    if Found = False then
      raise EDatabaseError.Create(Param + ' entry was not found in
configuration file');

  finally
    if pFld <> nil then
      FreeMem(pFld);
    if pRec <> nil then
      FreeMem(pRec);
    if hCfg <> nil then

    (* DbiCloseConfigFile is defined as such:
           function DbiCloseConfigFile (           { Close the config file }
           var   hCfg          : hDBICfg;          { Handle }
                 bSave         : Bool;             { To save the changes }
                 bDefault      : Bool;             { To make this file the
default }
                 bSaveAs16     : Bool              { To save as a 16-bit
config file }
              ): DBIResult stdcall; *)
      { Close and save the config file... }
    Check(DbiCloseConfigFile(hCfg, TRUE, TRUE, FALSE));
    if SelfInitialized = True then

      DbiExit;
  end;
  {$Else}
     raise EDatabaseError.Create('Non supported function in 16 bit');
  {$EndIf}
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
  SetConfigParameter2('\DRIVERS\PARADOX\INIT\;NET DIR', 'c:\bdenet');
end;