获取SQL Server服务器列表的几种方法
 
一、      SQL DMO
描述:SQL Distributed Management Objects(SQL分布式管理对象),存在于SQLDMO.dll文件中,实际上是一个COM 对象,通过调用SQL DMO的ListAvailableSQLServers方法取得。
列表类型:列举装有“客户端”和“服务端”的计算机。
适用条件:装有 SQL Server,且有SQLDMO.dll文件。
速度:中
调用示例:GetSQLServerList(ListBox1.items);
代码:
  ComObj;
function GetSQLServerList(var AList: TStrings): Boolean;
  SQLServerApp: Variant;
  ServerList: Variant;
  i: Integer;
  Result := True;
  try
    SQLServerApp := CreateOleObject('SQLDMO.Application');
    ServerList := SQLServerApp.ListAvailableSQLServers;
    for i := 1 to ServerList.Count do
      AList.Add(ServerList.Item(i));
    SQLServerApp := Unassigned;
    ServerList := Unassigned;
  except
    Result := False;
二、      NetServerEnum
描述:网络服务函数,存在于NetApi32.dll文件中;通过NetServerEnum函数可取得装有SQL Server服务端的计算机列表,只装有SQL Server客户端的计算机将不会被列举其中;如果一台计算机的SQL Server服务刚刚启动,那么此函数将会过很久才能取到该计算机。
列表类型:仅列举装有“服务端”的计算机。
适用条件:有NetApi32.dll文件。
速度:快
type
  NET_API_STATUS = DWORD;
  PServerInfo100 = ^TServerInfo100;
  _SERVER_INFO_100 = record
    sv100_platform_id: DWORD;
    sv100_name: LPWSTR;
  {$EXTERNALSYM _SERVER_INFO_100}
  TServerInfo100 = _SERVER_INFO_100;
  SERVER_INFO_100 = _SERVER_INFO_100;
  {$EXTERNALSYM SERVER_INFO_100}
const
  NERR_Success = 0;
  MAX_PREFERRED_LENGTH = DWORD(-1);
  SV_TYPE_SQLSERVER    = $00000004;
function NetApiBufferAllocate(ByteCount: DWORD; var Buffer: Pointer):
  NET_API_STATUS; stdcall; external 'netapi32.dll' name 'NetApiBufferAllocate';
function NetServerEnum(ServerName: LPCWSTR; Level: DWORD; var BufPtr: Pointer;
  PrefMaxLen: DWORD; var EntriesRead: DWORD; var TotalEntries: DWORD;
  ServerType: DWORD; Domain: LPCWSTR; ResumeHandle: PDWORD): NET_API_STATUS;
  stdcall; external 'netapi32.dll' name 'NetServerEnum';
