Private Const NO_ERROR As Long = 0
Private Const CONNECT_UPDATE_PROFILE As Long = &H1
Private Const RESOURCETYPE_DISK As Long = &H1
Private Const RESOURCE_GLOBALNET As Long = &H2
Private Const RESOURCEDISPLAYTYPE_SHARE As Long = &H3
Private Const RESOURCEUSAGE_CONNECTABLE As Long = &H1

Private Const SW_SHOWNORMAL As Long = 1

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


'----------------------------------------------
'WNetAddConnection2

'Allows the caller to redirect (connect) a local
'device to a network resource. It is similar to
'WNetAddConnection, except that it takes a pointer
'to a NETRESOURCE structure to describe the network
'resource to connect to. It also takes the addition
'parameters lpUserID and dwFlags.

'lpNetResource
'Specifies the network resource to connect to.
'The following fields must be set when making a
'connection, the others are ignored.
'
'  lpRemoteName: Specifies the network resource
'                to connect to. This is limited
'                to MAX_PATH.
 
'  lpLocalName: This specifies the name of a local
'               device to be redirected, such as "F:"
'               or "LPT1". The string is treated in a
'               case insensitive manner, and may be
'               the empty string (or NULL) in which
'               case a connection to the network resource
'               is made without making a redirection.
 
'  lpProvider: Specifies the NP to connect to. If NULL
'              or empty string, Windows will try each
'              NP in turn. The caller should set
'              lpProvider only if it knows for sure
'              which network it wants. Otherwise, it
'              is preferable to let Windows determine
'              which NP the network name maps to.
'              If this is non NULL, Windows will try
'              the named NP and no other.
 
'  dwType: Specifies the type of resource to connect to.
'          It must be RESOURCETYPE_DISK or RESOURCETYPE_PRINT
'          if lpLocalName is not the empty string. It may
'          also be RESOURCETYPE_ANY if lpLocalName is the
'          empty string.
'
'lpPassword
'Specifies the password to be used in making the
'connection, normally the password associated with
'lpUserID. A NULL value or string may be passed in
'to indicate to the function to use the current
'default password.
'
'lpUserID
'This specifies the identity of the user needed to
'make the connection. If NULL, a default will be
'applied. This is used when the user wishes to connect
'to a resource, but has a different user name or
'account assigned to him for that resource. This
'identification represents a security context, and
'is NP specific.
'
'dwFlags
'This is a bit mask which may have any of the
'following bits set:
'
'  CONNECT_UPDATE_PROFILE: If the connection should
'                          be made persistent. If set,
'                          Windows automatically restores
'                          this connection when the user
'                          logs on to the network. A connection
'                          is only made persistent if the
'                          connection was successful.
 

Private Declare Function WNetAddConnection2 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 WNetCancelConnection2 Lib "mpr.dll" _
   Alias "WNetCancelConnection2A" _
  (ByVal lpName As String, _
   ByVal dwFlags As Long, _
   ByVal fForce As Long) As Long

