1、除了用SQL-DMO组件外还有没有其他方法可以获取。
2、怎样在没有安装SQL机子上注册SQLDMO.DLL文件。
各位帮帮忙
2、怎样在没有安装SQL机子上注册SQLDMO.DLL文件。
各位帮帮忙
解决方案 »
- ActiveX部件不能创建对象!求助!!!
- 剔除重复数据的问题,(找遍csdn没有答案)
- 怎样固定生成窗口的大小?
- VB应该采用何种SQL语法来查询连个时间段之间的东东啊?
- SoS!
- 怎么才能在程序中关闭另一个程序呢?在线等待!!!
- 我把Form1.BorderStyle 设为 0,那我应如何使我的程序在最小化是在任务栏中的像是按钮的东东中加多显示一个图标?我指的不是系统托盘呀!
- 我在程序里对PictureBox得picture赋值,应该怎样写????急
- 不好意思,求出一字符再另一字符串中出現的個數的函數是哪個的??我忘了.
- 关于DOEVENTS()的问题
- 知道对方的IP,怎样禁止他访问我的数据库
- 升▲▲▲▲了,散分!
引用 Microsoft SQLDMO Object Library
'下面是代码
Option Explicit
Private Sub Command1_Click()
On Error GoTo Err1
Dim dmoObj As New SQLDMO.Application
Dim I As Long
For I = 1 To dmoObj.ListAvailableSQLServers.Count
List1.AddItem dmoObj.ListAvailableSQLServers.Item(I)
Next
Err1:
End Sub
Private Function getSNameList() As Boolean
Dim errVSQL As Boolean
errVSQL = True
On Error GoTo errSQL
Dim Server As SQLDMO.NameList
Dim appDMO As New SQLDMO.Application
Dim i As Integer
Set Server = appDMO.ListAvailableSQLServers
For i = 1 To Server.Count
cmbSName.AddItem Server(i)
Next
errVSQL = False
errSQL:
If errVSQL Then
getSNameList = False
Else
getSNameList = True
End If
End FunctionPrivate Sub Form_Load()
getSNameList
End Sub
最主要API:NetServerEnum具体你自己在研究研究如果我给的代码少什么东西我再给你找
Private Declare Function NetServerEnum Lib "netapi32" (strServername As Any, ByVal level As Long, BufPtr As Long, ByVal prefmaxlen As Long, entriesread As Long, totalentries As Long, ByVal servertype As Long, strDomain As Any, resumehandle As Long) As LongPublic Function GetAllDomainSQLServers(ByRef aServer() As String) As Boolean
Dim l As Long, entriesread As Long, totalentries As Long, hREsume As Long
Dim BufPtr As Long, level As Long, prefmaxlen As Long, lType As Long
Dim domain() As Byte, i As Long, sv100 As SV_100, nIndex As Integer
Dim nCount As Integer, aDomain() As String, n As Integer
On Error Resume Next
aDomain = EnumDomains
If Not IsArray(aDomain) Then GetAllDomainSQLServers = False: Exit Function
nCount = UBound(aDomain)
nIndex = 0
For n = 1 To nCount
level = 100: prefmaxlen = -1
lType = SV_TYPE_SQLSERVER
domain = aDomain(n) & vbNullChar
l = NetServerEnum(ByVal 0&, level, BufPtr, prefmaxlen, entriesread, totalentries, lType, domain(0), hREsume)
' Erase aServer
If l = 0 Or l = 234& Then
For i = 0 To entriesread - 1
CopyMemory sv100, ByVal BufPtr, Len(sv100)
ReDim Preserve aServer(nIndex)
aServer(nIndex) = Pointer2stringw(sv100.name)
nIndex = nIndex + 1
BufPtr = BufPtr + Len(sv100)
Next i
End If
NetApiBufferFree BufPtr
Next
GetAllDomainSQLServers = (Err.Number = 0)
End FunctionPublic Function EnumDomains() As Variant
Dim plngRtn As Long, plngEnumHwnd As Long, plngCount As Long, plngLoop As Long, plngBufSize As Long
Dim pastrDomainNames() As String, patypNetAPI(0 To MAX_RESOURCES) As NETRESOURCE
plngEnumHwnd = 0&
plngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, dwType:=RESOURCETYPE_ANY, dwUsage:=RESOURCEUSAGE_ALL, lpNetResource:=ByVal 0&, lphEnum:=plngEnumHwnd)
If plngRtn = NO_ERROR Then
plngCount = RESOURCE_ENUM_ALL
plngBufSize = (UBound(patypNetAPI) + 100) * Len(patypNetAPI(0))
plngRtn = WNetEnumResource(hEnum:=plngEnumHwnd, lpcCount:=plngCount, lpBuffer:=patypNetAPI(0), lpBufferSize:=plngBufSize)
End If
If plngEnumHwnd <> 0 Then Call WNetCloseEnum(plngEnumHwnd)
plngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, dwType:=RESOURCETYPE_ANY, dwUsage:=RESOURCEUSAGE_ALL, lpNetResource:=patypNetAPI(0), lphEnum:=plngEnumHwnd)
plngCount = 200
If plngRtn = NO_ERROR Then
plngCount = RESOURCE_ENUM_ALL
plngBufSize = UBound(patypNetAPI) * Len(patypNetAPI(0))
plngRtn = WNetEnumResource(hEnum:=plngEnumHwnd, lpcCount:=plngCount, lpBuffer:=patypNetAPI(0), lpBufferSize:=plngBufSize)
If plngCount > 0 Then
ReDim pastrDomainNames(1 To plngCount) As String
For plngLoop = 0 To plngCount - 1
pastrDomainNames(plngLoop + 1) = PointerToAsciiStr(patypNetAPI(plngLoop).pRemoteName)
Next plngLoop
End If
End If
If plngEnumHwnd <> 0 Then Call WNetCloseEnum(plngEnumHwnd)
EnumDomains = pastrDomainNames
End FunctionPrivate Function Pointer2stringw(ByVal l As Long) As String
Dim Buffer() As Byte, nLen As Long
nLen = lstrlenW(l) * 2
If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMemory Buffer(0), ByVal l, nLen
Pointer2stringw = Buffer
End If
End FunctionPrivate Function PointerToAsciiStr(ByVal xilngPtrToString As Long) As String
On Error Resume Next ' Don't accept an error here
Dim plngLen As Long, pstrStringValue As String, plngNullPos As Long, plngRtn As Long
plngLen = StrLenA(xilngPtrToString)
If xilngPtrToString > 0 And plngLen > 0 Then
pstrStringValue = Space$(plngLen + 1)
plngRtn = StrCopyA(pstrStringValue, xilngPtrToString)
plngNullPos = InStr(pstrStringValue, Chr$(0))
If plngNullPos > 0 Then
PointerToAsciiStr = Left$(pstrStringValue, plngNullPos - 1) 'Lose the null terminator...
Else
PointerToAsciiStr = pstrStringValue 'Just pass the string...
End If
Else
PointerToAsciiStr = ""
End If
End Function
运行时,DLL入口不对
Dim oSQLServerDMOApp As Object
Dim i As Integer
Dim namX As Object
On Error Resume Next
Set oSQLServerDMOApp = CreateObject("SQLDMO.Application")
Set namX = oSQLServerDMOApp.ListAvailableSQLServers
For i = 1 To namX.Count
cmbServer.AddItem namX.Item(i)
Next
cmbServer.ListIndex = 0
End Sub
---------------------------------------------------------------
安装 MS SQL Server server/client
引用 Microsoft SQLDMO Object Library
'CODE
Option Explicit
Private Sub Command1_Click()
On Error GoTo Err1
Dim dmoObj As New SQLDMO.Application
Dim I As Long
For I = 1 To dmoObj.ListAvailableSQLServers.Count
List1.AddItem dmoObj.ListAvailableSQLServers.Item(I)
Next
Err1:
End Sub
'可以列出局域网内注册或未注册的SQL服务器
'参数:用于显示服务器名的组合框
Public Function GetLocalSQLServer(ByRef cmbServer As ComboBox) As Boolean
Dim oSQLServerDMOApp As SQLDMO.Application
Dim oServerGroup As SQLDMO.ServerGroup
Dim oRegisteredServer As SQLDMO.RegisteredServer
Dim i As Integer, j As Integer
Dim namX As NameList
Dim blnEquate As Boolean
Screen.MousePointer = 11
Set oSQLServerDMOApp = New SQLDMO.Application
cmbServer.Clear
'首先显示的是注册了的数据库
'处理所有服务器组
For Each oServerGroup In oSQLServerDMOApp.ServerGroups
'处理每个注册了的服务器
For Each oRegisteredServer In oServerGroup.RegisteredServers
'添加每个名字到 combobox
cmbServer.AddItem oRegisteredServer.Name
Next
Next
Set oRegisteredServer = Nothing
Set oServerGroup = Nothing '接下来显示尚未注册的数据库
Set namX = oSQLServerDMOApp.ListAvailableSQLServers
For i = 1 To namX.Count
blnEquate = False
'检查该服务器是否已经被列出来
For j = 0 To cmbServer.ListCount - 1
If cmbServer.List(j) = namX.Item(i) Then
blnEquate = True
Exit For '退出内圈循环
End If
Next j
If blnEquate = False Then
cmbServer.AddItem namX.Item(i)
End If
Next i
'显示第一个服务器
If cmbServer.ListCount > 0 Then
cmbServer.ListIndex = 0
End If
Set namX = Nothing
Set oSQLServerDMOApp = Nothing
Screen.MousePointer = 0
End Function
'1, 可取得域或工作组内所有的SqlServer服务器名
'2, 取得各项网络设置
Option Explicit
Private uNet() As NETRESOURCE_REAL
'取得SqlServer服务器名
'返回的服务器名用","相隔
Public Function GetSQLServers() As String
Dim l As Long
Dim entriesread As Long
Dim totalentries As Long
Dim hREsume As Long
Dim bufptr As Long
Dim level As Long
Dim prefmaxlen As Long
Dim lType As Long
Dim domain() As Byte
Dim sv100 As SV_100
Dim strReturnValue As String
Dim strDomainList As String '取得的域或工作组列表,用","格开
Dim iPos As Integer
Dim i As Integer
Dim strPart As String level = 100
prefmaxlen = -1
lType = SV_TYPE_SQLSERVER
strDomainList = GetDomain()
i = 1
Do
iPos = InStr(i, strDomainList, ",")
If iPos = 0 Then
strPart = Mid(strDomainList, i, Len(strDomainList))
Else
strPart = Mid(strDomainList, i, iPos - i)
End If
domain = strPart & vbNullChar
l = NetServerEnum(ByVal 0&, _
level, _
bufptr, _
prefmaxlen, _
entriesread, _
totalentries, _
lType, _
domain(0), _
hREsume)
If l = 0 Or l = 234& Then
For i = 0 To entriesread - 1
CopyMemory sv100, ByVal bufptr, Len(sv100)
If strReturnValue = "" Then
strReturnValue = Pointer2Stringw(sv100.name)
Else
strReturnValue = strReturnValue & "," & Pointer2Stringw(sv100.name)
End If
bufptr = bufptr + Len(sv100)
Next i
End If
i = iPos + 1
Loop Until iPos = 0 NetApiBufferFree bufptr
GetSQLServers = strReturnValue
End Function'指针转换为字符串
Private Function Pointer2Stringw(ByVal l As Long) As String
Dim Buffer() As Byte
Dim nLen As Long
nLen = lstrlenW(l) * 2 If nLen Then
ReDim Buffer(0 To (nLen - 1)) As Byte
CopyMemory Buffer(0), ByVal l, nLen
Pointer2Stringw = Buffer
End If
End Function
'取得网络的各项配置
Private Sub GetNetworkSetting()
Const MAX_RESOURCES = 256
Const NOT_A_CONTAINER = -1
Dim bFirstTime As Boolean
Dim lReturn As Long
Dim hEnum As Long
Dim lCount As Long
Dim lMin As Long
Dim lLength As Long
Dim l As Long
Dim lBufferSize As Long
Dim lLastIndex As Long
Dim uNetApi(0 To MAX_RESOURCES) As NETRESOURCE
bFirstTime = True
Do
If bFirstTime Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, _
RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, ByVal 0&, hEnum)
bFirstTime = False
Else
If uNet(lLastIndex).dwUsage _
And RESOURCEUSAGE_CONTAINER Then
lReturn = WNetOpenEnum(RESOURCE_GLOBALNET, _
RESOURCETYPE_ANY, RESOURCEUSAGE_ALL, _
uNet(lLastIndex), hEnum)
Else
lReturn = NOT_A_CONTAINER
hEnum = 0
End If
lLastIndex = lLastIndex + 1
End If
If lReturn = NO_ERROR Then
lCount = RESOURCE_ENUM_ALL
Do
lBufferSize = UBound(uNetApi) * Len(uNetApi(0)) / 2
lReturn = WNetEnumResource(hEnum, lCount, _
uNetApi(0), lBufferSize)
If lCount > 0 Then
ReDim Preserve uNet(0 To lMin + lCount - 1) _
As NETRESOURCE_REAL
For l = 0 To lCount - 1
'Each Resource will appear here as uNet(i)
uNet(lMin + l).dwScope = uNetApi(l).dwScope
uNet(lMin + l).dwType = uNetApi(l).dwType
uNet(lMin + l).dwDisplayType = _
uNetApi(l).dwDisplayType
uNet(lMin + l).dwUsage = uNetApi(l).dwUsage
If uNetApi(l).pLocalName Then
lLength = lstrlen(uNetApi(l).pLocalName)
uNet(lMin + l).sLocalName = _
Space$(lLength)
CopyMem ByVal uNet(lMin _
+ l).sLocalName, _
ByVal uNetApi(l).pLocalName, lLength
End If
If uNetApi(l).pRemoteName Then
lLength = lstrlen( _
uNetApi(l).pRemoteName)
uNet(lMin + l).sRemoteName = _
Space$(lLength)
CopyMem ByVal uNet(lMin + _
l).sRemoteName, _
ByVal uNetApi(l).pRemoteName, lLength
End If
If uNetApi(l).pComment Then
lLength = lstrlen(uNetApi(l).pComment)
uNet(lMin + l).sComment = _
Space$(lLength)
CopyMem ByVal uNet(lMin + l).sComment, _
ByVal uNetApi(l).pComment, lLength
End If
If uNetApi(l).pProvider Then
lLength = lstrlen(uNetApi(l).pProvider)
uNet(lMin + l).sProvider = _
Space$(lLength)
CopyMem ByVal uNet(lMin + l).sProvider, _
ByVal uNetApi(l).pProvider, lLength
End If
Next l
End If
lMin = lMin + lCount
Loop While lReturn = ERROR_MORE_DATA
End If
If hEnum Then
l = WNetCloseEnum(hEnum)
End If
Loop While lLastIndex < lMin
End Sub
Public Function GetDomain() As String
Dim DomainList As String
Dim l As Long
DomainList = ""
Call GetNetworkSetting
If UBound(uNet) > 0 Then
For l = 0 To UBound(uNet)
If uNet(l).dwDisplayType = RESOURCEDISPLAYTYPE_DOMAIN Then
If DomainList = "" Then
DomainList = uNet(l).sRemoteName
Else
DomainList = DomainList & "," & uNet(l).sRemoteName
End If
End If
' Select Case uNet(l).dwDisplayType
' Case RESOURCEDISPLAYTYPE_DIRECTORY&
' Debug.Print "Directory...",
' Case RESOURCEDISPLAYTYPE_DOMAIN
' Debug.Print "Domain...",
' Case RESOURCEDISPLAYTYPE_FILE
' Debug.Print "File...",
' Case RESOURCEDISPLAYTYPE_GENERIC
' Debug.Print "Generic...",
' Case RESOURCEDISPLAYTYPE_GROUP
' Debug.Print "Group...",
' Case RESOURCEDISPLAYTYPE_NETWORK&
' Debug.Print "Network...",
' Case RESOURCEDISPLAYTYPE_ROOT&
' Debug.Print "Root...",
' Case RESOURCEDISPLAYTYPE_SERVER
' Debug.Print "Server...",
' Case RESOURCEDISPLAYTYPE_SHARE
' Debug.Print "Share...",
' Case RESOURCEDISPLAYTYPE_SHAREADMIN&
' Debug.Print "ShareAdmin...",
' End Select
' Debug.Print uNet(l).sRemoteName, uNet(l).sComment
Next l
End If
GetDomain = DomainList
End Function