|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic Network Services NetShareEnum: Enumerating Shared Resources on Other Machines |
|
Posted: | Monday June 25, 2001 |
Updated: | Monday December 26, 2011 |
Applies to: | VB4-32, VB5, VB6 |
Developed with: | VB6, Windows 2000 |
OS restrictions: | Windows NT3.1, Windows NT4, Windows 2000, Windows XP |
Author: | VBnet - Randy Birch |
Related: |
WNetAddConnection2: Transparently Connect to Network Shares |
Prerequisites |
For this demo, one of the operating systems listed under OS Restrictions above. |
|
NetShareEnum retrieves information about each shared resource on a
server. It's security requirements are the same as those outlined in
NetWkstaUserEnum: Workstation Logon Information.
WNetEnumResource can also be used to retrieve resource information, however, it does not enumerate hidden shares or users connected to a share. The demo below shows how to call NetShareEnum with the SHARE_INFO_2 structure when calling on an NT-based machine. WNetEnumResource can be called on 9x and NT-based systems (WNetEnumResource: Enumerating Local Network Resources). The parameters for NetShareEnum under Windows 95/98/Me - including the structures you can use - are different from those valid for Windows NT/2000/XP. Specifically, the MSDN states that in using this API for 9x, the calling application must use the cbBuffer parameter to specify the size, in bytes, of the information buffer pointed to by the pbBuffer parameter. (The cbBuffer parameter replaces the prefmaxlen parameter.) In addition, the resume handle parameter is not available on this platform. Therefore, for 9x systems the API's parameter list is defined as: NetShareEnum( const char FAR * pszServer, short sLevel, char FAR * pbBuffer, unsigned short cbBuffer, unsigned short FAR * pcEntriesRead, unsigned short FAR * pcTotalAvail ); The MSDN's NetShareEnum page contains a link to a C code example for calling this API under Windows 95/98/Me. |
BAS Module Code |
None. |
|
Form Code |
To a form add a command button (Command1), list box (List1), and two labels (Label1, Label2). A third set of labels in a control array can be used for the list item captions. Add the following to the form: |
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 'Windows type used to call the Net API Private Const MAX_PREFERRED_LENGTH As Long = -1 Private Const NERR_SUCCESS As Long = 0& Private Const ERROR_MORE_DATA As Long = 234& Private Const LB_SETTABSTOPS As Long = &H192 'See NetServerEnum demo for complete 'list of server types supported Private Const SV_TYPE_ALL As Long = &HFFFFFFFF Private Const SV_TYPE_WORKSTATION As Long = &H1 Private Const SV_TYPE_SERVER As Long = &H2 Private Const STYPE_ALL As Long = -1 'note: my const Private Const STYPE_DISKTREE As Long = 0 Private Const STYPE_PRINTQ As Long = 1 Private Const STYPE_DEVICE As Long = 2 Private Const STYPE_IPC As Long = 3 Private Const STYPE_SPECIAL As Long = &H80000000 Private Const ACCESS_READ As Long = &H1 Private Const ACCESS_WRITE As Long = &H2 Private Const ACCESS_CREATE As Long = &H4 Private Const ACCESS_EXEC As Long = &H8 Private Const ACCESS_DELETE As Long = &H10 Private Const ACCESS_ATRIB As Long = &H20 Private Const ACCESS_PERM As Long = &H40 Private Const ACCESS_ALL As Long = ACCESS_READ Or _ ACCESS_WRITE Or _ ACCESS_CREATE Or _ ACCESS_EXEC Or _ ACCESS_DELETE Or _ ACCESS_ATRIB Or _ ACCESS_PERM 'for use on Win NT/2000 only Private Type SERVER_INFO_100 sv100_platform_id As Long sv100_name As Long End Type 'shi2_current_uses: number of current connections to the resource 'shi2_max_uses : max concurrent connections resource can accommodate 'shi2_netname : share name of a resource 'shi2_passwd : share's password when ' (server running with share-level security) 'shi2_path : local path for the shared resource 'shi2_permissions : shared resource's permissions ' (servers running with share-level security) 'shi2_remark : string containing optional comment about the resource 'shi2_type : the type of the shared resource Private Type SHARE_INFO_2 shi2_netname As Long shi2_type As Long shi2_remark As Long shi2_permissions As Long shi2_max_uses As Long shi2_current_uses As Long shi2_path As Long shi2_passwd As Long End Type Private Declare Function NetServerEnum Lib "netapi32" _ (ByVal servername As Long, _ ByVal level As Long, _ buf As Any, _ ByVal prefmaxlen As Long, _ entriesread As Long, _ totalentries As Long, _ ByVal servertype As Long, _ ByVal domain As Long, _ resume_handle As Long) As Long Private Declare Function NetShareEnum Lib "netapi32" _ (ByVal servername As Long, _ ByVal level As Long, _ bufptr As Long, _ ByVal prefmaxlen As Long, _ entriesread As Long, _ totalentries As Long, _ resume_handle As Long) As Long Private Declare Function NetApiBufferFree Lib "netapi32" _ (ByVal Buffer As Long) As Long Private Declare Sub CopyMemory 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 SendMessage Lib "user32" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Private Sub Form_Load() ReDim TabArray(0 To 4) As Long TabArray(0) = 73 TabArray(1) = 125 TabArray(2) = 151 TabArray(3) = 232 'Clear any existing tabs 'and set the list tabstops Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 0&, ByVal 0&) Call SendMessage(List1.hwnd, LB_SETTABSTOPS, 4&, TabArray(0)) List1.Refresh Command1.Caption = "Net Share Enum" Label1.Caption = "call success (0) or error :" Label2.Caption = "" End Sub Private Sub Command1_Click() Dim bufptr As Long 'output Dim dwServer As Long 'pointer to the server Dim dwEntriesread As Long 'out Dim dwTotalentries As Long 'out Dim dwResumehandle As Long 'out Dim success As Long Dim nStructSize As Long Dim cnt As Long Dim usrname As String Dim bServer As String Dim shi2 As SHARE_INFO_2 'demo using the local machine bServer = "\\" & Environ$("COMPUTERNAME") & vbNullString 'create pointer to the machine name dwServer = StrPtr(bServer) success = NetShareEnum(dwServer, _ 2, _ bufptr, _ MAX_PREFERRED_LENGTH, _ dwEntriesread, _ dwTotalentries, _ dwResumehandle) List1.Clear Label2.Caption = success If success = NERR_SUCCESS And _ success <> ERROR_MORE_DATA Then nStructSize = LenB(shi2) For cnt = 0 To dwEntriesread - 1 'get one chunk of data and cast 'into an SHARE_INFO_2 type, and 'add the data to a list CopyMemory shi2, ByVal bufptr + (nStructSize * cnt), nStructSize List1.AddItem GetPointerToByteStringW(shi2.shi2_netname) & vbTab & _ GetConnectionType(shi2.shi2_type) & vbTab & _ GetConnectionPermissions(shi2.shi2_permissions) & vbTab & _ GetPointerToByteStringW(shi2.shi2_remark) & vbTab & _ GetPointerToByteStringW(shi2.shi2_path) ' & vbTab & _ Next End If Call NetApiBufferFree(bufptr) End Sub Private Function GetConnectionPermissions(ByVal dwPermissions As Long) As String 'Permissions are only returned a shared 'resource running with share-level security. 'A server running user-level security ignores 'this member, so the function returns '"not applicable". Dim tmp As String If (dwPermissions And ACCESS_READ) Then tmp = tmp & "R" If (dwPermissions And ACCESS_WRITE) Then tmp = tmp & " W" If (dwPermissions And ACCESS_CREATE) Then tmp = tmp & " C" If (dwPermissions And ACCESS_DELETE) Then tmp = tmp & " D" If (dwPermissions And ACCESS_EXEC) Then tmp = tmp & " E" If (dwPermissions And ACCESS_ATRIB) Then tmp = tmp & " A" If (dwPermissions And ACCESS_PERM) Then tmp = tmp & " P" If Len(tmp) = 0 Then tmp = "n/a" GetConnectionPermissions = tmp End Function Private Function GetConnectionType(ByVal dwConnectType As Long) As String 'compare connection type value Select Case dwConnectType Case STYPE_DISKTREE: GetConnectionType = "disk drive" Case STYPE_PRINTQ: GetConnectionType = "print queue" Case STYPE_DEVICE: GetConnectionType = "communication device" Case STYPE_IPC: GetConnectionType = "ipc" Case STYPE_SPECIAL: GetConnectionType = "administrative" Case Else 'weird case. On my NT2000 machines, 'I have to do this to identify the 'IPC$ share type Select Case (dwConnectType Xor STYPE_SPECIAL) 'rtns 3 if IPC Case STYPE_IPC: GetConnectionType = "ipc" Case Else: GetConnectionType = "undefined" End Select End Select End Function Public Function GetPointerToByteStringW(ByVal dwData As Long) As String Dim tmp() As Byte Dim tmplen As Long If dwData <> 0 Then tmplen = lstrlenW(dwData) * 2 If tmplen <> 0 Then ReDim tmp(0 To (tmplen - 1)) As Byte CopyMemory tmp(0), ByVal dwData, tmplen GetPointerToByteStringW = tmp End If End If End Function |
Comments |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |