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