Форум: "Базы";
Текущий архив: 2004.02.10;
Скачать: [xml.tar.bz2];

Вниз

Программное создание ODBC DSN   Найти похожие ветки 

← →
alexproger   (2004-01-20 15:47) [0]

Доброго всем времени суток!!!

Подскажите как программно создать DSN ODBC (пользовательский или системный) из программы на Delphi. Способ с вызовом аплета панелши управления не предлагать - знаю, но не подходит, т.к. будушие юзеря большие "чайники".

---

← →
Nikolay M.   (2004-01-20 16:17) [1]

Через реестр. Создай какой-нибудь тестовый "Registry MS Access DSN test" и поищи это название в реестре - найдешь много вкусного :)

---

← →
KSergey   (2004-01-21 08:59) [2]

Через реестр не надо.
Нада через SQLDataSources

---

← →
KSergey   (2004-01-21 09:00) [3]

////////////////////////////////////////////////////////////////////////////////
//
// Модуль управления источниками DSN
//
// Ссылки на источники:
// http://www.rsdn.ru/qna/default.asp?db/datasrc.xml
// http://www.bbd.net.ru/modules.php?op=modload&name=News&file=article&sid=16
// http://www.firststeps.ru/mfc/odbc/r.php?14
// http://www.proglib.ru/articles/art0000032.asp
// http://www.rsdn.ru/qna/printv.asp?db/drv_ds.xml
//
////////////////////////////////////////////////////////////////////////////////

unit DSNConf;

interface

uses
Windows, Registry, Sysutils;

function AddDSNMSSQLSource(const ADSNName, AServer, ADataBase: String;
ADescription: String = ""): Boolean;
function IsExistDSN(const ADSNName: String): Boolean;
function IsExistDSNSql(const ADSNName: String): Boolean;

function SQLConfigDataSource(
hwndParent: HWND; // Указатель на окно вызвавшее функцию
fRequest: WORD; // Тип запроса
lpszDriver: PChar; // Пользовательское имя драйвера
lpszAttributes: PChar // атрибуты
): Boolean; stdcall; external "odbccp32.dll" name "SQLConfigDataSource";

type
SQLSMALLINT = Smallint;
SQLUSMALLINT = Word;
PSQLSMALLINT = ^SQLSMALLINT;
SQLRETURN = SQLSMALLINT;
SQLHANDLE = Pointer;
SQLPOINTER = Pointer;
PSQLPOINTER = ^SQLPOINTER;
PSQLHANDLE = ^SQLHANDLE;
SQLHENV = SQLHANDLE;
SQLINTEGER = Longint;
SQLUINTEGER = Longword;

function SQLValidDSN( // проверка допустимости указанного имени DSN-источника
lpszDSN: PChar // проверяемое имя
): BOOL; stdcall; external "odbccp32.dll" name "SQLValidDSN";

function SQLDataSources(
EnvironmentHandle: SQLHENV;
Direction: SQLUSMALLINT;
ServerName: PChar;
BufferLength1: SQLSMALLINT;
NameLength1Ptr: PSQLSMALLINT;
Description: PChar;
BufferLength2: SQLSMALLINT;
NameLength2Ptr: PSQLSMALLINT
): SQLRETURN; stdcall; external "odbc32.dll" name "SQLDataSources";

function SQLSetEnvAttr(
EnvironmentHandle: SQLHENV;
Attribute: SQLINTEGER;
ValuePtr: SQLPOINTER;
StringLength: SQLINTEGER
): SQLRETURN; stdcall; external "odbc32.dll" name "SQLSetEnvAttr";

function SQLAllocHandle(
HandleType: SQLSMALLINT;
InputHandle: SQLHANDLE;
OutputHandlePtr: PSQLHANDLE
): SQLRETURN; stdcall; external "odbc32.dll" name "SQLAllocHandle";

function SQLFreeHandle(
HandleType: SQLSMALLINT;
Handle: SQLHANDLE
): SQLRETURN; stdcall; external "odbc32.dll" name "SQLFreeHandle";

const
// SQLConfigDataSource request flags
ODBC_ADD_DSN = 1; // Add data source
ODBC_CONFIG_DSN = 2; // Configure (edit) data source
ODBC_REMOVE_DSN = 3; // Remove data source
ODBC_ADD_SYS_DSN = 4; // add a system DSN
ODBC_CONFIG_SYS_DSN = 5; // Configure a system DSN
ODBC_REMOVE_SYS_DSN = 6; // remove a system DSN
ODBC_REMOVE_DEFAULT_DSN = 7; // remove the default DSN

{ Codes used for FetchOrientation in SQLFetchScroll(), and in SQLDataSources() }
SQL_FETCH_NEXT = 1;
SQL_FETCH_FIRST = 2;
{ additional SQLDataSources fetch directions }
SQL_FETCH_FIRST_USER = 31;
SQL_FETCH_FIRST_SYSTEM = 32;

{ handle type identifiers }
SQL_HANDLE_ENV = 1;
SQL_HANDLE_DBC = 2;
SQL_HANDLE_STMT = 3;
SQL_HANDLE_DESC = 4;

{ return values from functions }
SQL_SUCCESS = 0;
SQL_SUCCESS_WITH_INFO = 1;
SQL_NO_DATA = 100;
SQL_ERROR = -1;
SQL_INVALID_HANDLE = -2;

{ null handle used in place of parent handle when allocating HENV }
SQL_NULL_HANDLE = nil;

{ env attribute }
SQL_ATTR_ODBC_VERSION = 200;
SQL_ATTR_CONNECTION_POOLING = 201;
SQL_ATTR_CP_MATCH = 202;

{ values for SQL_ATTR_ODBC_VERSION }
SQL_OV_ODBC2 = 2;
SQL_OV_ODBC3 = 3;

{ whether an attribute is a pointer or not }
SQL_IS_POINTER = -4;
SQL_IS_UINTEGER = -5;
SQL_IS_INTEGER = -6;
SQL_IS_USMALLINT = -7;
SQL_IS_SMALLINT = -8;

implementation

const
SQLDriverName = "SQL Server";

{******************************************************************************
* AddDSNMSSQLSource - добавляет (модифицирует) пользовательский DSN-источник
* для доступа к MS SQL серверу
* Дополнительно в клиентских настройках прописывается
* протокол TCP/IP и порт 1433
*
* Вход: ADSNName - имя DSN-источника
* AServer - имя сервера
* ADataBase - наименование БД на сервере по умолчанию
* ADescription - описание источника (необязательный параметр)
*
* Выход: TRUE - в случае успеха, FALSE - в противном случае
******************************************************************************}

function AddDSNMSSQLSource(const ADSNName, AServer, ADataBase: String;
ADescription: String = ""): Boolean;
var
params: String;

// эта ф-ция прописывает необходимые настройки для доступа к MS SQL по TCP/IP
// и на порт 1433
function SetNetLibParam: Boolean;
begin
Result := FALSE;
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey("\Software\Microsoft\MSSQLServer\Client", TRUE) then
if NOT KeyExists("ConnectTo") then
CreateKey("ConnectTo");
if OpenKey("ConnectTo", TRUE) then
begin
WriteString(AServer,"DBMSSOCN," + AServer + ",1433");
Result := TRUE;
end;
finally
CloseKey;
Free;
end;
end;

begin
if SQLValidDSN (PChar(ADSNName)) then
begin
params := "DSN=" + ADSNName + #0"Server=" + AServer + #0"DataBase= " +
ADataBase + #0"Description=" + ADescription + #0#0;
Result := SQLConfigDataSource(0, ODBC_ADD_DSN, PChar(SQLDriverName), PChar(params));
Result := Result AND SetNetLibParam;
end
else
Result := FALSE;
end;

---

← →
KSergey   (2004-01-21 09:01) [4]

******************************************************************************
* IsExistDSNBody - основная функция проверок
******************************************************************************}

function IsExistDSNBody(const ADSNName, ADriver: String): Boolean;
const
BUF_LEN = 256;
var
buf1, buf2: array [0..BUF_LEN] of Char;
buf1Len, buf2Len: SQLSMALLINT;
hEnv: SQLHANDLE;
RetCode: SQLRETURN;
Direct: SQLUSMALLINT;
begin
Result := FALSE;
if SQLValidDSN(PChar(ADSNName)) then
if SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, @hEnv) = SQL_SUCCESS then
begin
RetCode := SQLSetEnvAttr (hEnv, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), SQL_IS_INTEGER);
if (RetCode = SQL_SUCCESS) OR (RetCode = SQL_SUCCESS_WITH_INFO) then
begin
Direct := SQL_FETCH_FIRST;
while TRUE do
begin
RetCode := SQLDataSources(hEnv, Direct,buf1, BUF_LEN, @buf1Len, buf2, BUF_LEN, @buf2Len);
Direct := SQL_FETCH_NEXT;
if (RetCode = SQL_SUCCESS) OR (RetCode = SQL_SUCCESS_WITH_INFO) then
begin
if AnsiStrComp (PChar(ADSNName), buf1) = 0 then
begin
if ADriver <> "" then
if AnsiStrComp (PChar(ADriver), buf2) <> 0 then
Continue; // запись не с тем драйвером - продолжить поиск
Result := TRUE;
Break; // найден подходящий DSN; выход с соотв. флагом
end;
end
else
Break; // прервать цикл по ошибке
end; // while
end;
SQLFreeHandle(SQL_HANDLE_ENV, hEnv);
end;
end;

{******************************************************************************
* IsExistDSN - проверяет есть ли пользовательский или системный DSN
* с указанным наименованием
*
* Вход: ADSNName - имя DSN-источника
*
* Выход: TRUE - найдено, FALSE - не найдено либо ошибка
******************************************************************************}

function IsExistDSN(const ADSNName: String): Boolean;
begin
Result := IsExistDSNBody(ADSNName, "");
end;

{******************************************************************************
* IsExistDSNSql - проверяет есть ли пользовательский или системный DSN
* с указанным наименованием и настроенный
* на работу с SQL-сервером
*
* Вход: ADSNName - имя DSN-источника
*
* Выход: TRUE - найдено, FALSE - не найдено либо ошибка
******************************************************************************}

function IsExistDSNSql(const ADSNName: String): Boolean;
begin
Result := IsExistDSNBody(ADSNName, SQLDriverName);
end;

end.

---

← →
KSergey   (2004-01-21 09:09) [5]

Выше привел свой полностью рабочий модуль, который существенно дополнен по сравнению с ранее опубликованным на
http://delphibase.endimus.com/?action=viewfunc&topic=basemssql&id=10442

Советую и там читнуть небольшой мой комментарий.

(к стати, когда там сделают возможность простого внесения изменений в опубликованный код? А то сечас - только через администраторов с полным удалением...)

Все это - для MS SQL, однако это не сложно переделать на любые другие. См. источники и MSDN.

---

Страницы: 1 вся ветка

Форум: "Базы";
Текущий архив: 2004.02.10;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.48 MB
Время: 0.008 c