Drive Mapping

This tip covers drive mapping in Visual Basic.

This Content Component encountered an error

Drive Mapping
Greg Osborne
gregosborne@vp.net

When users run your applications, it will be a pain if they have to start Windows Explorer to map a needed drive. Reader Greg Osborne of Fort Collins, Colo., provides us with a way to map and unmap drives from within an application. The tip below includes the code for a class, as well as code to allow testing of the class.

I have often needed to add drive mapping and unmapping capabilities to an application that I have written. Over the years, I have come up with a class that I have added to my projects which allows the creation of network drive mappings both through code or through the use of the built-in windows dialogs.

The class code is below - its fairly long but encompasses many API functions. Also contains an error event you can use in your application for trapping errors that may occur.

Start a new ActiveX DLL project. Name the project NW and the Class Networking

=============================
Option Explicit
'these functions - G. Osborne (05/10/1998)
Public Enum WN_FUNCTIONS
  WN_CONNECTION_DIALOG = 20000
  WN_DISCONNECTION_DIALOG
  WN_ADD_CONNECTION
  WN_CANCEL_CONNECTION
  WN_CONNECTION_INFO
  WN_DRIVE_TYPE
  WN_DRIVE_STRINGS
  WN_NET_USERNAME
End Enum
'errors - G. Osborne (05/10/1998)
Public Enum WN_ERRORS
  CANCEL_PRESSED = 2300
  NO_ERROR = 0
  WN_ACCESS_DENIED = 5
  WN_OUT_OF_MEMORY = 8
  WN_NOT_SUPPORTED = 50
  WN_NET_ERROR = 59
  WN_BAD_NETNAME = 67
  WN_ALREADY_CONNECTED = 85
  WN_BAD_PASSWORD = 86
  WN_BAD_VALUE = 87
  WN_MORE_DATA = 234
  WN_BAD_POINTER = 487
  WN_BAD_LOCALNAME = 1200
  WN_NOT_CONNECTED = 2250
  WN_DLL_GETDRIVE_STRING_ERROR = 2251
  WN_DLL_GETUSERNAME_ERROR = 2252
End Enum
'drive types - G. Osborne (05/10/1998)
Public Enum WN_DRIVE_TYPES
  WN_UNKNOWN_DRIVE = 1
  WN_REMOVABLE_DRIVE = 2
  WN_FIXED_DRIVE = 3
  WN_NETWORK_DRIVE = 4
  WN_CDROM_DRIVE = 5
  WN_RAM_DRIVE = 6
End Enum
'declares - G. Osborne (05/10/1998)
Private Declare Function WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA" (ByVal 
lpName As String, ByVal lpUserName As String, lpnLength As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias 
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As 
String) As Long
Private Declare Function WNetConnectionDialog Lib "mpr.dll" (ByVal hWnd As 
Long, ByVal dwType As Long) As Long
Private Declare Function WNetDisconnectDialog Lib "mpr.dll" (ByVal hWnd As 
Long, ByVal dwType As Long) As Long
Private Declare Function WNetAddConnection Lib "mpr.dll" Alias 
"WNetAddConnectionA" (ByVal lpszNetPath As String, ByVal lpszPassword As 
String, ByVal lpszLocalName As String) As Long
Private Declare Function WNetCancelConnection Lib "mpr.dll" Alias 
"WNetCancelConnectionA" (ByVal lpszName As String, ByVal bForce As Long) As 
Long
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias 
"WNetGetConnectionA" (ByVal lpszLocalName As String, ByVal lpszRemoteName As 
String, cbRemoteName As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" 
(ByVal nDrive As String) As Long
'events - G. Osborne (05/10/1998)
Public Event NetError(Number As WN_ERRORS, Description, Source, DuringFunction, 
ExtraText)
Public Function NetConnectionDialog(ByVal ownerHwnd As Long) As Boolean
'------------------------------------------------------------------------------
--
'         Name: NetConnectionDialog
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Displays the connect network drive dialog.  Returns  True if
'                successful, False otherwise
' Return Value: Boolean
'   Parameters: ByVal ownerHwnd         As Long
'
'------------------------------------------------------------------------------
--
  'make call and process retvalue
  NetConnectionDialog = ErrorMessage(WNetConnectionDialog(ownerHwnd, 1), 
WN_CONNECTION_DIALOG, vbNullString)
End Function
Public Function NetDisConnectionDialog(ByVal ownerHwnd As Long)
'------------------------------------------------------------------------------
--
'         Name: NetDisConnectionDialog
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Displays the disconnect network drive dialog.  Returns  True if
'                successful, False otherwise
' Return Value:
'   Parameters: ByVal ownerHwnd         As Long
'
'------------------------------------------------------------------------------
--
  'make call and process return value
  NetDisConnectionDialog = ErrorMessage(WNetDisconnectDialog(ownerHwnd, 1), 
WN_DISCONNECTION_DIALOG, vbNullString)
End Function
Public Function NetAddConnection(ByVal NetworkPath, ByVal NetworkPassword, 
ByVal localName)
'------------------------------------------------------------------------------
--
'         Name: NetAddConnection
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Connects a network drive with the dialog box.  Returns True if
'                successful, False otherwise
' Return Value:
'   Parameters: ByVal NetworkPath
'                ByVal NetworkPassword
'                ByVal localName
'
'------------------------------------------------------------------------------
--
  'make call and process return value
  NetAddConnection = ErrorMessage(WNetAddConnection(CStr(NetworkPath), 
CStr(NetworkPassword), CStr(localName)), WN_ADD_CONNECTION, vbNullString)
End Function
Public Function NetCancelConnection(ByVal localName)
'------------------------------------------------------------------------------
--
'         Name: NetCancelConnection
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Disconnects a network drive with the dialog box. Returns True 
if
'                successful, False otherwise
' Return Value:
'   Parameters: ByVal localName
'
'------------------------------------------------------------------------------
--
  'make call and process return value
  NetCancelConnection = ErrorMessage(WNetCancelConnection(CStr(localName), 1), 
WN_CANCEL_CONNECTION, vbNullString)
End Function
Public Function NetConnection(ByVal localName)
'------------------------------------------------------------------------------
--
'         Name: NetConnection
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Returns the fully qualified share name of the specified netork
'                connection
' Return Value:
'   Parameters: ByVal localName
'
'------------------------------------------------------------------------------
--
  Dim buffer                            As String
  Dim bufferlen                         As Long
  Dim retval                            As WN_ERRORS
  'make sure local name is just "X:"
  localName = Left(localName, 2)
  buffer = vbNullString
  Do
    'set buffer size - if WM_MORE_DATA is the return
    'code from the call, loop and make larger until
    'that error code goes away
    buffer = Space(Len(buffer) + 255)
    bufferlen = Len(buffer)
    'make call
    retval = WNetGetConnection(CStr(localName), buffer, bufferlen)
  Loop Until retval <> WN_MORE_DATA
  'process retval
  If retval <> NO_ERROR Then
    'there was an error
    ErrorMessage retval, WN_CONNECTION_INFO, vbNullString
  Else
    'return share name
    NetConnection = Left(buffer, InStr(buffer, Chr(0)) - 1)
  End If
End Function
Public Function NetDriveType(localName)
'------------------------------------------------------------------------------
--
'         Name: NetDriveType
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Returns the type of drive specified by the root path in
'                Localname
' Return Value:
'   Parameters: localName
'
'------------------------------------------------------------------------------
--
  Dim retval                            As WN_DRIVE_TYPES
  retval = GetDriveType(CStr(localName))
  NetDriveType = LoadResString(12400 + retval)
End Function
Public Function NetDrives(ByVal separator) As String
'------------------------------------------------------------------------------
--
'         Name: NetDrives
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: Returns a string loaded with the drive letters specifying all
'                the drives on the computer
' Return Value: String
'   Parameters: ByVal separator
'
'------------------------------------------------------------------------------
--
    Dim drvs                            As Integer
    Dim buffer                          As String
    Dim buflen                          As Long
    Dim retval                          As Long
    buffer = Space$(255)
    buflen = Len(buffer)
    'make call
    retval = GetLogicalDriveStrings(buflen, buffer)
    'a retval of 0 means there was an error
    'report it and return the Err.LastDLLError
    If retval = 0 Then
      ErrorMessage WN_DLL_GETDRIVE_STRING_ERROR, WN_DRIVE_STRINGS, 
"DLLErrorCode:" & Err.LastDllError
      Exit Function
    End If
    'trim spaces
    buffer = LTrim(RTrim(buffer))
    'fix drives into a delimited string
    For drvs = 1 To Len(buffer) - 2
        If Mid(buffer, drvs, 1) = Chr$(0) Then
            Mid$(buffer, drvs, 1) = separator
        End If
    Next drvs
    '2 null characters on the end - trim off
    NetDrives = Left(buffer, Len(buffer) - 2)
End Function
Private Function ErrorMessage(ByVal Errorcode As WN_ERRORS, ByVal 
DuringFunction As WN_FUNCTIONS, Optional ByVal ExtraText) As Boolean
'------------------------------------------------------------------------------
--
'         Name: ErrorMessage
'  Create Date: 05/10/1998
'   Created By: G. Osborne
'      Purpose: If necessary, raises the error event and passes pre-defined
'                parameters back to the error event of the parent object.
'                Returns True if there was no error (WN_NO_ERROR) or False
'                otherwise.
' Return Value: Boolean
'   Parameters: ByVal Errorcode         As WN_ERRORS
'                ByVal DuringFunction   As WN_FUNCTIONS
'                Optional ByVal ExtraText
'
'------------------------------------------------------------------------------
--
  If Errorcode = NO_ERROR Then
    'mapped okay
    ErrorMessage = True
  Else
    'cancel pressed - point to const
    If Errorcode = -1 Then
      Errorcode = CANCEL_PRESSED
    End If
    ErrorMessage = False
    'notify by event
    RaiseEvent NetError(Errorcode, LoadResString(Errorcode + 10000), App.Title 
& " (V" & App.Major & "." & App.Minor & "." & App.Revision & ")", 
LoadResString(DuringFunction), vbNullString)
  End If
End Function

The above code relies heavily on a resource file with the following entries:

ID English (United States)
10000 No Error
10005 Access Denied
10008 Out of Memory
10050 Not Supported
10059 Network Error
10067 Bad Network Name
10085 Already Connected
10086 Bad Password
10087 Bad Value
10234 More Data Required
10487 Bad Pointer
11200 Bad Local Name
12250 Not Connected
12251 Get Drive String Error
12252 Get Network Username Error
12300 Cancel Pressed
12401 Unknown Drive Type
12402 Removeable Drive
12403 Fixed Drive
12404 Network Drive
12405 CDRom Drive
12406 Ram Drive
20000 displaying the connection dialog
20001 displaying the disconnection dialog
20002 adding a new connection
20003 cancelling a connection
20004 getting connection info
20005 getting drive type
20006 getting drive strings
20007 getting the network username

Below is some code for testing - create a new form with one command button

=============================
Option Explicit
Dim WithEvents NetProcs As Networking
Private Sub Command1_Click()
    Const MYPASSWORD = "mypassword"
    Const PATHSEPERATOR = ";"
    Const MYNETPATH = "myservermyshare"
    Const MAPPEDDRIVE = "X:" 'must have colon
    Set NetProcs = New Networking
    With NetProcs
        Debug.Print "Network Drives: (" & .NetDrives(PATHSEPERATOR) & ")"
        Debug.Print "Mapped " & MYNETPATH & " to " & MAPPEDDRIVE & ": (" & 
.NetAddConnection(MYNETPATH, MYPASSWORD, MAPPEDDRIVE) & ")"
        Debug.Print "Network Drives: (" & .NetDrives(PATHSEPERATOR) & ")"
        Debug.Print "Drive Type of " & MAPPEDDRIVE & ": (" & 
.NetDriveType(MAPPEDDRIVE) & ")"
        Debug.Print "Connection Info for " & MAPPEDDRIVE & ": (" & 
.NetConnection(MAPPEDDRIVE) & ")"
        Debug.Print "Removed Connection for " & MAPPEDDRIVE & ": (" & 
.NetCancelConnection(MAPPEDDRIVE) & ")"
        Debug.Print "Network Drives: (" & .NetDrives(PATHSEPERATOR) & ")"
        Debug.Print "Showing Connection Dialog..."
        Debug.Print .NetConnectionDialog(Me.hWnd)
        Debug.Print "Showing Dis-Connection Dialog..."
        Debug.Print .NetDisConnectionDialog(Me.hWnd)
    End With
End Sub

Private Sub NetProcs_NetError(Number As NW.WN_ERRORS, Description As Variant, 
Source As Variant, DuringFunction As Variant, ExtraText As Variant)
    Debug.Print Description
End Sub

=============================
This was first published in October 2000

Dig deeper on .NET Architecture Best Practices

0 comments

Oldest 

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

-ADS BY GOOGLE

SearchCloudComputing

SearchSoftwareQuality

SearchSOA

TheServerSide

SearchCloudApplications

Close