home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples5 / ch22 / dwnetres.cls < prev    next >
Encoding:
Visual Basic class definition  |  1997-02-17  |  11.0 KB  |  321 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "dwNetResource"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. ' Class dwNetResource
  11. ' Copyright (c) 1996 by Desaware Inc.  All Rights Reserved
  12. ' Part of the Desaware API Class Library
  13. ' For further information contact:
  14. ' Desaware Inc.
  15. ' 1100 E. Hamilton Ave.  Suite #4
  16. ' Campbell, CA 95008
  17. ' (408) 377-4770
  18. ' www.desaware.com
  19.  
  20. Option Explicit
  21.  
  22. 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
  23. ' We need a separate declaration for the null case
  24. 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
  25.  
  26. Private Declare Function WNetEnumResource Lib "mpr.dll" Alias "WNetEnumResourceA" (ByVal hEnum As Long, lpcCount As Long, lpBuffer As Byte, lpBufferSize As Long) As Long
  27. 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
  28. 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
  29. 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
  30.  
  31. Private Declare Function WNetCloseEnum Lib "mpr.dll" (ByVal hEnum As Long) As Long
  32.  
  33. ' Important error values
  34. Private Const ERROR_EXTENDED_ERROR = 1208&
  35. Private Const ERROR_NO_MORE_ITEMS = 259&
  36. Private Const ERROR_MORE_DATA = 234 '  dderror
  37.  
  38.  
  39. Private Type NETRESOURCELONG
  40.         dwScope As Long
  41.         dwType As Long
  42.         dwDisplayType As Long
  43.         dwUsage As Long
  44.         lpLocalName As Long
  45.         lpRemoteName As Long
  46.         lpComment As Long
  47.         lpProvider As Long
  48. End Type
  49.  
  50. Private Type NETRESOURCE
  51.         dwScope As Long
  52.         dwType As Long
  53.         dwDisplayType As Long
  54.         dwUsage As Long
  55.         lpLocalName As String
  56.         lpRemoteName As String
  57.         lpComment As String
  58.         lpProvider As String
  59. End Type
  60.  
  61. ' Holds the current copy of the netresource
  62. Private Info As NETRESOURCE
  63.  
  64. ' Set on object that has been initialized to a valid net resource
  65. Private Initialized As Boolean
  66.  
  67.  
  68. ' Always loaded with last network API error
  69. Public LastError As Long
  70. ' Set only if LastError is ERROR_EXTENDED_ERROR (See dwNetwork)
  71. Public LastNetError As New dwNetError
  72.  
  73. ' Local type name on the remote system.
  74. ' Set by WNetGetResourceInformation
  75. Public SystemResourceName$
  76.  
  77. ' Set and Retrieve the flag types. Constants are in dwNetConstants
  78.  
  79. Public Property Get dwScope() As Long
  80.    dwScope = Info.dwScope
  81. End Property
  82.  
  83. Public Property Get dwType() As Long
  84.    dwType = Info.dwType
  85. End Property
  86.  
  87. Public Property Get dwDisplayType() As Long
  88.    dwDisplayType = Info.dwDisplayType
  89. End Property
  90.  
  91. Public Property Get dwUsage() As Long
  92.    dwUsage = Info.dwUsage
  93. End Property
  94.  
  95. ' The set values do not verification. Win32 will catch
  96. ' errors when the structure is used in an API call.
  97.  
  98. Public Property Let dwScope(l As Long)
  99.    Info.dwScope = l
  100. End Property
  101.  
  102. Public Property Let dwType(l As Long)
  103.    Info.dwType = l
  104. End Property
  105.  
  106. Public Property Let dwDisplayType(l As Long)
  107.    Info.dwDisplayType = l
  108. End Property
  109.  
  110. Public Property Let dwUsage(l As Long)
  111.    Info.dwUsage = l
  112. End Property
  113.  
  114. ' Note how on the next four string retrieval functions, we
  115. ' strip the extra null terminator that was added earlier
  116. ' If it's empty or null, we just return the empty string
  117. Public Property Get lpLocalName() As String
  118.    If Len(Info.lpLocalName) > 1 Then
  119.       lpLocalName = Left(Info.lpLocalName, Len(Info.lpLocalName) - 1)
  120.    End If
  121. End Property
  122.  
  123. Public Property Get lpRemoteName() As String
  124.    If Len(Info.lpRemoteName) > 1 Then
  125.       lpRemoteName = Left(Info.lpRemoteName, Len(Info.lpRemoteName) - 1)
  126.    End If
  127. End Property
  128.  
  129. Public Property Get lpComment() As String
  130.    If Len(Info.lpComment) > 1 Then
  131.       lpComment = Left(Info.lpComment, Len(Info.lpComment) - 1)
  132.    End If
  133. End Property
  134.  
  135. Public Property Get lpProvider() As String
  136.    If Len(Info.lpProvider) > 1 Then
  137.       lpProvider = Left(Info.lpProvider, Len(Info.lpProvider) - 1)
  138.    End If
  139. End Property
  140.  
  141. ' You need to be able to set the strings as well, since
  142. ' the object can be used when creating connections
  143.  
  144. Public Property Let lpLocalName(ByVal s As String)
  145.    ' Make sure we have that null termination
  146.    If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
  147.    Info.lpLocalName = s
  148. End Property
  149.  
  150. Public Property Let lpRemoteName(ByVal s As String)
  151.    ' Make sure we have that null termination
  152.    If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
  153.    Info.lpRemoteName = s
  154. End Property
  155.  
  156. Public Property Let lpComment(ByVal s As String)
  157.    ' Make sure we have that null termination
  158.    If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
  159.    Info.lpComment = s
  160. End Property
  161.  
  162. Public Property Let lpProvider(ByVal s As String)
  163.    ' Make sure we have that null termination
  164.    If s <> vbNullString And Len(s) >= 1 And Right$(s, 1) <> Chr$(0) Then s = s & Chr$(0)
  165.    Info.lpProvider = s
  166. End Property
  167.  
  168.  
  169. ' The NETRESOURCELONG structure contains information
  170. ' from a buffer. We need to convert that information into
  171. ' a form that won't fail when the buffer is deleted (which
  172. ' will happen if the enumerating object is changed or destroyed)
  173. ' Note how we add an extra null termination just in case to be
  174. ' sure we can use the info structure for further enumeration. We
  175. ' strip it on attempts to read the string
  176.  
  177. Private Sub LoadInfoFromNRLong(nr As NETRESOURCELONG)
  178.    Info.dwScope = nr.dwScope
  179.    Info.dwType = nr.dwType
  180.    Info.dwDisplayType = nr.dwDisplayType
  181.    Info.dwUsage = nr.dwUsage
  182.    If nr.lpLocalName <> 0 Then
  183.       Info.lpLocalName = agGetStringFromPointer(nr.lpLocalName) & Chr$(0)
  184.    Else
  185.       Info.lpLocalName = vbNullString
  186.    End If
  187.    If nr.lpRemoteName <> 0 Then
  188.       Info.lpRemoteName = agGetStringFromPointer(nr.lpRemoteName) & Chr$(0)
  189.    Else
  190.       Info.lpRemoteName = vbNullString
  191.    End If
  192.    If nr.lpComment <> 0 Then
  193.       Info.lpComment = agGetStringFromPointer(nr.lpComment) & Chr$(0)
  194.    Else
  195.       Info.lpComment = vbNullString
  196.    End If
  197.    If nr.lpProvider <> 0 Then
  198.       Info.lpProvider = agGetStringFromPointer(nr.lpProvider) & Chr$(0)
  199.    Else
  200.       Info.lpProvider = vbNullString
  201.    End If
  202.  
  203. End Sub
  204.  
  205. ' This function is called to load the dwNetResource
  206. ' object from a buffer created during an enumeration
  207. Public Sub Load(ByVal bufferaddress&)
  208.    Dim nr As NETRESOURCELONG  ' Temporary structure for copying
  209.    ' Copy the necessary data
  210.    agCopyData ByVal bufferaddress, nr, Len(nr)
  211.    LoadInfoFromNRLong nr
  212.   
  213.    Initialized = True
  214. End Sub
  215.  
  216.  
  217. ' This function combines the WNetOpenEnum, WNetEnumResources and WNetCloseEnum functions
  218. ' It returns a collection containing all of the enumerated objects
  219.  
  220. Public Function Enumerate(ByVal dwScope&, ByVal dwType&, ByVal dwUsage&) As Collection
  221.    Dim EnumerationHandle&
  222.    Dim res&
  223.    Dim tbuf() As Byte
  224.    Dim BufferSize As Long
  225.    Dim Results As New Collection
  226.    Dim newobject As New dwNetResource
  227.    
  228.    ' We don't do parameter verification here, leaving it for
  229.    ' Win32 to do it and set the LastError if necessary
  230.  
  231.  
  232.    If Not Initialized Then
  233.       res = WNetOpenEnumRoot(dwScope, dwType, dwUsage, 0, EnumerationHandle)
  234.    Else
  235.       ' We take advantage of the fact that dynamic strings inside of VB structures
  236.       ' are BSTR's which translate into ANSI strings during an API function call
  237.       res = WNetOpenEnum(dwScope, dwType, dwUsage, Info, EnumerationHandle)
  238.    End If
  239.    ' Typical failures here are invalid parameters, no network
  240.    If res <> 0 Then
  241.       SetErrorValues
  242.       Exit Function
  243.    End If
  244.  
  245.    ' Create a big buffer to work with. We dimention it here instead of
  246.    ' at the declaration to make sure it's allocated off the heap and not the stack
  247.    ReDim tbuf(16384)
  248.    BufferSize = 16384
  249.  
  250.    ' Here we enumerate each resource at this level. Note that we don't do
  251.    ' any checking to make sure that this is a valid NetResource container (or root)
  252.    ' because Win32 will catch this error
  253.    Do
  254.       res = WNetEnumResource(EnumerationHandle, 1, tbuf(0), BufferSize)
  255.       
  256.       ' Check for errors
  257.       Select Case res
  258.          Case 0   ' Success
  259.             ' Create a new object
  260.             Set newobject = New dwNetResource
  261.             ' We pass the new object a pointer to the buffer
  262.             newobject.Load agGetAddressForObject(tbuf(0))
  263.             Results.Add newobject
  264.         
  265.         Case ERROR_NO_MORE_ITEMS
  266.             Debug.Print "count of the results " & Results.Count
  267.            
  268.          Case Else
  269.             SetErrorValues
  270.             If LastError = ERROR_MORE_DATA Then
  271.                ' A buffer too small error should be very rare, but
  272.                ' the case is handled just to be through. The code
  273.                ' will drop down and try again
  274.                ReDim tbuf(BufferSize + 1)
  275.             Else
  276.                ' This type of error can't be handled, so exit
  277.                ' the loop immediately
  278.                Exit Do
  279.             End If
  280.       End Select
  281.       
  282.    Loop While res = 0
  283.  
  284.    ' And close the enumeration
  285.    res = WNetCloseEnum(EnumerationHandle)
  286.    Set Enumerate = Results
  287.    If res <> 0 Then SetErrorValues
  288. End Function
  289.  
  290. ' Loads the LastError and LastNetError information when an error occurs
  291. Public Sub SetErrorValues()
  292.       LastError = Err.LastDllError
  293.       If LastError = ERROR_EXTENDED_ERROR Then
  294.          ' This error object initializes itself
  295.          Set LastNetError = New dwNetError
  296.       End If
  297. End Sub
  298.  
  299. ' To call this method, the following properties must be set
  300. ' dwType (RESOURCETYPE_ constant)
  301. ' lpLocalName (may be null)
  302. ' lpRemoteName
  303. ' lpProvider (null to use default)
  304. Public Function WNetAddConnection2(lpPassWord As String, lpUser As String, dwConnection As Long) As Long
  305.    Dim res&
  306.    res = intWNetAddConnection2(Info, lpPassWord, lpUser, dwConnection)
  307.    
  308.    If res <> 0 Then SetErrorValues
  309.    WNetAddConnection2 = res
  310. End Function
  311.  
  312. Public Function WNetAddConnection3(hwnd As Long, lpPassWord As String, lpUser As String, dwConnection As Long) As Long
  313.    Dim res&
  314.    res = intWNetAddConnection3(hwnd, Info, lpPassWord, lpUser, dwConnection)
  315.    
  316.    If res <> 0 Then SetErrorValues
  317.    WNetAddConnection3 = res
  318. End Function
  319.  
  320.  
  321.