function NetApiBufferFree(Buffer: Pointer): NET_API_STATUS; stdcall; external
'netapi32.dll' name 'NetApiBufferFree';
function GetSQLServerList(var AList: TStrings; pwcServerName: PWChar = nil;
  pwcDomain: PWChar = nil): Boolean;
  NetAPIStatus: DWORD;
  dwLevel: DWORD;
  pReturnSvrInfo: Pointer;
  dwPrefMaxLen: DWORD;
  dwEntriesRead: DWORD;
  dwTotalEntries: DWORD;
  dwServerType: DWORD;
  dwResumeHandle: PDWORD;
  pCurSvrInfo: PServerInfo100;
  i, j: Integer;
    dwLevel := 100;
    pReturnSvrInfo := nil;
    dwPrefMaxLen := MAX_PREFERRED_LENGTH;
    dwEntriesRead := 0;
    dwTotalEntries := 0;
    dwServerType := SV_TYPE_SQLSERVER;    //服务器类型
    dwResumeHandle := nil;
    NetApiBufferAllocate(SizeOf(pReturnSvrInfo), pReturnSvrInfo);
    try
      NetAPIStatus := NetServerEnum(pwcServerName, dwLevel, pReturnSvrInfo,
        dwPrefMaxLen, dwEntriesRead, dwTotalEntries, dwServerType, pwcDomain,
        dwResumeHandle);
      if ((NetAPIStatus = NERR_Success) or (NetAPIStatus = ERROR_MORE_DATA)) and
        (pReturnSvrInfo <> nil) then
      begin
        pCurSvrInfo := pReturnSvrInfo;
        // 循环取得所有SQL Server服务器
        i := 0;
        j := dwEntriesRead;
        while i < j do
        begin
          if pCurSvrInfo = nil then
            Break;
          with AList do
            Add(pCurSvrInfo^.sv100_name);
          Inc(i);
          Inc(pCurSvrInfo);
        end;
      end;
    finally
      if Assigned(pReturnSvrInfo) then
        NetApiBufferFree(pReturnSvrInfo);
    end;

 unit   uEnumSQLServer;  
   
  interface  
   
  uses   Windows,   Classes,   SysUtils;  
   
  type  
      NET_API_STATUS   =   DWORD;  
   
      PServerInfo100   =   ^TServerInfo100;  
      _SERVER_INFO_100   =   record  
          sv100_platform_id:   DWORD;  
          sv100_name:   LPWSTR;  
      end;  
  {$EXTERNALSYM   _SERVER_INFO_100}  
      TServerInfo100   =   _SERVER_INFO_100;  
      SERVER_INFO_100   =   _SERVER_INFO_100;  
  {$EXTERNALSYM   SERVER_INFO_100}  
   
  const  
      NERR_Success   =   0;  
      MAX_PREFERRED_LENGTH   =   DWORD(-1);  
      SV_TYPE_SQLSERVER   =   $00000004;  
   
  function   NetApiBufferAllocate(ByteCount:   DWORD;   var   Buffer:   Pointer):  
      NET_API_STATUS;   stdcall;   external   'netapi32.dll'   name   'NetApiBufferAllocate';  
   
  function   NetServerEnum(ServerName:   LPCWSTR;   Level:   DWORD;   var   BufPtr:   Pointer;  
      PrefMaxLen:   DWORD;   var   EntriesRead:   DWORD;   var   TotalEntries:   DWORD;  
      ServerType:   DWORD;   Domain:   LPCWSTR;   ResumeHandle:   PDWORD):   NET_API_STATUS;  
  stdcall;   external   'netapi32.dll'   name   'NetServerEnum';  
   
  function   NetApiBufferFree(Buffer:   Pointer):   NET_API_STATUS;   stdcall;   external  
  'netapi32.dll'   name   'NetApiBufferFree';  
   
  function   GetSQLServerList(out   AList:   TStrings;   pwcServerName:   PWChar   =   nil;  
      pwcDomain:   PWChar   =   nil):   Boolean;  
   
  implementation  
   
  function   GetSQLServerList(out   AList:   TStrings;   pwcServerName:   PWChar   =   nil;  
      pwcDomain:   PWChar   =   nil):   Boolean;  
  var  
      NetAPIStatus:   DWORD;  
      dwLevel:   DWORD;  
      pReturnSvrInfo:   Pointer;  
      dwPrefMaxLen:   DWORD;  
      dwEntriesRead:   DWORD;  
      dwTotalEntries:   DWORD;  
      dwServerType:   DWORD;  
      dwResumeHandle:   PDWORD;  
      pCurSvrInfo:   PServerInfo100;  
      i,   j:   Integer;  
  begin  
      Result   :=   True;  
      try  
          if   Trim(pwcServerName)   =   ''   then  
              pwcServerName   :=   nil;  
   
          if   Trim(pwcDomain)   =   ''   then  
              pwcDomain   :=   nil;  
   
          dwLevel   :=   100;  
          pReturnSvrInfo   :=   nil;  
          dwPrefMaxLen   :=   MAX_PREFERRED_LENGTH;  
          dwEntriesRead   :=   0;  
          dwTotalEntries   :=   0;  
          dwServerType   :=   SV_TYPE_SQLSERVER;  
          dwResumeHandle   :=   nil;  
   
          NetApiBufferAllocate(SizeOf(pReturnSvrInfo),   pReturnSvrInfo);  
          try  
              NetAPIStatus   :=   NetServerEnum(pwcServerName,   dwLevel,   pReturnSvrInfo,  
                  dwPrefMaxLen,   dwEntriesRead,   dwTotalEntries,   dwServerType,   pwcDomain,  
                  dwResumeHandle);  
   
              if   (NetAPIStatus   =   NERR_Success)   and   (pReturnSvrInfo   <>   nil)   then  
              begin  
                  pCurSvrInfo   :=   pReturnSvrInfo;  
   
                  i   :=   0;  
                  j   :=   dwEntriesRead;  
                  while   i   <   j   do  
                  begin  
                      if   pCurSvrInfo   =   nil   then  
                          Break;  
   
                      with   AList   do  
                          Add(pCurSvrInfo^.sv100_name);  
   
                      Inc(i);  
                      Inc(pCurSvrInfo);  
                  end;  
              end;  
          finally  
              if   Assigned(pReturnSvrInfo)   then  
                  NetApiBufferFree(pReturnSvrInfo);  
          end;  
      except  
          Result   :=   False;  
      end;  
  end;  
   
  end.  


