{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Eryk Bottomley

var

d: TDataBase;

begin

d:= TDataBase.Create (Application);

d.DataBaseName:= 'PRIV';

d.DriverName:= 'STANDARD';

d.Params.Add ('PATH=' Session.PrivateDir);

d.Connected:= True;

end;

…теперь вы имеете псевдоним с именем 'PRIV', указывающий на частный каталог.

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

var

MyAliasPath: string;

const

AliasName = 'MyAlias';

{**** Получаем из BDE путь MyAlias}

ParamsList:= TStringList.Create;

try

with Session do

begin

Session.GetAliasNames (ParamsList);

Session.GetAliasParams (AliasName, ParamsList);

MyAliasPath:= Copy (ParamsList[0], 6, 50) '\';

end;

finally

ParamsList.Free;

end;

Как через конфигурацию IDAPI получить физический каталог расположения базы данных, зная ее псевдоним?

Обратите внимание на метод GetAliasParams класса TSession.

Возвращенная строка будет содержать искомый путь.

Я пользуюсь следующей функцией:

uses DbiProcs, DBiTypes;

function GetDataBaseDir (const Alias: string): string;

(* Возвращает каталог расположения базы данных по заданному псевдониму

(без обратного слеша) *)

var

sp: PChar;

Res: pDBDesc;

begin

try

New (Res);

sp:= StrAlloc (length (Alias) 1);

StrPCopy (sp, Alias);

if DbiGetDatabaseDesc (sp, Res) = 0 then

Result:= StrPas (Res^.szPhyName)

else

Result:= '';

finally

StrDispose (sp);

Dispose (Res);

end;

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

procedure TForm1.Button3Click (Sender: TObject);

var

MyList: TStringList;

begin

MyList:= TStringList.Create;

try

with MyList do

begin

Add ('SERVER NAME=IB_SERVER:/PATH/DATABASE.GDB');

Add ('USER NAME=MYNAME');

end;

Session1.AddAlias ('NewIBAlias', 'INTRBASE', MyList);

finally

MyList.Free;

end;

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

procedure CreateAlias ();

const

DlPs = 5;

var

wrstr, wrstr1:string;

AParams: TStringList;

Psevdonm: array [1..DlPs] of string;

i: integer;

begin

//Заполним массив

Psevdonm[1]:= 'TERMNNSI,NSI'; // имя,каталог

Psevdonm[2]:= 'TERMNBASE,BASE';

Psevdonm[3]:= 'TERMNTNL,BASE\TNL';

Psevdonm[4]:= 'TERMNARH,ARH';

Psevdonm[5]:= 'TERMNTELE,TELE';

// if not DirectoryExists (datapath) then begin

// createdir (datapath);

// end;

for i:= 1 to DlPs do

begin

// Для начала проверим каталоги

wrstr1:= Copy (Psevdonm[i],Pos (',',Psevdonm[i]) 1, Length (Psevdonm[i])-Pos (',',Psevdonm[i]) 1);

if not DirectoryExists (wrstr1) then

begin

CreateDirectory (PChar (CurrntDir '\' wrstr1),nil);

end;

// Если нет псевдонима, то создадим или подправим

wrstr:= Copy (Psevdonm[i],1,Pos (',',Psevdonm[i])-1);

if not Session.IsAlias (wrstr) then

begin

try

Session.AddStandardAlias (wrstr,wrstr1,'PARADOX');

Session.SaveConfigFile;

except

SaveTekJrn ('ERR:Ошибка создания алиаса — ' wrstr);

Exit;

end;

end;

//Настроим алиас

AParams:= TStringList.Create;

AParams.Add ('PATH=' CurrntDir '\' wrstr1);

Session.ModifyAlias (wrstr,AParams);

Session.SaveConfigFile;

// Освобождение списка

AParams.Free;

end;

end;

{/codecitation}

{codecitation class="brush: pascal; gutter: false;" width="600px"}

Автор: Vit

WEB-сайт: http://forum.vingrad.ru

type

TSQLConfigDataSource =

function (hwndParent: Integer;

fRequest: Integer;

lpszDriverString: string;

lpszAttributes: string): Smallint; stdcall;

function SQLConfigDataSource (hwndParent: Integer; fRequest: Integer;

lpszDriverString: string; lpszAttributes: string): Integer; stdcall;

var

func: TSQLConfigDataSource;

OdbccpHMODULE: HMODULE;

begin

OdbccpHMODULE:= LoadLibrary ('c:\WINDOWS\SYSTEM\odbccp32.dll');

if OdbccpHMODULE = 0 then

raise Exception.Create (SysErrorMessage (GetLastError));

func:= GetProcAddress (OdbccpHMODULE, PChar ('SQLConfigDataSource'));

if @func = nil then

raise Exception.Create ('Error Getting adress for SQLConfigDataSource'

SysErrorMessage (GetLastError));

Result:= func (hwndParent, fRequest, lpszDriverString, lpszAttributes);

FreeLibrary (OdbccpHMODULE);

end;

procedure TForm1.Button1Click (Sender: TObject);

begin

if SQLConfigDataSource (0, 1, 'Microsoft Excel Driver (*.xls)',

Format ('DSN=%s;DBQ=%s;DriverID=790', ['MyDSNName',

'c:\temp\temp.xls'])) 1 then

ShowMessage ('Cannot create ODBC alias');

end;

PS: Ecли вы собираетесь работать с этим DSN через BDE, то надо закрыть и открыть Session, иначе он не будет доступен

{/codecitation}