VB and VBA Users Source Code: Using NetMessageNameEnum on NT or Win 2000
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Using NetMessageNameEnum on NT or Win 2000
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Thursday, August 03, 2000
Hits:
566
Category:
Networks
Article:
To find out the network names reserved by a user, use NetMessageNameEnum. The following code displays a list of network names a user has reserved on their local server. Option Explicit Private Declare Function NetMessageNameEnum Lib "netapi32.DLL" (ByVal ServerName As Long, ByVal lLevel As Long, lPointerToResults As Long, ByVal lPreferedMaxLen As Long, lEntriesRead As Long, lTotalEntriesPointer As Long, lResumeHwnd As Long) As Long Private Declare Sub CopyMem Lib "kernel32" Alias "RtlMoveMemory" (pTo As Any, uFrom As Any, ByVal lSize As Long) Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long Private Declare Function lstrcpyW Lib "kernel32" (lpString1 As Byte, ByVal lpString2 As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32.DLL" (ByVal lPointerToBuffer As Long) As Long Private Type MSG_INFO_1 msgi1_name As Long msgi1_forward_flag As Long msgi1_forward As Long End Type 'Call this routine to debug.print the users network names Sub Test() Dim sArrayNames() As String, lThisName As Long Dim sResult As String sResult = Len(AliasNamesGet(sArrayNames)) If sResult Then 'Error Debug.Print sResult Else 'Success For lThisName = 1 To UBound(sArrayNames) Debug.Print sArrayNames(lThisName) Next End If End Sub 'Purpose : Enumerates a users local network names 'Inputs : 'Outputs : AliasNamesGet Returns any error messages ' sArrayNames() as String String array containing the users names 'Author : Andrew Baker 'Date : 03/08/2000 19:12 'Notes : WIN NT/2000 ONLY 'Revisions : Function AliasNamesGet(sArrayNames() As String) As String Dim bArrayServerName() As Byte, lptrBuffer As Long, tUserInfo As MSG_INFO_1, lEnteriesRead As Long, lTotal As Long Dim lRetVal As Long, I As Long, lRetHwnd As Long Const ERROR_MORE_DATA As Long = 234& Const MAX_PREFERRED_LENGTH As Long = -1&, NERR_ServiceNotInstalled As Long = 2184 Const NERR_Success As Long = 0 Static bDLLErrorShown As Boolean On Error GoTo ErrFailed bArrayServerName = vbNullChar 'Use Local Server lRetVal = NetMessageNameEnum(VarPtr(bArrayServerName(0)), 1&, lptrBuffer, MAX_PREFERRED_LENGTH, lEnteriesRead, lTotal, lRetHwnd) Select Case lRetVal Case NERR_Success, ERROR_MORE_DATA ReDim sArrayNames(1 To lEnteriesRead) 'Loop through the names. For I = 0 To lEnteriesRead - 1 Call CopyMem(tUserInfo, ByVal (lptrBuffer + (I * Len(tUserInfo))), Len(tUserInfo)) ' 96=len(USER_INFO_2) sArrayNames(I + 1) = zStrFromPtrW(tUserInfo.msgi1_name) Next Case NERR_ServiceNotInstalled AliasNamesGet = "The service has not been started!!!" Case Else AliasNamesGet = "Unspecified network error!!!" End Select If lptrBuffer Then 'Free memory Call NetApiBufferFree(lptrBuffer) End If Exit Function ErrFailed: 'Error Handler If bDLLErrorShown = False Then MsgBox "Error while attempting to obtaining network alias names..." & Chr(13) & Err.Description, vbExclamation End If End Function 'Purpose : Converts a pointer to a string into a string. 'Inputs : pBuf Pointer to a string held in memory 'Outputs : The string held at the specified memory address 'Author : Andrew Baker 'Date : 03/08/2000 19:14 'Notes : Assumes string is a unicode string 'Revisions : Private Function zStrFromPtrW(ByVal pBuf As Long) As String Dim lngLen As Long Dim abytBuf() As Byte 'Get the length of the string at the memory location lngLen = lstrlenW(pBuf) * 2 - 1 'Unicode string (must double the buffer size) If lngLen Then ReDim abytBuf(lngLen) 'Copy the memory contents 'into a they byte buffer Call CopyMem(abytBuf(0), ByVal pBuf, lngLen) 'convert and return the buffer zStrFromPtrW = abytBuf End If End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