三、      SQLBrowseConnect
描述:ODBC函数(Microsoft Open Database Connectivity,开放式数据库连接),存在于odbc32.dll文件中;通过SQLBrowseConnect函数可返回连接字符串信息,包括DSN、DRIVER、SERVER、UID、PWD、APP、WSID、DATABASE、LANGUAGE等信息。在函数GetODBCInfo 中传入itServer、itDatabase、itLanguage可分别取得“服务器”、“数据库”及“语言”等信息列表,其中itDatabase、itLanguage默认取本地信息,取远程信息请自行修改“'Driver={SQL Server};SERVER=(local);UID=sa;PWD='”连接字符串。
适用条件:由于MDAC 2.6 、2.6 SP1、2.7和Microsoft ODBC Driver for SQL Server 2000 2000.80.194有Bug,因此在这些版本中此函数无法取得Microsoft SQL Server 7.0的服务器。
调用示例:GetODBCInfo(ListBox1.items, itServer);
  TInfoType = (itServer, itDatabase, itLanguage);
  SQLHANDLE    = Pointer;
  SQLSMALLINT  = SHORT;
  SQLINTEGER   = LongInt;
  PSQLHANDLE   = ^SQLHANDLE;
  SQLHENV      = SQLHANDLE;
  SQLHDBC      = SQLHANDLE;
  SQLRETURN    = SQLSMALLINT;
  SQLCHAR      = UCHAR;
  PSQLCHAR     = ^SQLCHAR;
  SQLPOINTER   = Pointer;
  PSQLSMALLINT = ^SQLSMALLINT;
function SQLAllocHandle(HandleType: SQLSMALLINT; InputHandle: SQLHANDLE;
  OutputHandle: PSQLHANDLE): SQLRETURN; stdcall; external 'odbc32.dll' name
  'SQLAllocHandle';
function SQLSetEnvAttr(EnvironmentHandle: SQLHENV; Attribute: SQLINTEGER;
  Value: SQLPOINTER; StringLength: SQLINTEGER): SQLRETURN; stdcall; external
  'odbc32.dll' name 'SQLSetEnvAttr';
function SQLBrowseConnect(hdbc: SQLHDBC; szConnStrIn: PSQLCHAR;
  cbConnStrIn: SQLSMALLINT; szConnStrOut: PSQLCHAR;
  cbConnStrOutMax: SQLSMALLINT; pcbConnStrOut: PSQLSMALLINT): SQLRETURN;
  stdcall; external 'odbc32.dll' name 'SQLBrowseConnect';
function SQLDisconnect(ConnectionHandle: SQLHDBC): SQLRETURN; stdcall; external
  'odbc32.dll' name 'SQLDisconnect';
function SQLFreeHandle(HandleType: SQLSMALLINT; Handle: SQLHANDLE): SQLRETURN;
  stdcall; external  'odbc32.dll' name 'SQLFreeHandle';
  SQL_HANDLE_ENV        = 1;
  SQL_HANDLE_DBC        = 2;
  SQL_NULL_HANDLE       = LongInt(0);
  SQL_SUCCESS           = 0;
  SQL_ERROR             = -1;
  SQL_ATTR_ODBC_VERSION = 200;
  SQL_OV_ODBC3          = ULONG(3);
  SQL_NTS               = -3;
function GetODBCInfo(var AList: TStrings; InfoType: TInfoType): Boolean;
  ConnStrOutMax = 4824;
  SplitterStr = '={';
  HENV: SQLHENV;
  HDBC: SQLHDBC;
  RetCode: SQLRETURN;
  ConnStrOut: PSQLCHAR;
  cbConnStrOut: SQLSMALLINT;
  ConnStrIn, TmpStr: string;
  TmpPos: Integer;
  case InfoType of
    itServer: ConnStrIn := 'Driver={SQL Server}';
    itDatabase, itLanguage: ConnStrIn := 'Driver={SQL Server};SERVER=(local);UID=sa;PWD=';
  Result := False;
    // 分配 ODBC 环境句柄
    RetCode := SQLAllocHandle(SQL_HANDLE_ENV, SQLPOINTER(SQL_NULL_HANDLE), @HENV);
    if RetCode = SQL_ERROR then
      Exit;
    // 设置 ODBC 版本
    RetCode := SQLSetEnvAttr(HENV, SQL_ATTR_ODBC_VERSION, SQLPointer(SQL_OV_ODBC3), 0);
    if RetCode <> SQL_SUCCESS then
    // 分配数据库连接句柄
    RetCode := SQLAllocHandle(SQL_HANDLE_DBC, HENV, @HDBC);
    GetMem(ConnStrOut, ConnStrOutMax);
    RetCode := SQLBrowseConnect(HDBC, PSQLCHAR(ConnStrIn), SQL_NTS, ConnStrOut,
      ConnStrOutMax, @cbConnStrOut);
    if RetCode <> SQL_ERROR then
    begin
      TmpStr := PChar(ConnStrOut);
      if InfoType = itLanguage then
        Delete(TmpStr, 1, AnsiPos('};', TmpStr) + 1);
      Delete(TmpStr, 1, AnsiPos(SplitterStr, TmpStr) + 1);
      Delete(TmpStr, AnsiPos('}', TmpStr), Length(TmpStr));
      while TmpStr <> '' do
        TmpPos := AnsiPos(',', TmpStr);
        if TmpPos > 0 then
          AList.Add(Copy(TmpStr, 1, TmpPos - 1))
        else
          AList.Add(TmpStr);
          TmpStr := '';
        Delete(TmpStr, 1, TmpPos)
      Result := True;
    FreeMem(ConnStrOut, ConnStrOutMax);
  finally
    if Assigned(HDBC) then
      SQLDisconnect(HDBC);
      SQLFreeHandle(SQL_HANDLE_DBC, HDBC);
      HDBC := nil;
    if Assigned(HENV) then
      SQLFreeHandle(SQL_HANDLE_ENV, HENV);
      HENV := nil;
-------------------
构造一个连接字串,从一个ini文件读取参数。
var AppIni: TIniFile;
  IniFile, TFStr,: string;
  Source, User, Passwd, DBase: string;
  IniFile := ChangeFileExt(Application.ExeName, '.INI');
  if FileExists(IniFile) then
  begin
    AppIni := TIniFile.Create(IniFile);
      Source := AppIni.ReadString('DataBaseSet', 'Source', '');
      User := AppIni.ReadString('DataBaseSet', 'User', '');
      Passwd := AppIni.ReadString('DataBaseSet', 'Passwd', '');
      DBase := AppIni.ReadString('DataBaseSet', 'DBase', '');
      Provider := AppIni.ReadString('DataBaseSet', 'Provider', '');
      //Provider := 'SQLOLEDB.1'
    if Ado.Passwd = '' then TFStr := 'False' else TFStr := 'True';
    ADOCon.Close();
    ADOCon.ConnectionString :=
      'Locale Identifier=2052' +
      ';Use Procedure for Prepare=1' +
      ';Auto Translate=True' +
      ';Packet Size=4096' +
      ';Persist Security Info=' + TFStr +
      ';Provider=' + Ado.Provider +
      ';Password=' + Ado.Passwd +
      ';Workstation ID=' + Ado.Source +
      ';Connect Timeout=' + IntToStr(Ado.Time) +
      ';User ID=' + Ado.User +
      ';Data Source=' + Ado.Source +
      ';Initial Catalog=' + ADO.DBase;
    ADOCon.Open();
      Application.MessageBox('数据库连接失败,请通知系统管理员', '提示', MB_ICONWARNING);