VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "dwNetResource"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
' Class dwNetResource
' Copyright (c) 1996 by Desaware Inc.  All Rights Reserved
' Part of the Desaware API Class Library
' For further information contact:
' Desaware Inc.
' 1100 E. Hamilton Ave.  Suite #4
' Campbell, CA 95008
' (408) 377-4770
' www.desaware.com

Option Explicit

Private Declare Function WNetOpenEnum Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, lpNetResource As NETRESOURCE, lphEnum As Long) As Long
' We need a separate declaration for the null case
Private Declare Function WNetOpenEnumRoot Lib "mpr.dll" Alias "WNetOpenEnumA" (ByVal dwScope As Long, ByVal dwType As Long, ByVal dwUsage As Long, ByVal lpNetResource As Long, lphEnum As Long) As Long

Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As Byte, lpBufferSize As Long) As Long
Private Declare Function intWNetAddConnection2 Lib "mpr.dll" Alias "WNetAddConnection2A" (lpNetResource As NETRESOURCE, ByVal lpPassWord As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function intWNetAddConnection3 Lib "mpr.dll" Alias "WNetAddConnection3A" (ByVal hwnd As Long, lpNetResource As NETRESOURCE, ByVal lpPassWord As String, ByVal lpUserName As String, ByVal dwFlags As Long) As Long
Private Declare Function intWNetUseConnection Lib "mpr.dll" Alias "WNetUseConnectionA" (ByVal hwnd As Long, lpNetResource As NETRESOURCE, ByVal lpPassWord As String, ByVal lpUserID As String, ByVal dwFlags As Long, ByVal lpAccessName As String, lpBufferSize As Long, lpResult As Long) As Long

Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long

' Important error values
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_NO_MORE_ITEMS = 259&
Private Const ERROR_MORE_DATA = 234 '  dderror


Private Type NETRESOURCELONG
        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

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

' Holds the current copy of the netresource
Private Info As NETRESOURCE

' Set on object that has been initialized to a valid net resource
Private Initialized As Boolean


' Always loaded with last network API error
Public LastError As Long
' Set only if LastError is ERROR_EXTENDED_ERROR (See dwNetwork)
Public LastNetError As New dwNetError

' Local type name on the remote system.
' Set by WNetGetResourceInformation
Public SystemResourceName$

' Set and Retrieve the flag types. Constants are in dwNetConstants

Public Property Get dwScope() As Long
   dwScope = Info.dwScope
End Property

Public Property Get dwType() As Long
   dwType = Info.dwType
End Property

Public Property Get dwDisplayType() As Long
   dwDisplayType = Info.dwDisplayType
End Property

Public Property Get dwUsage() As Long
   dwUsage = Info.dwUsage
End Property

' The set values do not verification. Win32 will catch
' errors when the structure is used in an API call.

Public Property Let dwScope(l As Long)
   Info.dwScope = l
End Property

Public Property Let dwType(l As Long)
   Info.dwType = l
End Property

Public Property Let dwDisplayType(l As Long)
   Info.dwDisplayType = l
End Property

Public Property Let dwUsage(l As Long)
   Info.dwUsage = l
End Property

' Note how on the next four string retrieval functions, we
' strip the extra null terminator that was added earlier
' If it's empty or null, we just return the empty string
Public Property Get lpLocalName() As String
   If Len(Info.lpLocalName) > 1 Then
      lpLocalName = Left(Info.lpLocalName, Len(Info.lpLocalName) - 1)
   End If
End Property

Public Property Get lpRemoteName() As String
   If Len(Info.lpRemoteName) > 1 Then
      lpRemoteName = Left(Info.lpRemoteName, Len(Info.lpRemoteName) - 1)
   End If
End Property

Public Property Get lpComment() As String
   If Len(Info.lpComment) > 1 Then
      lpComment = Left(Info.lpComment, Len(Info.lpComment) - 1)
   End If
End Property

Public Property Get lpProvider() As String
   If Len(Info.lpProvider) > 1 Then
      lpProvider = Left(Info.lpProvider, Len(Info.lpProvider) - 1)
   End If
End Property

' You need to be able to set the strings as well, since
' the object can be used when creating connections

Public Property Let lpLocalName(ByVal s As String)
   ' Make sure we have that null termination
   If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
   Info.lpLocalName = s
End Property

Public Property Let lpRemoteName(ByVal s As String)
   ' Make sure we have that null termination
   If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
   Info.lpRemoteName = s
End Property

Public Property Let lpComment(ByVal s As String)
   ' Make sure we have that null termination
   If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
   Info.lpComment = s
End Property

Public Property Let lpProvider(ByVal s As String)
   ' Make sure we have that null termination
   If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
   Info.lpProvider = s
End Property


' The NETRESOURCELONG structure contains information
' from a buffer. We need to convert that information into
' a form that won't fail when the buffer is deleted (which
' will happen if the enumerating object is changed or destroyed)
' Note how we add an extra null termination just in case to be
' sure we can use the info structure for further enumeration. We
' strip it on attempts to read the string

Private Sub LoadInfoFromNRLong(nr As NETRESOURCELONG)
   Info.dwScope = nr.dwScope
   Info.dwType = nr.dwType
   Info.dwDisplayType = nr.dwDisplayType
   Info.dwUsage = nr.dwUsage
   If nr.lpLocalName <> 0 Then
      Info.lpLocalName = agGetStringFromPointer(nr.lpLocalName) & Chr$(0)
   Else
      Info.lpLocalName = vbNullString
   End If
   If nr.lpRemoteName <> 0 Then
      Info.lpRemoteName = agGetStringFromPointer(nr.lpRemoteName) & Chr$(0)
   Else
      Info.lpRemoteName = vbNullString
   End If
   If nr.lpComment <> 0 Then
      Info.lpComment = agGetStringFromPointer(nr.lpComment) & Chr$(0)
   Else
      Info.lpComment = vbNullString
   End If
   If nr.lpProvider <> 0 Then
      Info.lpProvider = agGetStringFromPointer(nr.lpProvider) & Chr$(0)
   Else
      Info.lpProvider = vbNullString
   End If

End Sub

' This function is called to load the dwNetResource
' object from a buffer created during an enumeration
Public Sub Load(ByVal bufferaddress&)
   Dim nr As NETRESOURCELONG  ' Temporary structure for copying
   ' Copy the necessary data
   agCopyData ByVal bufferaddress, nr, Len(nr)
   LoadInfoFromNRLong nr
  
   Initialized = True
End Sub


' This function combines the WNetOpenEnum, WNetEnumResources and WNetCloseEnum functions
' It returns a collection containing all of the enumerated objects

Public Function Enumerate(ByVal dwScope&, ByVal dwType&, ByVal dwUsage&) As Collection
   Dim EnumerationHandle&
   Dim res&
   Dim tbuf() As Byte
   Dim BufferSize As Long
   Dim Results As New Collection
   Dim newobject As New dwNetResource
   
   ' We don't do parameter verification here, leaving it for
   ' Win32 to do it and set the LastError if necessary


   If Not Initialized Then
      res = WNetOpenEnumRoot(dwScope, dwType, dwUsage, 0, EnumerationHandle)
   Else
      ' We take advantage of the fact that dynamic strings inside of VB structures
      ' are BSTR's which translate into ANSI strings during an API function call
      res = WNetOpenEnum(dwScope, dwType, dwUsage, Info, EnumerationHandle)
   End If
   ' Typical failures here are invalid parameters, no network
   If res <> 0 Then
      SetErrorValues
      Exit Function
   End If

   ' Create a big buffer to work with. We dimention it here instead of
   ' at the declaration to make sure it's allocated off the heap and not the stack
   ReDim tbuf(16384)
   BufferSize = 16384

   ' Here we enumerate each resource at this level. Note that we don't do
   ' any checking to make sure that this is a valid NetResource container (or root)
   ' because Win32 will catch this error
   Do
      res = WNetEnumResource(EnumerationHandle, 1, tbuf(0), BufferSize)
      
      ' Check for errors
      Select Case res
         Case 0   ' Success
            ' Create a new object
            Set newobject = New dwNetResource
            ' We pass the new object a pointer to the buffer
            newobject.Load agGetAddressForObject(tbuf(0))
            Results.Add newobject
        
        Case ERROR_NO_MORE_ITEMS
            Debug.Print "count of the results " & Results.Count
           
         Case Else
            SetErrorValues
            If LastError = ERROR_MORE_DATA Then
               ' A buffer too small error should be very rare, but
               ' the case is handled just to be through. The code
               ' will drop down and try again
               ReDim tbuf(BufferSize + 1)
            Else
               ' This type of error can't be handled, so exit
               ' the loop immediately
               Exit Do
            End If
      End Select
      
   Loop While res = 0

   ' And close the enumeration
   res = WNetCloseEnum(EnumerationHandle)
   Set Enumerate = Results
   If res <> 0 Then SetErrorValues
End Function

' Loads the LastError and LastNetError information when an error occurs
Public Sub SetErrorValues()
      LastError = Err.LastDllError
      If LastError = ERROR_EXTENDED_ERROR Then
         ' This error object initializes itself
         Set LastNetError = New dwNetError
      End If
End Sub

' To call this method, the following properties must be set
' dwType (RESOURCETYPE_ constant)
' lpLocalName (may be null)
' lpRemoteName
' lpProvider (null to use default)
Public Function WNetAddConnection2(lpPassWord As String, lpUser As String, dwConnection As Long) As Long
   Dim res&
   res = intWNetAddConnection2(Info, lpPassWord, lpUser, dwConnection)
   
   If res <> 0 Then SetErrorValues
   WNetAddConnection2 = res
End Function

Public Function WNetAddConnection3(hwnd As Long, lpPassWord As String, lpUser As String, dwConnection As Long) As Long
   Dim res&
   res = intWNetAddConnection3(hwnd, Info, lpPassWord, lpUser, dwConnection)
   
   If res <> 0 Then SetErrorValues
   WNetAddConnection3 = res
End Function


