псевдоним БД

lazynov · 05.03.2007

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

Barmutik · 05.03.2007

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

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

Код:

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.

lazynov · 16.03.2007

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

Barmutik · 16.03.2007

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

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

procedure CheckODBCALias(AODBCName, ADatabaseName: string);

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

lazynov · 20.03.2007

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

Вам надо пользовать:
Вы её запускать пробовали ?

пробовал. тока мне не совсем то надо и слишком много!
я уже написал нужное решение:

Код:

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;

Barmutik · 20.03.2007

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

lazynov · 20.03.2007

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

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

skvoznak · 15.05.2007

а я делаю псевдоним так:

Код:

 with Session do
begin
ConfigMode := cmSession;
ast:=ExtractFilePath(ParamStr(0));
AddStandardAlias('name_alias', ExtractFilePath(ParamStr(0)), 'PARADOX');
end;

единственное что псевдоним создаётся во время запуска и существует только во время рабты программы

lazynov · 16.05.2007

skvoznak сказал(а):
а я делаю псевдоним так:

Код:

with Session do begin ConfigMode := cmSession; ast:=ExtractFilePath(ParamStr(0)); AddStandardAlias('name_alias', ExtractFilePath(ParamStr(0)), 'PARADOX'); end;

единственное что псевдоним создаётся во время запуска и существует только во время рабты программы

Существует только во время работы потому что ты не сохраняешь config. Для этого:

Код:

Session.AddStandardAlias(AliasName, DBDir, 'PARADOX');
[b]Session.SaveConfigFile;[/b]

и все ОК!

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

MatlabX · 16.05.2007

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

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

единственное что псевдоним создаётся во время запуска и существует только во время рабты программы

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

lazynov · 16.05.2007

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

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

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

skvoznak · 16.05.2007

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

shigo · 26.05.2007

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

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

skvoznak · 10.06.2007

<span class="vbquote">(lazynov @ 15:05:2007, 22:37 )</span>Цитата(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]
не хочет он у меня конфиг-файл сохранять! хоть тресни! ошибка- и всё тут

Все сервисы Codeby

Поиск

Поиск

псевдоним БД

lazynov

Barmutik

lazynov

Barmutik

lazynov

Barmutik

lazynov

skvoznak

lazynov

MatlabX

lazynov

skvoznak

shigo

skvoznak