finally
Paramlist.Free;
end;
end;
function GetDBPath2(AliasName: string): TFileName;
var
ParamList: TStringList;
i: integer;
begin
ParamList := TStringList.Create;
with Session do try
try
GetAliasParams(AliasName,ParamList);
except
for i:=0 to pred(DatabaseCount) do
if (Databases[i].DatabaseName = AliasName) then
ParamList.Assign(Databases[i].Params);
end;
Result := UpperCase(ParamList.Values['PATH'])+'';
finally
Paramlist.Free;
end;
end;
function GetDBPath3(ATable: TTable): TFileName;
var
TblProps: CURProps;
pTblName, pFullName: DBITblName;
begin
with ATable do begin
AnsiToNative(Locale, TableName, pTblName, 255);
Check(DBIGetCursorProps(Handle, TblProps));
Check(DBIFormFullName(DBHandle,pTblName,TblProps.szTableType,pFullName));
Result := ExtractFilePath(StrPas(pFullName));
end;
end;
Reinhard Kalinke
Получение пути псевдонима и таблицы II
Вот маленький примерчик того, как в Delphi можно получить информацию о псевдонимах. Для начала создайте новый проект с ListBox и тремя метками (с именамиListBox1, Label1, Label2 и Label3). Затем создайте обработчик события формы OnCreate с примерно следующим кодом:
procedure TForm1.FormCreate(Sender: TObject);
begin
Session.GetAliasNames(ListBox1.Items);
end;
Теперь создайте обработчик OnClick для ListBox:
procedure TForm1.ListBox1Click(Sender: TObject);
var
tStr: array[0..100] of char;
Desc: DBDesc;
begin
if ListBox1.Items.Count = 0 then exit;
StrPLCopy(tStr, ListBox1.Items.Strings[ListBox1.ItemIndex], High(tStr));
DbiGetDatabaseDesc(tStr, @Desc);
with Desc do begin
Label1.Caption := StrPas(Desc.szName);
Label2.Caption := StrPas(Desc.szPhyName);
Label3.Caption := StrPas(Desc.szDbType);
end;
end;
Добавьте следующие модули в секцию 'uses' в верхней части модуля:
DB, DBTables, DBITypes, DBIProcs;
Теперь вы можете увидеть путь для всех ваших стандартных псевдонимов (Paradox и dBase).
Получение пути псевдонима и таблицы III
Delphi 1
Используйте Session.GetAliasParams. В ответ вы получите объект Tstrings, откуда вы можете получить значение для переменной 'PATH". Для получения дополнительной информации обратитесь к электронной справке к разделу, описывающему TSession. Объект Session объявлен в модуле DB.
uses db;
var aliaspath : string[128];
begin
aliaspath := Session.GetAliasParams['MyAlias'].values['PATH'];
end;
uses SysUtils,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;
Получение пути псевдонима и таблицы IV
Nomadic советует:
1. По таблице (фактически по Database) получить физическое местонахождение.
Примечание: Database можно создать явно, если нет, Дельфи сама его создаст, доступ к ней по Table(Query).Database
uses DbiProcs;
function GetDirByDatabase(Database: TDatabase): string;
var pszDir: PChar;
begin
pszDir := StrAlloc(255);
try
DbiGetDirectory(Database.Handle, True, pszDir);
Result := StrPas(pszDir);
finally
StrDispose(pszDir);
end;
end;
2. По алиасу.
function GetPhNameByAlias(sAlias: string): string;
var
Database: TDatabase;
pszDir: PChar;
begin
Database := TDatabase.Create(nil); {allocate memory}
pszDir := StrAlloc(255);
try
Database.AliasName := sAlias;
Database.DatabaseName := 'TEMP'; {requires a name – is ignored}
Database.Connected := True; {connect without opening any table}
DbiGetDirectory(Database.Handle, True, pszDir); {get the dir.}
Database.Connected := False; {disconnect}
Result := StrPas(pszDir); {convert to a string}
finally
Database.Free; {free memory}
StrDispose(pszDir);
end;
end;
Информация о псевдониме BDE
Delphi 1
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;
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;
Изменение каталога псевдонима во время выполнения приложения
Delphi 1
Я делаю это все время. У меня есть INI-файл, который сообщает, где можно найти таблицы и каталоги их расположения. Вот как я это делаю:
procedure CheckTable(var Table : TTable; var TName : string);
var
ChangePath: boolean;
Path: string;
ActiveState: Boolean;
begin
if (TName = '') then TName := Table.TableName
else with Table do begin
ActiveState := Active;
Close;
Path := ExtractFilePath(TName);
ChangePath := HasAttr(DatabaseName, faDirectory) or (CompareText(DatabaseName, Path) <> 0);
if (Length(Path) > 0) and ChangePath then DatabaseName := Path;
if (CompareText(ExtractFileName(Tname), TableName) <> 0) then TableName := ExtractFileName(Tname);
Active := ActiveState;
end;
end;
Псевдоним на лету
Delphi 2
Попробуйте это:
type TDataMod = class(TDataModule)
Database: TDatabase;
public
procedure TempAlias(NewAlias, NewDir: String);
end;
procedure TDataMod.TempAlias(NewAlias, NewDir: String);
begin
with Session do if not IsAlias(NewAlias) then begin
ConfigMode := cmSession; (* NewAlias будет ВРЕМЕННЫМ *)
try
AddStandardAlias(NewAlias, NewDir, 'PARADOX');
Database.Close;
Database.AliasName := NewAlias;
Database.Open;
finally
ConfigMode := cmAll;
end;
end;
end;
Комментарии:
a) Поместите компонент Database на форму DataModule;
b) Задайте свойству DatabaseName имя базы данных, например, 'TempDB';
c) Задайте свойству DatabaseName компонента TTable значение = 'TempDB'
d) Для получения дополнительной информации ознакомьтесь с примером MastApp, поставляемым вместе с D2.
Псевдонимы
Delphi 2
Попробуйте следующий код:
var
theStrList : TStringList;
GPath : String;
begin
