delphi代码创建bde别名示例

实际应用中可能需要程序自动创建BDE别名

特试建 MSsql和paradox数据库别名

//单元代码

unit Unit11;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DBTables;

type
  TForm11 = class(TForm)
    mmo1: TMemo;
    btn1: TButton;
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form11: TForm11;

implementation

{$R *.dfm}

procedure TForm11.btn1Click(Sender: TObject);
var
  lst: TStringList;

  procedure DropALias(const AliasName : string);
  begin
    if lst.IndexOf(AliasName)<>-1 then
   begin
     Session.DeleteAlias(AliasName);
     Session.SaveConfigFile;
     mmo1.lines.add('Drop Alias[' + ALiasName + ']');
   end;
  end;

  procedure AddParadox(const AliasName : string);
  begin
    DropALias(AliasName);
    try
      Session.AddStandardAlias(AliasName,'c:\instance1','Paradox');
      Session.SaveConfigFile;  //保存BDE配置文件
      mmo1.lines.add('Save Alias[' + ALiasName + ']');
    except
      on e : Exception do
        Application.MessageBox(PChar(e.message),'错误',MB_ICONERROR+mb_OK);
    end;
  end;

  procedure AddMSSql(const AliasName : string);
  const ServerStr = '.'; //服务器地址(本机)
  var
    AliasLst: TStringList;
  begin
    DropALias(AliasName);

    try
      Session.AddStandardAlias(AliasName,'','MSSQL');
      Session.SaveConfigFile;
      AliasLst := TStringList.Create;
      try
        with AliasLst do
        begin
          Add('User name=sa');
          Add('SQLQRYMODE=SERVER');
          add('Server name='+ServerStr);
          add('DataBase name=test');
        end;

        Session.ModifyAlias(AliasName, AliasLst);
        Session.SaveConfigFile;
        mmo1.lines.add('Save Alias[' + ALiasName + ']');
      finally
        AliasLst.free;
      end;
    except
      on e : Exception do
        Application.MessageBox(PChar(e.message),'错误',MB_ICONERROR+mb_OK);
    end;
  end;
begin
  lst:=TStringlist.Create;
  try
    Session.GetAliasNames(lst);  //取得别名列表

    //Paradox
    AddParadox('NewParadox');
    //MSSq
    AddMSSql('NewSql');
  finally
    lst.free;
  end;
end;

end.