Article ID: 198896
Article Last Modified on 8/14/2007
Option Explicit
' General definitions
Const ERROR_SUCCESS = 0
Const ERROR_MORE_DATA = 234
Const SV_TYPE_SERVER = &H2 'Server type mask, all types of servers
Const SIZE_SI_101 = 24
Private Type SERVER_INFO_101
dwPlatformId As Long
lpszServerName As Long
dwVersionMajor As Long
dwVersionMinor As Long
dwType As Long
lpszComment As Long
End Type
Private Declare Function NetServerEnum Lib "netapi32.dll" ( _
ByVal servername As String, _
ByVal level As Long, _
buffer As Long, _
ByVal prefmaxlen As Long, _
entriesread As Long, _
totalentries As Long, _
ByVal servertype As Long, _
ByVal domain As String, _
resumehandle As Long) As Long
Private Declare Function NetApiBufferFree Lib "netapi32.dll" ( _
BufPtr As Any) As Long
Private Declare Sub RtlMoveMemory Lib "KERNEL32" ( _
hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Function lstrcpyW Lib "KERNEL32" ( _
ByVal lpszDest As String, ByVal lpszSrc As Long) As Long
Private Function PointerToString(lpszString As Long) As String
Dim lpszStr1 As String, lpszStr2 As String, nRes As Long
lpszStr1 = String(1000, "*")
nRes = lstrcpyW(lpszStr1, lpszString)
lpszStr2 = (StrConv(lpszStr1, vbFromUnicode))
PointerToString = Left(lpszStr2, InStr(lpszStr2, Chr$(0)) - 1)
End Function
Private Sub Command1_Click()
Dim pszTemp As String, pszServer As String, pszDomain As String
Dim nLevel As Long, i As Long, BufPtr As Long, TempBufPtr As Long
Dim nPrefMaxLen As Long, nEntriesRead As Long, nTotalEntries As Long
Dim nServerType As Long, nResumeHandle As Long, nRes As Long
Dim ServerInfo As SERVER_INFO_101
' Get the server name. It can be a null string
pszTemp = Chr(0)
pszTemp = InputBox("Enter server name:", "Server Name")
If Len(pszTemp) = 0 Then
pszServer = vbNullString
Else
pszServer = StrConv(pszTemp, vbUnicode)
End If
' Get the domain name. It can be a null string
pszTemp = Chr(0)
pszTemp = InputBox("Enter domain name:", "Domain Name")
If Len(pszTemp) = 0 Then
pszDomain = vbNullString
Else
pszDomain = StrConv(pszTemp, vbUnicode)
End If
nLevel = 101
BufPtr = 0
nPrefMaxLen = &HFFFFFFFF
nEntriesRead = 0
nTotalEntries = 0
nServerType = SV_TYPE_SERVER
nResumeHandle = 0
Do
nRes = NetServerEnum(pszServer, nLevel, BufPtr, _
nPrefMaxLen, nEntriesRead, nTotalEntries, _
nServerType, pszDomain, nResumeHandle)
If ((nRes = ERROR_SUCCESS) Or (nRes = ERROR_MORE_DATA)) And _
(nEntriesRead > 0) Then
TempBufPtr = BufPtr
For i = 1 To nEntriesRead
RtlMoveMemory ServerInfo, TempBufPtr, SIZE_SI_101
Debug.Print PointerToString(ServerInfo.lpszServerName)
TempBufPtr = TempBufPtr + SIZE_SI_101
Next i
Else
MsgBox "NetServerEnum failed: " & nRes
End If
NetApiBufferFree (BufPtr)
Loop While nEntriesRead < nTotalEntries
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
159498 How To Call LanMan Services from 32-bit Visual Basic Apps
159423 How To Call LAN Manager Functions from 16-bit Visual Basic 4.0
151774 How To Call NetUserGetInfo API from Visual Basic
106553 How To Write C DLLs and Call Them from Visual Basic
118643 How to Pass a String or String Arrays Between VB and a C DLL
110219 LONG: How to Call Windows API from VB 3.0--General Guidelines
Additional query words: kbDSupport
Keywords: kbdswnet2003swept kbapi kbhowto kbnetwork KB198896