псевдоним БД

Тема в разделе "Delphi - Базы данных", создана пользователем lazynov, 5 мар 2007.

  1. lazynov

    lazynov Гость

    Люди! Помогите пожалста!
    Как программно создать псевдоним (alias) для БД???
     
  2. Barmutik

    Barmutik Гость

    Вот полностью рабочий модуль... писался когда-то для какого-то проекта...

    CheckODBCALias - проверяет и при необходимости создаёт альяс... нужные моменты изменить по необходимости :)

    Код (Text):
    unit CheckODBCAliasUnit;

    interface

    type
    SQLHANDLE   = LongInt;
    SQLHENV  = SQLHANDLE;
    SQLSMALLINT = smallint;
    SQLINTEGER  = LongInt;
    SQLPOINTER  = Pointer;
    SQLRETURN   = SQLSMALLINT;
    SQLUSMALLINT = Word;
    PSQLCHAR     = PChar;
    PSQLSMALLINT = ^SQLSMALLINT;

    const
    SQL_HANDLE_ENV      = 1;
    SQL_NULL_HANDLE   = 0;
    SQL_SUCCESS       = 0;
    SQL_ATTR_ODBC_VERSION = 200;
    SQL_OV_ODBC3            = 3;
    SQL_SUCCESS_WITH_INFO = 1;
    SQL_MAX_DSN_LENGTH  = 32;
    SQL_FETCH_FIRST = 2;
    SQL_FETCH_NEXT   = 1;
    ODBC_ADD_DSN = 1;
    ODBC_CONFIG_DSN = 2;

    procedure CheckODBCALias(AODBCName, ADatabaseName: string);
    function GetODBCAliasDatabasePath(AODBCName: string): string;
    procedure LoadODBC;
    procedure UnLoadODBC;

    type
    TSQLConfigDataSource = function(
    hwndParent:   Integer;
    fRequest:        Integer;
    lpszDriverString: string;
    lpszAttributes:  string): Integer; stdcall;

    TSQLAllocHandle = function(HandleType: SQLSMALLINT;
    InputHandle: SQLHANDLE;
    var OutputHandlePtr: SQLHANDLE): SQLRETURN; stdcall;

    TSQLSetEnvAttr = function(EnvironmentHandle: SQLHENV;
    Attribute: SQLINTEGER; Value: SQLPOINTER;
    StringLength: SQLINTEGER) : SQLRETURN; stdcall;

    TSQLFreeHandle = function(HandleType: SQLSMALLINT;
    Handle: SQLHANDLE): SQLRETURN; stdcall;

    TSQLDataSources = function(EnvironmentHandle: SQLHENV;
    Direction: SQLUSMALLINT; ServerName: PSQLCHAR;
    BufferLength1: SQLSMALLINT; NameLength1: PSQLSMALLINT;
    Description: PSQLCHAR; BufferLength2: SQLSMALLINT;
    NameLength2: PSQLSMALLINT) : SQLRETURN; stdcall;

    implementation

    uses
    Windows, SysUtils, Classes, VCLUtils;

    var
    OdbcHMODULE: HMODULE;
    Odbc1HMODULE: HMODULE;
    SQLConfigDataSource: TSQLConfigDataSource;
    SQLAllocHandle: TSQLAllocHandle;
    SQLSetEnvAttr: TSQLSetEnvAttr;
    SQLFreeHandle: TSQLFreeHandle;
    SQLDataSources: TSQLDataSources;

    function GetAdresstoFunction(AODBCModule: HMODULE; FunctionName: string): FARPROC;
    begin
    Result := GetProcAddress(AODBCModule, Pchar(FunctionName));
    if Result = nil then
    begin
    raise Exception.create('Íå ìîãó çàãðóçèòü ôóíêöèþ '+ FunctionName + #13+
    SysErrorMessage(GetLastError));
    end;
    end;

    procedure LoadODBC;
    begin
    OdbcHMODULE := LoadLibrary('ODBC32.DLL');
    if OdbcHMODULE = 0 then
    raise Exception.Create(SysErrorMessage(GetLastError));
    SQLAllocHandle := GetAdresstoFunction(OdbcHMODULE, 'SQLAllocHandle');
    SQLSetEnvAttr := GetAdresstoFunction(OdbcHMODULE, 'SQLSetEnvAttr');
    SQLFreeHandle := GetAdresstoFunction(OdbcHMODULE, 'SQLFreeHandle');
    SQLDataSources := GetAdresstoFunction(OdbcHMODULE, 'SQLDataSources');
    Odbc1HMODULE := LoadLibrary('ODBCCP32.DLL');
    if Odbc1HMODULE = 0 then
    raise Exception.Create(SysErrorMessage(GetLastError));
    SQLConfigDataSource := GetAdresstoFunction(Odbc1HMODULE, 'SQLConfigDataSource');
    end;

    procedure UnLoadODBC;
    begin
    Delay(100);
    if OdbcHMODULE <> 0 then
    begin
    if not FreeLibrary(OdbcHMODULE) then
    begin
    raise Exception.Create(SysErrorMessage(GetLastError));
    end;
    end;
    if Odbc1HMODULE <> 0 then
    begin
    if not FreeLibrary(Odbc1HMODULE) then
    begin
    raise Exception.Create(SysErrorMessage(GetLastError));
    end;
    end;
    end;

    function GetHENV: SQLHENV;
    var
    AODBCHandle: SQLHENV;
    begin
    AODBCHandle := 0;
    LoadODBC;
    if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, AODBCHandle) <> SQL_SUCCESS then
    raise Exception.Create('Îøèáêà àëîêàöèÿ ODBC õýíäëà.');
    try
    if not(SQLSetEnvAttr(AODBCHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0)
    in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO]) then
    raise Exception.Create('Îøèáêà ïîëó÷åíèÿ àòðèáóòîâ ODBC õýíäëà.' );
    except
    if AODBCHandle <> 0 then
    begin
    SQLFreeHandle(SQL_HANDLE_ENV, AODBCHandle);
    end;
    raise;
    end;
    Result := AODBCHandle;
    end;

    procedure GetDatSourceNames(Alist: TStrings);
    var
    ServerName: array [0..SQL_MAX_DSN_LENGTH] of Char;
    sl:      SQLSMALLINT;
    sqlResult: integer;
    AODBCEnviromentHandle: SQLHENV;
    begin
    Alist.Clear;
    AODBCEnviromentHandle := GetHENV;
    if SQLDataSources(AODBCEnviromentHandle, SQL_FETCH_FIRST,
    ServerName, SQL_MAX_DSN_LENGTH, @sl,
    nil, 0, nil) = SQL_SUCCESS then
    repeat
    Alist.add( StrPas(ServerName));
    sqlresult := SQLDataSources(AODBCEnviromentHandle, SQL_FETCH_NEXT,
    ServerName, SQL_MAX_DSN_LENGTH, @sl,
    nil, 0, nil)
    until (sqlResult <> SQL_SUCCESS) and (sqlResult <> SQL_SUCCESS_WITH_INFO)
    end;

    procedure CheckODBCALias(AODBCName, ADatabaseName: string);
    var
    AODBCDSN: TStringList;
    AParameters: string;
    begin
    AODBCDSN := TStringList.Create;
    try
    GetDatSourceNames(AODBCDSN);
    if AODBCDSN.IndexOf(AODBCName) <> -1 then
    begin
    AParameters := 'DSN=' + AODBCName + ';DBQ=' + ADatabaseName;
    SQLConfigDataSource(SQL_NULL_HANDLE, ODBC_CONFIG_DSN,
    'Microsoft Access Driver (*.mdb)', AParameters)
    end
    else
    begin
    AParameters := 'DSN=' + AODBCName + ';DBQ=' + ADatabaseName;
    SQLConfigDataSource(SQL_NULL_HANDLE, ODBC_ADD_DSN,
    'Microsoft Access Driver (*.mdb)', AParameters);
    end;
    finally
    AODBCDSN.Free;
    UnLoadODBC;
    end;
    end;

    function GetODBCAliasDatabasePath(AODBCName: string): string;
    var
    AODBCDSN: TStringList;
    AParameters: string;
    begin
    AODBCDSN := TStringList.Create;
    try
    GetDatSourceNames(AODBCDSN);
    finally
    AODBCDSN.Free;
    UnLoadODBC;
    end;
    end;

    end.
     
  3. lazynov

    lazynov Гость

    Извини конечно! Но не мог ли бы ты мне объяснить суть и принцип, а то в коде как то неособо понятно! Спасибо заранее!
     
  4. Barmutik

    Barmutik Гость

    А что конкретно не понятно? Кода на 2 листа всего .. есть готовые вынесенные функции ...

    Вам надо пользовать:

    Вы её запускать пробовали ?
     
  5. lazynov

    lazynov Гость

    пробовал. тока мне не совсем то надо и слишком много!
    я уже написал нужное решение:
    Код (Text):
    procedure CreateAlias;
    var
    AParams: TStringList;
    dir:string;
    begin
    dir := ExtractFilePath(paramstr(0)) + 'Base';
    AParams := TStringList.Create;
    if not Session.IsAlias('Name_Alias') then
    begin
    Session.AddStandardAlias('Name_Alias',Dir,'PARADOX');
    Session.SaveConfigFile;
    end
    else
    try
    AParams.Clear;
    AParams.Add('PATH=' + Dir);
    Session.ModifyAlias('Name_Alias',AParams);
    Session.SaveConfigFile;
    finally
    AParams.Free;
    end;
    end;
     
  6. Barmutik

    Barmutik Гость

    Классно что всё получилось .. моё решение просто создаёт Альяс для ODBC юю в следующий раз посторайтесь более точно ставить вопрос... Удачи!
     
  7. lazynov

    lazynov Гость

    Се равно спасибо.
     
  8. skvoznak

    skvoznak Гость

    а я делаю псевдоним так:
    Код (Text):
     with Session do
    begin
    ConfigMode := cmSession;
    ast:=ExtractFilePath(ParamStr(0));
    AddStandardAlias('name_alias', ExtractFilePath(ParamStr(0)), 'PARADOX');
    end;
    единственное что псевдоним создаётся во время запуска и существует только во время рабты программы
     
  9. lazynov

    lazynov Гость

    Существует только во время работы потому что ты не сохраняешь config. Для этого:
    Код (Text):
    Session.AddStandardAlias(AliasName, DBDir, 'PARADOX');
    [b]Session.SaveConfigFile;[/b]
    и все ОК!

    это нвсе написано чуть выше... почитай!
     
  10. MatlabX

    MatlabX Гость

    [/quote]Как программно создать псевдоним (alias) для БД???

    Ты чего используешь? TTable или TQuery?
    То есть в TQuery в запросе можешь указать путь к файле БД.
    Например у тя рядом с exeщником находится папочка Base и внутри этой папки файл базы и название этого файла Materials.dbf.
    В проекте добавишь компоненту TQuery и запрос у тя будеть выглядится примерно так:
    TQuery.SQL.TEXT = 'Select * from base\materials.dbf'


    На моей версии не создаеться, просто обращаещся к базе без всяких алиасов и т.д.
     
  11. lazynov

    lazynov Гость

    Вобще через TTable. Но тут вопрос стоял не как обратится к базе данных, а как создать псевдоним. Решение помоему очевидное и работающее.
     
  12. skvoznak

    skvoznak Гость

    ммм)))) вот оно в чём дело))) спасибочки))))
     
  13. shigo

    shigo Гость

    Подскажите please
    Как программно создать alias вдя БД Oracle?
    Стандартно ч.з. SQL Explorer
    необходимо выбрать database driver name ORACLE
    затем
    -enable schema cache = true
    -schema cache dir = дирректория файла TNSNames
    -Указать имя сервера
    и т.д.

    Помогите разобраться как это сделать программно?
     
  14. skvoznak

    skvoznak Гость

    <!--QuoteBegin-lazynov+15:05:2007, 22:37 -->
    <span class="vbquote">(lazynov @ 15:05:2007, 22:37 )</span><!--QuoteEBegin-->Цитата(skvoznak @ 15:05:2007, 22:52 )

    а я делаю псевдоним так:
    Код
    with Session do
    begin
    ConfigMode := cmSession;
    ast:=ExtractFilePath(ParamStr(0));
    AddStandardAlias('name_alias', ExtractFilePath(ParamStr(0)), 'PARADOX');
    end;
    единственное что псевдоним создаётся во время запуска и существует только во время рабты программы


    Существует только во время работы потому что ты не сохраняешь config. Для этого:
    Код
    Session.AddStandardAlias(AliasName, DBDir, 'PARADOX');
    Session.SaveConfigFile;

    и все ОК!

    это нвсе написано чуть выше... почитай!
    [snapback]66092" rel="nofollow" target="_blank[/snapback]​
    [/quote]
    не хочет он у меня конфиг-файл сохранять! хоть тресни! ошибка- и всё тут
     
Загрузка...

Поделиться этой страницей