| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как получить список доступных MS SQL серверов?

ByteButcher ©   (2004-12-01 13:30:00) 

Я знаю как сделать это через SQL DMO. Но не хотелось бы тянуть вместе с прогой еще и SQL DMO. Подскажите как можно получить список доступных серверов БД используя ODBC.
А может в ADO или ADOX есть такая возможность?

---

paul_k   (2004-12-06 13:15:00) [1]

Список серверов.. значит и домен есть?
тогда из Active Directory  можно вынуть.

---

Nikolay M.   (2004-12-06 13:13:00) [2]

> bytebutcher   (06.12.04 12:50) [15]
> Кстати SQL DMO для получения списка доступных серверов использует
> ODBC. ПРОВЕРЕНО!

Откуда дровишки? Где посмотреть?

---

bytebutcher   (2004-12-06 12:50:00) [3]

Кстати SQL DMO для получения списка доступных серверов использует ODBC. ПРОВЕРЕНО!

---

Reindeer Moss Eater   (2004-12-02 09:07:00) [4]

Список серверов логичнее брать в конфигурации установленного клиента MSSQL.

---

Fay   (2004-12-02 03:35:00) [5]

sniknik ©   (01.12.04 22:55) [12]
Поставить SQL DMO.

---

sniknik   (2004-12-01 22:55:00) [6]

на устаревшие системы гарантия не распространяется.
сделал универсальнее? ну так выкладывай.

---

Fay   (2004-12-01 17:13:00) [7]

2 sniknik ©   (01.12.04 14:12) [5]
>> один (первый) рабочий с гарантией
Windows 95/98/Me: Unsupported

---

Fay   (2004-12-01 15:19:00) [8]

Не проверял, но Вы можете проверить - отсутствует ли SQLDMO где-либо, где есть клиент MSSQL. Мне почему-то кажется, что есть везде.

---

sniknik   (2004-12-01 14:43:00) [9]

> Мне почему-то кажется, что есть везде.
не везде. (хотя конечно смотря что понимать под клиентом MSSQL)
частая ситуация была работать прога может а списка серверов через DMO не видит (руками внесеш работает). собственно изза этого и начал заниматся модулями что вверху.
сейчас бывает наоборот у меня прога видит(она последовательно все методы перебирает до "победного") а системная (что по  PromptDataSource например) дает пустой список (в 98виндах, был замечен такой эффект (возможно еденичный))

---

Fay   (2004-12-01 14:24:00) [10]

Не проверял, но Вы можете проверить - отсутствует ли SQLDMO где-либо, где есть клиент MSSQL. Мне почему-то кажется, что есть везде.

---

ByteButcher   (2004-12-01 14:16:00) [11]

Да нет, достаточно, но хотелось бы знать про ADO.
Все равно ADO активно в проге используется.

---

sniknik   (2004-12-01 14:14:00) [12]

хотя нет, нашол... надо же ;о))
замена 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.


---

sniknik   (2004-12-01 14:12:00) [13]

> А через ADO или ADOX никак это не реализуется?
не видел такого.

тебе двух методов мало?
один (первый) рабочий с гарантией. я его "немного" правил под себя (практически переписывал). второй "as is" найден в инете, вроде работает... но гарантий нет. (гдето есть и правленный, мне тут не понравилось статическое лнкование dll которой может и не быть в системе, тоже переделывал, изза этого, помню, но искать влом)

---

ByteButcher   (2004-12-01 14:02:00) [14]

А через ADO или ADOX никак это не реализуется?

---

ByteButcher   (2004-12-01 14:01:00) [15]

Огромное спасибо !!!

---

sniknik   (2004-12-01 13:54:00) [16]


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.


---

sniknik   (2004-12-01 13:53:00) [17]


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.


---

Наверх