Private Declare Function ShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
   (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long
    


Private Sub Form_Load()

   Dim cnt As Long
   
   For cnt = 0 To 4
   
      If cnt > 0 Then Load Command1(cnt)
      
      With Command1(cnt)
      
         .Move 200, 200 + (370 * cnt), 2000, 345
         .Visible = True
         
         Select Case cnt
            Case 0: .Caption = "Map Specified Net Drive"
            Case 1: .Caption = "Map First Free Net Drive"
            Case 2: .Caption = "Disconnect Net Drive"
            Case 3: .Caption = "Open Explorer"
            Case 4: .Caption = "Exit"
         End Select
         
      End With
      
   Next  'cnt
         
End Sub


Private Sub Command1_Click(Index As Integer)

   Select Case Index
      Case 0: 'connect to a share as the passed drive letter
               MsgBox ConnectNetDrive("\\vbnetvaio\c$", "X:")

      Case 1: 'connect to a share using the first available drive letter
               MsgBox ConnectNetFirstFreeDrive("\\vbnetvaio\c$")
      
      Case 2: 'force a disconnection from the specified mapped drive
               MsgBox DisconnectNetDrive("X:", True)
      
      Case 3: 'show explorer
               Call ShellExecute(0&, "Open", _
                                     "explorer.exe", "/e,/n,c:\", _
                                     0&, SW_SHOWNORMAL)
      Case 4: 'quit
               Unload Me
      
   End Select
   
End Sub


Private Function ConnectNetDrive(serverpath As String, driveletter As String) As Boolean

  'attempts to connect to the passed network
  'connection to the specified drive.
  'ErrInfo=NO_ERROR if sucessful.

   Dim NETR As NETRESOURCE
   Dim errInfo As Long

   With NETR
      .dwScope = RESOURCE_GLOBALNET
      .dwType = RESOURCETYPE_DISK
      .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
      .dwUsage = RESOURCEUSAGE_CONNECTABLE
      .lpRemoteName = serverpath
      .lpLocalName = driveletter
      .lpProvider = vbNullString
   End With

   errInfo = WNetAddConnection2(NETR, vbNullString, "birchr", CONNECT_UPDATE_PROFILE)

   ConnectNetDrive = errInfo = NO_ERROR

End Function


Private Function ConnectNetFirstFreeDrive(serverpath As String) As String

   Dim NETR As NETRESOURCE
   Dim errInfo As Long
   Dim x As Long
   Dim testDrv As String

  'set the first drive as C (ascii 67), and
  'then if unsuccessful try incrementing by
  'one until the last drive is reached.
  'This is easier than using GetLogicalDriveStrings
  'to determine what's already used and what's free,
  'since the API returns an error code if the
  'drive assigned is already in use.
  
  'To change this to a "ConnectNetLastFreeDrive"
  'routine, change x= below to from 67 (C) to 123
  '(one char above Z), and change x=x+1 to x=x-1
  'in the Do Loop. Then change the 90 (Z) test in 
  'in the Loop to 68 (D)
  
   x = 67

   Do

     'increment drive by one (making the first
     'drive to test D:)
      x = x + 1
      testDrv = Chr$(x) & ":"

      With NETR
         .dwScope = RESOURCE_GLOBALNET
         .dwType = RESOURCETYPE_DISK
         .dwDisplayType = RESOURCEDISPLAYTYPE_SHARE
         .dwUsage = RESOURCEUSAGE_CONNECTABLE
         .lpRemoteName = serverpath
         .lpLocalName = testDrv
      End With

      errInfo = WNetAddConnection2(NETR, vbNullString, "birchr", CONNECT_UPDATE_PROFILE)

   Loop Until (x = 90) Or (errInfo = NO_ERROR)   '90 = "z"


  'return drive if successful, or empty string if failed
   If errInfo = NO_ERROR Then
      ConnectNetFirstFreeDrive = testDrv
   Else
      ConnectNetFirstFreeDrive = ""
   End If

End Function


Private Function DisconnectNetDrive(sResource As String, bForce As Boolean) As Boolean

  'Attempt to disconnect from the resource specified.
  'sResource is a string specifying the name of
  'either the redirected local device or the remote
  'network resource to disconnect from. If a redirected
  'local device is specified, the function cancels only
  'the specified device redirection. If a remote network
  'resource is specified, all connections without devices
  'are cancelled.
  
  'The bForce parameter specifies whether the disconnection
  'should occur if there are open files or jobs on the connection.
  'If this parameter is false the function fails if there are
  'open files or jobs.

  'connection to the specified drive.
  'ErrInfo=NO_ERROR if sucessful

   Dim errInfo As Long
   errInfo = WNetCancelConnection2(sResource, CONNECT_UPDATE_PROFILE, Abs(bForce))

   DisconnectNetDrive = errInfo = NO_ERROR

End Function