Форум: "Базы";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
ВнизКак получить список доступных MS SQL серверов? Найти похожие ветки
← →
ByteButcher (2004-12-01 13:30) [0]Я знаю как сделать это через SQL DMO. Но не хотелось бы тянуть вместе с прогой еще и SQL DMO. Подскажите как можно получить список доступных серверов БД используя ODBC.
А может в ADO или ADOX есть такая возможность?
← →
sniknik © (2004-12-01 13:53) [1]
unit NetAPI;
interface
uses Windows, Classes;
procedure GetSQLServerNames(Names: TStrings; const DomainName: string; const ServerType: DWORD);
function ScanDomainForSQLNames(List: TStrings; NetRes: PNetResource): Word;
implementation
const
NERR_SUCCESS = 0;
MAX_PREFERRED_LENGTH = DWORD(-1);
SV_TYPE_WORKSTATION = $00000001;
SV_TYPE_SERVER = $00000002;
SV_TYPE_SQLSERVER = $00000004;
SV_TYPE_DOMAIN_CTRL = $00000008;
SV_TYPE_DOMAIN_BAKCTRL = $00000010;
SV_TYPE_TIME_SOURCE = $00000020;
SV_TYPE_AFP = $00000040;
SV_TYPE_NOVELL = $00000080;
SV_TYPE_DOMAIN_MEMBER = $00000100;
SV_TYPE_PRINTQ_SERVER = $00000200;
SV_TYPE_DIALIN_SERVER = $00000400;
SV_TYPE_XENIX_SERVER = $00000800;
SV_TYPE_SERVER_UNIX = SV_TYPE_XENIX_SERVER;
SV_TYPE_NT = $00001000;
SV_TYPE_WFW = $00002000;
SV_TYPE_SERVER_MFPN = $00004000;
SV_TYPE_SERVER_NT = $00008000;
SV_TYPE_POTENTIAL_BROWSER = $00010000;
SV_TYPE_BACKUP_BROWSER = $00020000;
SV_TYPE_MASTER_BROWSER = $00040000;
SV_TYPE_DOMAIN_MASTER = $00080000;
SV_TYPE_SERVER_OSF = $00100000;
SV_TYPE_SERVER_VMS = $00200000;
SV_TYPE_WINDOWS = $00400000; // Windows95 and above
SV_TYPE_DFS = $00800000; // Root of a DFS tree
SV_TYPE_CLUSTER_NT = $01000000; // NT Cluster
SV_TYPE_DCE = $10000000; // IBM DSS (Directory and Security Services) or equivalent
SV_TYPE_ALTERNATE_XPORT = $20000000; // return list for alternate transport
SV_TYPE_LOCAL_LIST_ONLY = $40000000; // Return local list only
SV_TYPE_DOMAIN_ENUM = $80000000;
SV_TYPE_ALL = $FFFFFFFF; //handy for NetServerEnum2
type
TServerInfo101 = record
platform_id: DWORD;
name: PWideChar;
version_major: DWORD;
version_minor: DWORD;
server_type: DWORD;
comment: PWideChar;
end;
PServerInfo101 = ^TServerInfo101;
TServerInfo100 = record
platform_id: DWORD;
name: PWideChar;
end;
PServerInfo100 = ^TServerInfo100;
function NetServerEnum(const ServerName: PWideString; level: DWORD; var Buffer: pointer;
PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD; ServerType: DWORD;
const Domain: PWideChar; var ResumeHandle: DWORD): DWORD; stdcall;
external "netapi32.dll";
function NetApiBufferFree(Buffer: pointer): DWORD; stdcall;
external "netapi32.dll";
procedure GetSQLServerNames(Names: TStrings; const DomainName: string; const ServerType: DWORD);
var
Buffer: pointer;
EntriesRead, i, ErrCode, ResumeHandle, TotalEntries: DWORD;
DomainUnicode: array[0..100] of WideChar;
PDomainUnicode: PWideChar;
ServerInfo: PServerInfo101;
begin
ResumeHandle:= 0;
if (DomainName = "") then PDomainUnicode:= nil
else begin
StringToWideChar(DomainName, DomainUnicode, SizeOf(DomainUnicode));
PDomainUnicode:= DomainUnicode;
end;
errCode:= NetServerEnum(nil, 101, Buffer, MAX_PREFERRED_LENGTH, EntriesRead, TotalEntries, ServerType, PDomainUnicode, ResumeHandle);
if (errCode <> NERR_SUCCESS) then Exit;
try
ServerInfo:= Buffer;
for i := 1 to EntriesRead do begin
Names.Add(ServerInfo^.name);
Inc(ServerInfo);
end;
finally
NetApiBufferFree(Buffer);
end;
end;
function ScanDomainForSQLNames(List: TStrings; NetRes: PNetResource): Word;
var
ArNetRes: array[0..59] of TNetResource;
i: integer;
EntrReq, SizeReq: DWORD;
hEnum: THandle;
DomenName: string;
begin
Result:= WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_ANY, RESOURCEUSAGE_CONTAINER, NetRes, hEnum);
if Result = ERROR_NO_NETWORK then exit;
if Result = NO_ERROR then begin
EntrReq:= 1;
SizeReq:= SizeOf(TNetResource) * 59;
while (hEnum <> 0) and (WNetEnumResource(hEnum, EntrReq, @ArNetRes, SizeReq) <> ERROR_NO_MORE_ITEMS) do begin
for i:= 0 To EntrReq - 1 do
with ArNetRes[i] do begin
case dwDisplayType of
RESOURCEDISPLAYTYPE_DOMAIN: begin
if lpRemoteName <> "" then DomenName:= lpRemoteName
else DomenName:= lpComment;
GetSQLServerNames(List, DomenName, SV_TYPE_SQLSERVER);
end;
else ScanDomainForSQLNames(List, @ArNetRes[i]);
end;
end;
end;
WNetCloseEnum(hEnum);
end;
end;
end.
← →
sniknik © (2004-12-01 13:54) [2]
unit Odbc32;
interface
uses
SysUtils, classes, messages;
type
SQLRETURN = ShortInt;
SQLHANDLE = Pointer;
SQLHANDLEPTR = ^Pointer;
SQLHDBC = SQLHANDLE;
SQLHENV = SQLHANDLE;
SQLHSTMT = SQLHANDLE;
SQLCHAR = PChar;
SQLSMALLINT = SmallInt;
SQLSMALLINTPTR = ^ShortInt;
SQLINTEGER = Integer;
SQLPOINTER = Pointer;
const
SQL_HANDLE_ENV = 1;
SQL_NULL_HANDLE = nil;
SQL_SUCCESS = 0;
SQL_SUCCESS_WITH_INFO = 1;
SQL_HANDLE_DBC = 2;
SQL_NTS = -3;
SQL_NEED_DATA = 99;
SQL_ATTR_ODBC_VERSION = 200;
SQL_OV_ODBC3:SQLPOINTER = pointer(3);
function SQLAllocHandle(
HandleType:SQLSMALLINT;
InputHandle:SQLHANDLE;
var OutputHandle:SQLHANDLE):SQLRETURN; stdcall;
function SQLSetEnvAttr(
EnvironmentHandle:SQLHENV;
Attribute:SQLINTEGER;
ValuePtr:SQLPOINTER;
StringLength:SQLINTEGER):SQLRETURN; stdcall;
function SQLBrowseConnect(
ConnectionHandle:SQLHDBC;
InConnectionString:SQLCHAR;
StringLength1:SQLSMALLINT;
OutConnectionString:SQLCHAR;
BufferLength:SQLSMALLINT;
var StringLength2:SQLSMALLINT):SQLRETURN; stdcall;
function SQLFreeHandle(
HandleType:SQLSMALLINT;
Handle:SQLHANDLE):SQLRETURN; stdcall;
//==========MY PROC
function GetSQLServersListODBC(var sl:TStringList):boolean;
implementation
uses rxStrUtils;
function SQLAllocHandle(
HandleType:SQLSMALLINT;
InputHandle:SQLHANDLE;
var OutputHandle:SQLHANDLE):SQLRETURN; external "odbc32.dll";
function SQLSetEnvAttr(
EnvironmentHandle:SQLHENV;
Attribute:SQLINTEGER;
ValuePtr:SQLPOINTER;
StringLength:SQLINTEGER):SQLRETURN; external "odbc32.dll";
function SQLBrowseConnect(
ConnectionHandle:SQLHDBC;
InConnectionString:SQLCHAR;
StringLength1:SQLSMALLINT;
OutConnectionString:SQLCHAR;
BufferLength:SQLSMALLINT;
var StringLength2:SQLSMALLINT):SQLRETURN; external "odbc32.dll";
function SQLFreeHandle(
HandleType:SQLSMALLINT;
Handle:SQLHANDLE):SQLRETURN; external "odbc32.dll";
function GetSQLServersListODBC(var sl:TStringList):boolean;
const
BRWS_LEN = 1024;
var
henv:SQLHENV;
hdbc:SQLHDBC;
retcode:SQLRETURN;
ResArr:array[0..BRWS_LEN] of char;
s, s1, ResStr:string;
pc:PChar;
OutLen:SQLSMALLINT;
i,wc,p1,p2:integer;
begin
result := false;
hdbc := nil;
henv := nil;
pc := @ResArr;
// Allocate the environment handle.
retcode := SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, henv);
if retcode in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then begin
retcode := SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0);
if retcode in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then begin
// Allocate the connection handle.
retcode := SQLAllocHandle(SQL_HANDLE_DBC, henv, hdbc);
if retcode in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO] then begin
retcode := SQLBrowseConnect(hdbc, "DRIVER={SQL Server};", SQL_NTS, pc, SizeOf(ResArr), OutLen);
//ResStr: "SERVER:Server={OPTIMA,EXACT,GSERJ,OPTIMA2,TERMINAL};UID:Login ID=?;PWD:Password=?;*APP:AppName=?;*WSID:WorkStation ID=?"
if retcode = SQL_NEED_DATA then begin // можно считывать вернувшуюся строку
ResStr := ResArr;
// считаем число ключевых слов
wc := WordCount(ResStr,[";"]);
if wc > 0 then begin // список ключевых сло не пуст
p1 := 0; // ищем ключевое слово "SERVER:"
for i := 1 to wc do begin
s := ExtractWord(i, ResStr, [";"]);
p1 := pos("SERVER:",s);
if p1 > 0 then begin
break;
end;
end;
if p1 > 0 then begin // нашли ключевое слово
p1 := pos("{",s);
p2 := pos("}",s);
if (p1 > 0) and (p2 > 0) and (p2 > p1) then begin // нашли список серверов
s := trim(copy(s,p1 + 1, p2 - p1 - 1));
if length(s) > 0 then begin // список серверов не пуст
wc := WordCount(s,[","]);
if wc > 0 then begin
for i := 1 to wc do begin
s1 := AnsiUpperCase(trim(ExtractWord(i, s, [","])));
if pos("(LOCAL)", s1) = 0 then begin
sl.add(s1);
end;
end;
result := boolean(wc);
end;
end;
end;
end;
end;
end;
SQLFreeHandle(SQL_HANDLE_DBC, hdbc);
end;
end;
end;
SQLFreeHandle(SQL_HANDLE_ENV, henv);
end;
end.
← →
ByteButcher (2004-12-01 14:01) [3]Огромное спасибо !!!
← →
ByteButcher (2004-12-01 14:02) [4]А через ADO или ADOX никак это не реализуется?
← →
sniknik © (2004-12-01 14:12) [5]> А через ADO или ADOX никак это не реализуется?
не видел такого.
тебе двух методов мало?
один (первый) рабочий с гарантией. я его "немного" правил под себя (практически переписывал). второй "as is" найден в инете, вроде работает... но гарантий нет. (гдето есть и правленный, мне тут не понравилось статическое лнкование dll которой может и не быть в системе, тоже переделывал, изза этого, помню, но искать влом)
← →
sniknik © (2004-12-01 14:14) [6]хотя нет, нашол... надо же ;о))
замена 2го поста
unit Odbc32;
interface
uses
Windows, Classes;
function GetSQLServersODBC(List: TStrings): boolean;
implementation
type
SQLRETURN = ShortInt;
SQLHANDLE = Pointer;
SQLHANDLEPTR = ^Pointer;
SQLHDBC = SQLHANDLE;
SQLHENV = SQLHANDLE;
SQLHSTMT = SQLHANDLE;
SQLCHAR = PChar;
SQLSMALLINT = SmallInt;
SQLSMALLINTPTR = ^ShortInt;
SQLINTEGER = Integer;
SQLPOINTER = Pointer;
const
SQL_HANDLE_ENV = 1;
SQL_NULL_HANDLE = nil;
SQL_SUCCESS = 0;
SQL_SUCCESS_WITH_INFO = 1;
SQL_HANDLE_DBC = 2;
SQL_NTS = -3;
SQL_NEED_DATA = 99;
SQL_ATTR_ODBC_VERSION = 200;
SQL_OV_ODBC3: SQLPOINTER = pointer(3);
var
DllHandle: THandle;
SQLAllocHandle: function(HandleType: SQLSMALLINT; InputHandle: SQLHANDLE; var OutputHandle: SQLHANDLE): SQLRETURN; stdcall;
SQLSetEnvAttr: function(EnvironmentHandle: SQLHENV; Attribute: SQLINTEGER; ValuePtr: SQLPOINTER;StringLength: SQLINTEGER): SQLRETURN; stdcall;
SQLBrowseConnect: function(ConnectionHandle: SQLHDBC; InConnectionString: SQLCHAR;StringLength1: SQLSMALLINT; OutConnectionString: SQLCHAR; BufferLength: SQLSMALLINT;var StringLength2: SQLSMALLINT): SQLRETURN; stdcall;
SQLFreeHandle: function(HandleType: SQLSMALLINT; Handle: SQLHANDLE): SQLRETURN; stdcall;
function GetSQLServersODBC(List: TStrings): boolean;
const
BRWS_LEN = 1024;
var
Hdbc: SQLHDBC;
Henv: SQLHENV;
ResArr: array of char;
OutLen: SQLSMALLINT;
sTrt, sEnd: integer;
begin
result:= false;
List.Clear;
if DllHandle = 0 then begin
DllHandle:= LoadLibrary(PChar("odbc32.dll"));
if DllHandle < 32 then Exit;
SQLAllocHandle:= GetProcAddress(DllHandle, "SQLAllocHandle");
if @SQLAllocHandle = nil then begin DllHandle:= 0; Exit; end;
SQLSetEnvAttr:= GetProcAddress(DllHandle, "SQLSetEnvAttr");
if @SQLSetEnvAttr = nil then begin DllHandle:= 0; Exit; end;
SQLBrowseConnect:= GetProcAddress(DllHandle, "SQLBrowseConnect");
if @SQLBrowseConnect = nil then begin DllHandle:= 0; Exit; end;
SQLFreeHandle:= GetProcAddress(DllHandle, "SQLFreeHandle");
if @SQLFreeHandle = nil then begin DllHandle:= 0; Exit; end;
end;
Hdbc:= nil;
Henv:= nil;
if not (SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, Henv) in [SQL_SUCCESS, SQL_SUCCESS_WITH_INFO]) then Exit;
try
if not (SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0) in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO]) then Exit;
if not (SQLAllocHandle(SQL_HANDLE_DBC, henv, hdbc) in [SQL_SUCCESS,SQL_SUCCESS_WITH_INFO]) then Exit;
try
SetLength(ResArr, BRWS_LEN);
if SQLBrowseConnect(hdbc, "DRIVER={SQL Server};", SQL_NTS, Pointer(ResArr), BRWS_LEN, OutLen) <> SQL_NEED_DATA then Exit;
if BRWS_LEN < OutLen then begin
SetLength(ResArr, OutLen+1);
if SQLBrowseConnect(hdbc, "DRIVER={SQL Server};", SQL_NTS, Pointer(ResArr), OutLen, OutLen) <> SQL_NEED_DATA then Exit;
end;
sTrt:= Pos("{", PChar(ResArr));
sEnd:= Pos("}", PChar(ResArr));
List.Delimiter:= ",";
List.DelimitedText:= Copy(PChar(ResArr), sTrt+1, sEnd-sTrt-1);
SetLength(ResArr, 0);
result:= true;
finally
SQLFreeHandle(SQL_HANDLE_DBC, hdbc);
end;
finally
SQLFreeHandle(SQL_HANDLE_ENV, henv);
end;
end;
end.
← →
ByteButcher (2004-12-01 14:16) [7]Да нет, достаточно, но хотелось бы знать про ADO.
Все равно ADO активно в проге используется.
← →
Fay © (2004-12-01 14:24) [8]Не проверял, но Вы можете проверить - отсутствует ли SQLDMO где-либо, где есть клиент MSSQL. Мне почему-то кажется, что есть везде.
← →
sniknik © (2004-12-01 14:43) [9]> Мне почему-то кажется, что есть везде.
не везде. (хотя конечно смотря что понимать под клиентом MSSQL)
частая ситуация была работать прога может а списка серверов через DMO не видит (руками внесеш работает). собственно изза этого и начал заниматся модулями что вверху.
сейчас бывает наоборот у меня прога видит(она последовательно все методы перебирает до "победного") а системная (что по PromptDataSource например) дает пустой список (в 98виндах, был замечен такой эффект (возможно еденичный))
← →
Fay © (2004-12-01 15:19) [10]Не проверял, но Вы можете проверить - отсутствует ли SQLDMO где-либо, где есть клиент MSSQL. Мне почему-то кажется, что есть везде.
← →
Fay © (2004-12-01 17:13) [11]2 sniknik © (01.12.04 14:12) [5]
>> один (первый) рабочий с гарантией
Windows 95/98/Me: Unsupported
← →
sniknik © (2004-12-01 22:55) [12]на устаревшие системы гарантия не распространяется.
сделал универсальнее? ну так выкладывай.
← →
Fay © (2004-12-02 03:35) [13]sniknik © (01.12.04 22:55) [12]
Поставить SQL DMO.
← →
Reindeer Moss Eater © (2004-12-02 09:07) [14]Список серверов логичнее брать в конфигурации установленного клиента MSSQL.
← →
bytebutcher (2004-12-06 12:50) [15]Кстати SQL DMO для получения списка доступных серверов использует ODBC. ПРОВЕРЕНО!
← →
Nikolay M. © (2004-12-06 13:13) [16]
> bytebutcher (06.12.04 12:50) [15]
> Кстати SQL DMO для получения списка доступных серверов использует
> ODBC. ПРОВЕРЕНО!
Откуда дровишки? Где посмотреть?
← →
paul_k © (2004-12-06 13:15) [17]Список серверов.. значит и домен есть?
тогда из Active Directory можно вынуть.
Страницы: 1 вся ветка
Форум: "Базы";
Текущий архив: 2005.01.02;
Скачать: [xml.tar.bz2];
Память: 0.52 MB
Время: 0.034 c