Virtual Drive

Here is all that you need to know to create a virtual CD program. First create a module and insert the following code.

Public Type BrowseInfo
   lngHwnd As Long
   pIDLRoot As Long
   pszDisplayName As Long
   lpszTitle As Long
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type

Public Const MAX_PATH = 260

Declare Sub CoTaskMemFree Lib "ole32.dll" _
(ByVal hMem As Long)

Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long

Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long

Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, ByVal lpBuffer As String) As Long

Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Global Drives(1 To 26) As String

Public Function BrowseForFolder(ByVal lngHwnd As Long, ByVal strPrompt As String) As String

   On Error GoTo ehBrowseForFolder 'Trap for errors
   Dim intNull As Integer
   Dim lngIDList As Long, lngResult As Long
   Dim strPath As String
   Dim udtBI As BrowseInfo
   'Set API properties (housed in a UDT)
   With udtBI
       .lngHwnd = lngHwnd
       .lpszTitle = lstrcat(strPrompt, "")
   End With
   'Display the browse folder...
   lngIDList = SHBrowseForFolder(udtBI)
   If lngIDList <> 0 Then
       'Create string of nulls so it will fill in with the path
       strPath = String(MAX_PATH, 0)
       'Retrieves the path selected, places in the null
       'character filled string
       lngResult = SHGetPathFromIDList(lngIDList, strPath)
       'Frees memory
       Call CoTaskMemFree(lngIDList)
       'Find the first instance of a null character,
       'so we can get just the path
       intNull = InStr(strPath, vbNullChar)
       'Greater than 0 means the path exists...
       If intNull > 0 Then
           'Set the value
           strPath = Left(strPath, intNull - 1)
       End If
   End If
   'Return the path name
   BrowseForFolder = strPath
   Exit Function 'Abort
   'Return no value
   BrowseForFolder = Empty

End Function

Sub SetDrives()
Drives(1) = "a:"
Drives(2) = "b:"
Drives(3) = "c:"
Drives(4) = "d:"
Drives(5) = "e:"
Drives(6) = "f:"
Drives(7) = "g:"
Drives(8) = "h:"
Drives(9) = "i:"
Drives(10) = "j:"
Drives(11) = "k:"
Drives(12) = "l:"
Drives(13) = "m:"
Drives(14) = "n:"
Drives(15) = "o:"
Drives(16) = "p:"
Drives(17) = "q:"
Drives(18) = "r:"
Drives(19) = "s:"
Drives(20) = "t:"
Drives(21) = "u:"
Drives(22) = "v:"
Drives(23) = "w:"
Drives(24) = "x:"
Drives(25) = "y:"
Drives(26) = "z:"
End Sub

'end module code

Then, add the following code to a form.

Sub MountVirtualDrive(strVirtualDrive, strPhysicPath)
Shell "subst.exe " & strVirtualDrive & Chr(32) & strPhysicPath, vbHide
End Sub

Sub UnMountVirtualDrive(strVirtualDrive)
Shell "subst.exe " & strVirtualDrive & " /d", vbHide
End Sub
'end form code

Now all that you have to do to add a virtual drive is call MountVirtualDrive("g:","g:\my mounted folder"). To remove a virtual drive just do UnMountVirtualDrive("f:")

You might also like...




Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“Programs must be written for people to read, and only incidentally for machines to execute.”