Solved

Problems w/WNetEnumResource

Posted on 1999-01-11
6
610 Views
Last Modified: 2008-03-17
I have a prob. w/WNetEnumResource
anybody can help me, this example have a prob?
Dim f As Long, k As Long, n As NETRESOURCE
Dim g As NETRESOURCE
Dim lpcCount As Long, lpBufferSize As Long
f = WNetOpenEnum(RESOURCE_CONNECTED, RESOURCETYPE_ANY, _
0, g, k)

lpBufferSize = Len(n)
If k Then f = WNetEnumResource(k, lpcCount, n, lpBufferSize)
If lpcCount Then
     
        Debug.Print n.dwDisplayType
        Debug.Print n.dwScope
        Debug.Print n.dwType
        Debug.Print n.dwUsage
        Debug.Print n.lpComment
        Debug.Print n.lpLocalName
        Debug.Print n.lpProvider
        Debug.Print n.lpRemoteName
else
Debug.Print f
End If
Debug.Print lpBuffer
If k Then f = WNetCloseEnum(k)
0
Comment
Question by:tato
  • 3
  • 2
6 Comments
 

Author Comment

by:tato
ID: 1455346
Edited text of question
0
 
LVL 18

Accepted Solution

by:
mdougan earned 100 total points
ID: 1455347
Hi, I couldn't tell where you were having the problem, so, I included the routine I use to enum containers.  There is extra code for adding nodes to a treeview control, and I made the routine recursive (it calls itself) when it finds a container that contains another container (it will then go in and enumerate the resources within that container).  Maybe you can see from this what you are missing.  Note:  check your return val to see what the problem might have been.  Perhaps you do not have authority to enum a computer on your network etc.  Also, I'm expanding the long pointers into their text versions.

Public Type NETRESOURCE
   dwScope                             As Long
   dwType                              As Long
   dwDisplayType                       As Long
   dwUsage                             As Long
   lpLocalName                         As Long
   lpRemoteName                        As Long
   lpComment                           As Long
   lpProvider                          As Long
End Type

Public Type NETRESOURCE_REAL
    dwScope                            As Long
    dwType                             As Long
    dwDisplayType                      As Long
    dwUsage                            As Long
    sLocalName                         As String
    sRemoteName                        As String
    sComment                           As String
    sProvider                          As String
end type

Global BailOut                As Boolean
Global g_atypNetRes()         As NETRESOURCE_REAL
Global g_NetResLastIndex      As Long

Public Sub EnumContainer(Parent As String, ByVal pEnumHwnd As Long)
   Dim nodeX                           As Node
   Dim p_lngRtn                        As Long
   Dim p_lngResCount                   As Long
   Dim p_lngLen                        As Long
   Dim p_lngBufSize                    As Long
   Dim p_lngLoop                       As Long
   Dim p_lngEnumHwnd                   As Long
   Dim p_atypNetResAPI()               As NETRESOURCE
   Dim ErrNo                           As Long
   Dim ErrMsg                          As String

    On Error GoTo EnumContainerErr
   
    If BailOut = True Then
        GoTo EnumContainerExit
    End If
   
    p_lngEnumHwnd = pEnumHwnd
   ' ------------------------------------------
   ' Set the API type to max available resources
   ' ------------------------------------------
   ReDim p_atypNetResAPI(0 To MAX_RESOURCES) As NETRESOURCE
   
      If p_lngEnumHwnd = 0 Then
         ' ------------------------------------
         ' First time we set the Resource type to
         '     a null, and since the p_lngEnumHwnd
         '     hasn't been initialized yet,
         '     it's a zero
         ' ------------------------------------
         p_lngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, _
                                 dwType:=RESOURCETYPE_ANY, _
                                 dwUsage:=RESOURCEUSAGE_ALL, _
                                 lpNetResource:=ByVal 0&, _
                                 lphEnum:=p_lngEnumHwnd)
      Else
       
           p_lngRtn = WNetOpenEnum(dwScope:=RESOURCE_GLOBALNET, _
                                dwType:=RESOURCETYPE_ANY, _
                                dwUsage:=RESOURCEUSAGE_ALL, _
                                lpNetResource:=g_atypNetRes(g_NetResLastIndex), _
                                lphEnum:=p_lngEnumHwnd)
      End If
     
      ' ---------------------------------------
      ' No errors, so do our thing
      ' ---------------------------------------
      If p_lngRtn <> NO_ERROR Then
