VFP检测SQL Server的五个实例代码

** 需要指出的是，无论下面哪种方式的代码，都需要打开本机的网络共享，否则找不到SQL服务器
** 例一 ***************************************************
* Use MyFll.Fll(下载MyFll)
Set Library To MyFll
lcLocalName = Left(Sys(0),At("#",Sys(0))-2)
lcLocalIP = DomainToIP(lcLocalName)
? '本机名：'+ lcLocalName
? '本机的 IP 为：'+ lcLocalIP
IF lcLocalIP == '127.0.0.1'
   ? '本机现在处于单机状态，未联接网络，或网络适配器停用！'
ENDIF

cStr=GetSqlServer()
nCount=ALines(aServer,cStr,",")   &&切分生成数组
?
? "可连接的 SQL Server 服务器"+Transform(nCount)+"个,分别为："
For ii=1 to nCount
    ? ii,aServer[ii] &&将名字显示出来
EndFor
Set Library To

** 例二 ****************************************************
* Use SqlDMO.DLL, must install SQLServer or SqlDMO
loSqlDMO=Createobject("SQLDMO.Application")
loSvrs=loSqlDMO.ListAvailableSQLServers()
lnSvrsCount=loSvrs.Count
?
If lnSvrsCount=0
    ? "没有找到可用的 SQL Server 服务器。"
Else
    ? "可连接的 SQL Server 服务器"+Transform(lnSvrsCount)+"个,分别为："
    For ii=1 TO lnSvrsCount
        ? ii,loSvrs.Item(ii)
    Endfor
Endif
Release loSqlDMO

** 例三 *****************************************************
* Use Windows API, Only VFP9
#Define MAX_PREFERRED_LENGTH        -1
#Define SV_TYPE_SQLSERVER           0x00000004

Declare Long NetServerEnum In netapi32 string ServerName, Long nlevel, ;
        Long @ bufptr, Long prefmaxlen, long @ entriesread, ;
        Long @ totalentries, Long servertype, string domain, Long resume_handle
Declare Long NetApiBufferFree In netapi32 Long bufptr
Declare Long lstrlenW In win32api String @ lpString

If Version(5)<900
   =MessageBox( '需要 vfp 9.0 运行环境！', 16, '错误！' )
Else
   ?
   Store 0 To lnBuff, lnReadNums, lnTotNums
   If 0 == NetServerEnum( Null, 100, @ lnBuff, MAX_PREFERRED_LENGTH, @ lnReadNums, ;
                          @ lnTotNums, SV_TYPE_SQLSERVER, Null, 0) and lnReadNums > 0
      ? "可连接的 SQL Server 服务器"+TRANSFORM(lnReadNums)+"个,分别为："
      For ii = 1 To lnReadNums
          m.lnAddr = CToBin(Sys(2600, m.lnBuff + (m.ii-1)*8 + 4, 4), 'RS')
          m.lcSrv = Sys(2600, m.lnAddr, 256)
          ? ii,Left(Strconv(m.lcSrv, 6), lstrlenW(m.lcSrv))
      Endfor
   Else
      ? '没有找到可用的 SQL Server 实例。'
   Endif
   If lnBuff > 0
      NetApiBufferFree(lnBuff)
   Endif
Endif
CLEAR DLLS

** 例四 ***********************************************
** 为了与其他例子类似处理，将本例中的Cursor或Table除去了，同时代码也作了相应修改。特注明！
*-----------------------------------------------
* 函数: 获取局域网内所有SqlServer
* 设计: 红雨
* 时间: 2005.04.01
*-----------------------------------------------
?
? NetEnumSqlServer()

Function NetEnumSqlServer()
    Declare SHORT SQLBrowseConnect In odbc32 Integer ConnectionHandle, String InConnectionString, ;
            Integer StringLength1, String @ OutConnectionString, Integer BufferLength, Integer @ StringLength2Ptr
    Declare SHORT SQLAllocHandle In odbc32 Integer HandleType, Integer InputHandle, Integer @ OutputHandlePtr
    Declare SHORT SQLFreeHandle In odbc32 Integer HandleType, Integer Handle
    Declare SHORT SQLSetEnvAttr In odbc32 Integer EnvironmentHandle, Integer Attribute, ;
            Integer ValuePtr, Integer StringLength

Local hEnv, hConn, cInString, cOutString, nLenOutString, nCnt, iCnt
    m.nCnt = 0
    m.hEnv = 0
    m.hConn = 0
    m.cInString = "DRIVER=SQL SERVER"
    m.cOutString = Space(2048)
    m.nLenOutString = 0
    Local Array aServerList[1]

