VB得到網絡中可用的SQL服務器列表

_{得到網絡中可用的SQL服務器列表 
  
  'RETCODEs 
  Private   Const   SQL_ERROR   As   Long   =   -1& 
  Private   Const   SQL_INVALID_HANDLE   As   Long   =   -2& 
  Private   Const   SQL_NEED_DATA   As   Long   =   99& 
  Private   Const   SQL_NO_DATA_FOUND   As   Long   =   100& 
  Private   Const   SQL_SUCCESS   As   Long   =   0& 
  Private   Const   SQL_SUCCESS_WITH_INFO   As   Long   =   1& 
  
  'SQLError   defines 
  Private   Const   SQL_NULL_HENV   As   Long   =   0& 
  Private   Const   SQL_NULL_HDBC   As   Long   =   0& 
  Private   Const   SQL_NULL_HSTMT   As   Long   =   0& 
  
  Declare   Function   SQLAllocConnect   Lib   "odbc32.dll"   (ByVal   henv   As   Long,   _ 
                                    phdbc   As   Long)   As   Integer 
  Declare   Function   SQLAllocEnv   Lib   "odbc32.dll"   (phenv   As   Long)   As   Integer 
  Declare   Function   SQLBrowseConnect   Lib   "odbc32.dll"   (ByVal   hdbc   As   Long,   _ 
                                    ByVal   szConnStrIn   As   String,   ByVal   cbConnStrIn   As   Integer,   _ 
                                    ByVal   szConnStrOut   As   String,   ByVal   cbConnStrOutMax   As   Integer,   _ 
                                    pcbconnstrout   As   Integer)   As   Integer 
  Declare   Function   SQLDisconnect   Lib   "odbc32.dll"   (ByVal   hdbc   As   Long)   As   Integer 
  Declare   Function   SQLError   Lib   "odbc32.dll"   (ByVal   henv   As   Long,   ByVal   hdbc   As   Long,   _ 
                                    ByVal   hstmt   As   Long,   ByVal   szSqlState   As   String,   pfNativeError   As   Long,   _ 
                                    ByVal   szErrorMsg   As   String,   ByVal   cbErrorMsgMax   As   Integer,   _ 
                                    pcbErrorMsg   As   Integer)   As   Integer 
  Declare   Function   SQLFreeConnect   Lib   "odbc32.dll"   (ByVal   hdbc   As   Long)   As   Integer 
  Declare   Function   SQLFreeEnv   Lib   "odbc32.dll"   (ByVal   henv   As   Long)   As   Integer 
  
  Public   Function   StServerList()   As   String 
      On   Error   Resume   Next 
      Dim   rc                 As   Integer 
      Dim   henv             As   Long 
      Dim   hdbc             As   Long 
      Dim   stCon           As   String 
      Dim   stConOut     As   String 
      Dim   pcbConOut   As   Integer 
      Dim   ichBegin     As   Integer 
      Dim   ichEnd         As   Integer 
      Dim   stOut           As   String 
          
      Const   COMMA   As   String   =   "," 
          
      rc   =   SQLAllocEnv(henv) 
      rc   =   SQLAllocConnect(ByVal   henv,   hdbc) 
      stCon   =   "DRIVER=SQL   Server" 
          
      'Get   the   size   of   the   buffer   to   create   and   create   it 
      rc   =   SQLBrowseConnect(ByVal   hdbc,   stCon,   Len(stCon),   stConOut,   _ 
                Len(stConOut)   +   2,   pcbConOut) 
      stConOut   =   String$(pcbConOut   +   2,   vbNullChar) 
          
      'Get   the   actual   server   list 
      rc   =   SQLBrowseConnect(ByVal   hdbc,   stCon,   Len(stCon),   stConOut,   _ 
                Len(stConOut)   +   2,   pcbConOut) 
          
      If   (rc   <>   SQL_SUCCESS)   And   (rc   <>   SQL_NEED_DATA)   Then 
            'ignore   the   errors   if   any   occur 
      Else 
            'Parse   out   the   server   list 
            ichBegin   =   InStr(InStr(1,   stConOut,   "server="),   stConOut,   "{",   vbBinaryCompare) 
            stOut   =   Mid$(stConOut,   ichBegin   +   1) 
            ichEnd   =   InStr(1,   stOut,   "}",   vbBinaryCompare) 
            StServerList   =   Left$(stOut,   ichEnd   -   1) 
      End   If 
  
      'Disconnect,   free   the   connection   handle,   then 
      'free   the   environment   handle. 
      rc   =   SQLDisconnect(hdbc) 
      rc   =   SQLFreeConnect(hdbc) 
      rc   =   SQLFreeEnv(henv) 
  End   Function 
  
  Private   Sub   Form_Load() 
      MsgBox   StServerList 
  End   Sub}