'         ErrNo = GetLastError()
'         Select Case ErrNo
         Select Case p_lngRtn
            Case 0
                ErrMsg = "Unknown Error"
            Case ERROR_NOT_CONTAINER
                ErrMsg = "Error not a Container"
            Case ERROR_INVALID_PARAMETER
                ErrMsg = "Error Invalid Parameter"
            Case ERROR_NO_NETWORK
                ErrMsg = "Error No Network"
            Case ERROR_EXTENDED_ERROR
                ErrMsg = "Error Extended Error"
            Case ERROR_ACCESS_DENIED
                ErrMsg = "Error Access Denied"
            Case ERROR_NOT_ENOUGH_MEMORY
                ErrMsg = "Error Not Enough Memory"
                BailOut = True
                MsgBox ErrMsg & " " & CStr(ErrNo) & vbCrLf & "Return Code " & CStr(p_lngRtn) & vbCrLf & "Last Index " & CStr(g_NetResLastIndex), vbExclamation, Parent
                GoTo EnumContainerExit
            Case ERROR_BAD_NETPATH
                ErrMsg = "Error Bad Netpath"
            Case ERROR_NETWORK_BUSY
                ErrMsg = "Error Network Busy"
            Case ERROR_BAD_NET_RESP
                ErrMsg = "Error Bad Net Response"
            Case ERROR_UNEXP_NET_ERR
                ErrMsg = "Error Unexpected Net Err"
            Case ERROR_OUT_OF_STRUCTURES
                ErrMsg = "Error Out of Structures"
                BailOut = True
                MsgBox ErrMsg & " " & CStr(ErrNo) & vbCrLf & "Return Code " & CStr(p_lngRtn) & vbCrLf & "Last Index " & CStr(g_NetResLastIndex), vbExclamation, Parent
                GoTo EnumContainerExit
         End Select
         
         If ErrNo = ERROR_EXTENDED_ERROR Then
         End If
'         BailOut = True
         If p_lngRtn <> ERROR_ACCESS_DENIED Then
            MsgBox ErrMsg & " " & CStr(ErrNo) & vbCrLf & "Return Code " & CStr(p_lngRtn) & vbCrLf & "Last Index " & CStr(g_NetResLastIndex), vbExclamation, Parent
         End If
      Else
         ' ------------------------------------
         ' Increment the index of containers
         ' ------------------------------------
         g_NetResLastIndex = g_NetResLastIndex + 1
         If g_NetResLastIndex > (UBound(g_atypNetRes) - 50) Then
            ReDim Preserve g_atypNetRes(UBound(g_atypNetRes) + 100) As NETRESOURCE_REAL
         End If
     
'or         p_lngResCount = RESOURCE_ENUM_ALL
         p_lngResCount = MAX_RESOURCES
         
         Do
            ' ---------------------------------
            ' Set the length of the buffer, then
            '     enumerate the resources
            ' ---------------------------------
            p_lngBufSize = UBound(p_atypNetResAPI) * Len(p_atypNetResAPI(0)) ' / 2
            p_lngRtn = WNetEnumResource(hEnum:=p_lngEnumHwnd, _
                                        lpcCount:=p_lngResCount, _
                                        lpBuffer:=p_atypNetResAPI(0), _
                                        lpBufferSize:=p_lngBufSize)
           
            ' ---------------------------------
            ' Found at least one resource
            ' ---------------------------------
            If p_lngResCount > 0 Then