If SQLAllocHandle(1, 0, @hEnv) = 0
        If SQLSetEnvAttr(m.hEnv, 200, 3, 0) = 0
            If SQLAllocHandle(2, m.hEnv, @hConn) = 0
                If SQLBrowseConnect(m.hConn, @cInString, Len(m.cInString), @cOutString, 2048, @nLenOutString) = 99
                    m.nCnt = Alines(aServerList, Strextract(m.cOutString, '{', '}'), .T., ',')
                    lcMsg = '可连接的 SQL Server 服务器'+TRANSFORM(m.nCnt)+'个,分别为：' 
                    For m.iCnt = 1 To m.nCnt
                        lcMsg = lcMsg + Chr(13) + Chr(10) + Chr(9) + Transform(m.iCnt) + aServerList[iCnt]
                    Endfor
                Else
                    lcMsg = '没有找到可用的 SQL Server 实例。'
                Endif
            Endif
        Endif
    Endif
    Clear Dlls
    Return lcMsg
Endfunc
*************************************************

** 例五 ************************** 此例与红雨先生的上例近似，也取自网络并作部分修改
?
? GetNetSqlServerApi()

Function GetNetSqlServerApi()
* Use ODBC API
#Define SQL_HANDLE_ENV          1 
#Define SQL_HANDLE_DBC          2 
#Define SQL_NULL_HANDLE         0 
#Define SQL_SUCCESS         0 
#Define SQL_SUCCESS_WITH_INFO       1 
#Define SQL_NEED_DATA           99 
#Define SQL_ERROR           -1 
#Define SQL_INVALID_HANDLE      -2 
#Define SQL_ATTR_ODBC_VERSION       200 
#Define SQL_OV_ODBC3            3 
#Define SQL_NTS             -3 
#Define ENUM_SERVERS_MAX_RET_LENGTH -1  
 
lcDrvName = 'Driver={SQL Server}'

Declare short SQLAllocHandle In odbc32 short HandleType, Long InputHandle, Long @ OutputHandlePtr
Declare short SQLSetEnvAttr In odbc32 long EnvironmentHandle, Long nAttribute, Long ValuePtr, Long StringLength
Declare short SQLBrowseConnect In odbc32 long ConnectionHandle, String InConnectionString, short StringLength1, ;
        String @ OutConnectionString, short BufferLength, short @ StringLength2Ptr
Declare short SQLDisconnect In odbc32 As _SQLDisconnect long ConnectionHandle
Declare short SQLFreeHandle In odbc32 long HandleType, Long Handle

* Allocate the environment handle  
hSQLEnv = 0
lnResult = SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, @ hSQLEnv)
If (lnResult == SQL_SUCCESS Or lnResult == SQL_SUCCESS_WITH_INFO)
    * Set the environment attribute to SQL_OV_ODBC3
    lnResult = SQLSetEnvAttr(hSQLEnv, SQL_ATTR_ODBC_VERSION, SQL_OV_ODBC3, 0)
    If (lnResult == SQL_SUCCESS Or lnResult == SQL_SUCCESS_WITH_INFO)
        * Allocate a connection handle
        hSQLHdbc = 0
        lnResult = SQLAllocHandle(SQL_HANDLE_DBC, hSQLEnv, @ hSQLHdbc)
        If (lnResult == SQL_SUCCESS Or lnResult == SQL_SUCCESS_WITH_INFO)
            szConnStrOut = SPACE(2048)
            lnLen = 0
            * Call SQLBrowseConnect for additional information  
            lnResult = SQLBrowseConnect(hSQLHdbc, lcDrvName, Len(m.lcDrvName), @ szConnStrOut, 2048, @ lnLen)
            If (lnResult == SQL_SUCCESS Or lnResult == SQL_NEED_DATA)
                 Return ListSqlServersList(Left(szConnStrOut, lnLen))
            Endif
            _SQLDisconnect(hSQLHdbc)  
        Endif  
        SQLFreeHandle(SQL_HANDLE_DBC, hSQLHdbc)  
    Endif  
Endif  
SQLFreeHandle(SQL_HANDLE_ENV, hSQLEnv)
Clear Dlls
Endfunc

Function ListSqlServersList(tcConnectString)  
    Local ii, lcSvrs, lcSvr, lcMsg, laSvrs[1]  
    m.nCnt = Alines(laSvrs, Strextract(tcConnectString, '{', '}'), .T., ',')
    If m.nCnt > 0
        lcMsg = '找到 '+TRANSFORM(m.nCnt)+'个 SQL Server 实例：'
        For m.ii = 1 To m.nCnt
            lcMsg = lcMsg + Chr(13) + Chr(10) + Chr(9) + Transform(m.ii) + laSvrs[m.ii]  
        Endfor  
    Else
        lcMsg = '没有找到可用的 SQL Server 实例。'
    Endif
    Return lcMsg
Endfunc