Валентин Озеров - Советы по Delphi. Версия 1.4.3 от 1.1.2001

• Название: Советы по Delphi. Версия 1.4.3 от 1.1.2001
• Автор: Валентин Озеров
• Жанр: Программирование

…начиная с 1001. Смотрите другие файлы…

---

 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