'                If g_NetResLastIndex + p_lngResCount > UBound(g_atypNetRes) Then
'                    ReDim Preserve g_atypNetRes(UBound(g_atypNetRes) + p_lngResCount) As NETRESOURCE_REAL
'                End If
               For p_lngLoop = 0 To p_lngResCount - 1
                  ' ---------------------------
                  ' Copy the info into the "real"
                  '     array -- ie, strings are
                  '     actually strings
                  ' ---------------------------
                  g_atypNetRes(g_NetResLastIndex).dwScope = p_atypNetResAPI(p_lngLoop).dwScope
                  g_atypNetRes(g_NetResLastIndex).dwType = p_atypNetResAPI(p_lngLoop).dwType
                  g_atypNetRes(g_NetResLastIndex).dwDisplayType = p_atypNetResAPI(p_lngLoop).dwDisplayType
                  g_atypNetRes(g_NetResLastIndex).dwUsage = p_atypNetResAPI(p_lngLoop).dwUsage
                 
                  ' ---------------------------
                  ' Get the strings from the
                  '     string pointers
                  ' ---------------------------
                  p_lngLen = lstrlen(p_atypNetResAPI(p_lngLoop).lpLocalName)
                  If p_lngLen > 0 Then
                     g_atypNetRes(g_NetResLastIndex).sLocalName = Space$(p_lngLen)
                     CopyMem ByVal g_atypNetRes(g_NetResLastIndex).sLocalName, _
                             ByVal p_atypNetResAPI(p_lngLoop).lpLocalName, _
                             p_lngLen
                  End If
                     
                  p_lngLen = lstrlen(p_atypNetResAPI(p_lngLoop).lpRemoteName)
                  If p_lngLen > 0 Then
                     g_atypNetRes(g_NetResLastIndex).sRemoteName = Space$(p_lngLen)
                     CopyMem ByVal g_atypNetRes(g_NetResLastIndex).sRemoteName, _
                             ByVal p_atypNetResAPI(p_lngLoop).lpRemoteName, _
                             p_lngLen
                  End If
                 
                  p_lngLen = lstrlen(p_atypNetResAPI(p_lngLoop).lpComment)
                  If p_lngLen > 0 Then
                     g_atypNetRes(g_NetResLastIndex).sComment = Space$(p_lngLen)
                     CopyMem ByVal g_atypNetRes(g_NetResLastIndex).sComment, _
                             ByVal p_atypNetResAPI(p_lngLoop).lpComment, _
                             p_lngLen
                  End If
                     
                  p_lngLen = lstrlen(p_atypNetResAPI(p_lngLoop).lpProvider)
                  If p_lngLen > 0 Then
                     g_atypNetRes(g_NetResLastIndex).sProvider = Space$(p_lngLen)
                     CopyMem ByVal g_atypNetRes(g_NetResLastIndex).sProvider, _
                             ByVal p_atypNetResAPI(p_lngLoop).lpProvider, _
                             p_lngLen
                  End If

                ' ------------------------------------
                ' Only check containers, and ignore shares
                ' ------------------------------------
                If g_atypNetRes(g_NetResLastIndex).dwUsage And RESOURCEUSAGE_CONTAINER Then
   
    ' display types are not working the way I want    
                        If g_atypNetRes(g_NetResLastIndex).dwDisplayType And RESOURCEDISPLAYTYPE_DOMAIN Then
                            Set nodeX = frmNetTree.tvwIcon.Nodes.Add(Parent, tvwChild, g_atypNetRes(g_NetResLastIndex).sRemoteName, g_atypNetRes(g_NetResLastIndex).sRemoteName, 1)
                        ElseIf g_atypNetRes(g_NetResLastIndex).dwDisplayType And RESOURCEDISPLAYTYPE_SERVER Then
                            Set nodeX = frmNetTree.tvwIcon.Nodes.Add(Parent, tvwChild, g_atypNetRes(g_NetResLastIndex).sRemoteName, g_atypNetRes(g_NetResLastIndex).sRemoteName, 2)
                        Else
                            Set nodeX = frmNetTree.tvwIcon.Nodes.Add(Parent, tvwChild, g_atypNetRes(g_NetResLastIndex).sRemoteName, g_atypNetRes(g_NetResLastIndex).sRemoteName, 3)
                        End If
                       
                        Network.EnumContainer g_atypNetRes(g_NetResLastIndex).sRemoteName, p_lngEnumHwnd
    '                    g_NetResLastIndex = g_NetResLastIndex + 1
                    End If
                End If
                Next p_lngLoop
           
            Else
               ' ------------------------------
               ' No resources, do nothing
               ' ------------------------------
            End If
                       
         ' ------------------------------------
         ' Get rest of data
         ' ------------------------------------
         Loop While p_lngRtn = ERROR_MORE_DATA
      End If
     
      ' ---------------------------------------
      ' Be nice and close your resources
      ' ---------------------------------------
      If pEnumHwnd = 0 Then
         p_lngLoop = WNetCloseEnum(pEnumHwnd)
      End If
     
   Erase p_atypNetResAPI
'   Set p_atypNetResAPI = Nothing
     
Screen.MousePointer = 0
'Beep

EnumContainerExit:
    Exit Sub
EnumContainerErr:
    Screen.MousePointer = 0
    MsgBox Err.Description, vbExclamation, "" & Err.Number
    Resume EnumContainerExit
End Sub
0
 

Author Comment

by:tato
ID: 1455348
Dear mdougan:
Your answer is good, but i need info to copy a pointer to string as long in string.
Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As Long
I try to use lstcpyn bu don have success.
Excuse my english bye
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 18

Expert Comment

by:mdougan
ID: 1455349
Hi,

Sorry, I tried to include all of the definitions with the routine, but I forgot these.  These are the declarations of the API functions necessary to copy the long pointers into strings.  The following snippet of code from the EnumContainers routine calls these two functions:

                  ' ---------------------------
                  ' Get the strings from the
                  '     string pointers
                  ' ---------------------------
                  p_lngLen = lstrlen(p_atypNetResAPI(p_lngLoop).lpLocalName)
                  If p_lngLen > 0 Then
                     g_atypNetRes(g_NetResLastIndex).sLocalName = Space$(p_lngLen)
                     CopyMem ByVal g_atypNetRes(g_NetResLastIndex).sLocalName, _
                             ByVal p_atypNetResAPI(p_lngLoop).lpLocalName, _
                             p_lngLen
                  End If

Public Declare Sub CopyMem _
   Lib "kernel32" Alias "RtlMoveMemory" _
   (pTo As Any, _
    pFrom As Any, _
    ByVal lCount As Long)

Public Declare Function lstrlen _
   Lib "kernel32" Alias "lstrlenA" _
   (ByVal sText As Any) As Long

Hope this helps

MD
0
 

Author Comment

by:tato
ID: 1455350
thanks mdougan

0
 
LVL 13

Expert Comment

by:Mirkwood
ID: 1455351
Bought This Question.
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

708 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now