www.pudn.com > virtualdrivemapper.zip > frmMain.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmMain
BorderStyle = 3 'Fixed Dialog
Caption = "vDrive Manager"
ClientHeight = 5055
ClientLeft = 45
ClientTop = 330
ClientWidth = 6975
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5055
ScaleWidth = 6975
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Frame fraMain
BackColor = &H00C0C0C0&
Height = 5175
Left = 0
TabIndex = 0
Top = -120
Width = 6975
Begin VB.CommandButton cmdRem
Caption = "Remove vDrive"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1800
TabIndex = 11
Top = 4680
Width = 1575
End
Begin VB.CommandButton cmdClose
Caption = "&Close"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 5640
TabIndex = 10
Top = 4680
Width = 1215
End
Begin VB.FileListBox flb1
Height = 3210
Hidden = -1 'True
Left = 3360
System = -1 'True
TabIndex = 9
Top = 1200
Width = 3495
End
Begin VB.PictureBox picIco
AutoRedraw = -1 'True
Height = 615
Left = 2400
ScaleHeight = 555
ScaleWidth = 555
TabIndex = 7
Top = 1200
Visible = 0 'False
Width = 615
End
Begin VB.CommandButton cmdRef
Caption = "Refresh"
Height = 375
Left = 4320
TabIndex = 6
Top = 4680
Width = 1215
End
Begin VB.CommandButton cmdCVD
Caption = "Create New vDrive"
Height = 375
Left = 120
TabIndex = 3
Top = 4680
Width = 1575
End
Begin MSComctlLib.ImageList imgList1
Left = 2400
Top = 600
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":1CFA
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3A06
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":3E5A
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":42AE
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmMain.frx":4702
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.TreeView tvwVdrv
Height = 3975
Left = 120
TabIndex = 1
Top = 480
Width = 3135
_ExtentX = 5530
_ExtentY = 7011
_Version = 393217
Indentation = 88
LabelEdit = 1
LineStyle = 1
Style = 7
ImageList = "imgList1"
BorderStyle = 1
Appearance = 1
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = ".::vDrive Files::."
Height = 255
Left = 3360
TabIndex = 8
Top = 960
Width = 3495
End
Begin VB.Label Label2
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = ".::Mapped path::."
Height = 255
Left = 3360
TabIndex = 5
Top = 240
Width = 3495
End
Begin VB.Label lblRpath
BackColor = &H00FFFFFF&
BorderStyle = 1 'Fixed Single
Height = 375
Left = 3360
TabIndex = 4
Top = 480
Width = 3495
End
Begin VB.Label Label1
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = ".::Loaded vDrives::."
Height = 255
Left = 120
TabIndex = 2
Top = 240
Width = 3135
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/////////////////////////////////////////////////////////
'Copyright © 2001 B.O.O.P.S. Inc.
'BOOPS, Based On Other People's Stuff
'We don't code the source you download, we code it better.
'Original only in the synthesis.
'
'This program is based on Ian O'Connor's(oc@lineone.net) vb script file
'"Directory Mapping.vbs" with revisions by Neil Ramsbottom(nramsbottom@hotmail.com).
'It was included in the zip.
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'This being the first release of this project the source has not been optimized.
'When I get around to posting an update the source will be much smaller and run faster.
'But for now it works... I wrote this on my win98 box, I'm to cheap to go out and buy
'W2K when XP is on it's way. And you can forget about ME, multimedia my ass.....
Private R As New cReg
Private m_Path As String
Dim FSO As New Scripting.FileSystemObject
Property Get Path() As String ' the Path currently selected
Path = m_Path
End Property
'/////////////////////////////////////////////////////////
Private Sub Form_Load()
cmdRef_Click
cmdRem.Enabled = False
End Sub
Private Sub cmdCVD_Click()
fraMain.Enabled = False
frmCreate.Show
End Sub
Private Sub cmdRem_Click()
Dim vMsg
vMsg = MsgBox("Remove this vDrive? " & vbCrLf & tvwVdrv.SelectedItem.Text, vbInformation + vbYesNo)
If vMsg = vbYes Then
'Converts, "G:" to "g: /d"
RemDrive LCase(Mid$(tvwVdrv.SelectedItem.Text, 2, 1)) & ": /d"
DoEvents
cmdRef_Click
Else
Exit Sub
End If
End Sub
Private Sub RemDrive(ByVal vRemDrv As String)
Dim wsh, drv As String, numVdrv As String
Set wsh = CreateObject("WScript.Shell")
wsh.Run ("subst " & vRemDrv)
drv = UCase(Left$(vRemDrv, 1)) & ":"
'Remove the vDrive's registry values.
'Starting with the key values then the key itself.
R.DeleteValue &H80000001, "Software\BOOPS\" & drv, "vMap"
R.DeleteValue &H80000001, "Software\BOOPS\" & drv, "vIcon"
R.DeleteKey &H80000001, "Software\BOOPS\" & drv
'Reset the number of vDrives loaded.
numVdrv = R.qVal(&H80000001, "Software\BOOPS", "Loaded")
R.SetKeyValue &H80000001, "Software\BOOPS", "Loaded", numVdrv - 1, REG_SZ
'Delete ascociated vDrive files if found.
If FileExist(tvwVdrv.SelectedItem.Key & "vDrive.ico") Then Kill tvwVdrv.SelectedItem.Key & "\vDrive.ico"
If FileExist(tvwVdrv.SelectedItem.Key & "Autorun.inf") Then Kill tvwVdrv.SelectedItem.Key & "\Autorun.inf"
End Sub
Private Sub cmdRef_Click()
vDirRefresh
lblRpath.Caption = "\\vRoot\"
flb1.Normal = False
flb1.Archive = False
flb1.ReadOnly = False
flb1.System = False
cmdRem.Enabled = False
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Public Sub vDirRefresh()
Dim rootNode As Node, nd As Node
Dim keys() As String, i As Long
Dim numVdrv As String, mapFld As String, vIcon As String
tvwVdrv.Nodes.Clear
'add the "My Virtual Computer" root (expanded)
Set rootNode = tvwVdrv.Nodes.Add(, , "\\vRoot\", "My Virtual Computer", 1)
rootNode.Expanded = True
numVdrv = R.qVal(&H80000001, "Software\BOOPS", "Loaded")
If numVdrv = "0" Then
'No virtual drives are loaded.
Set nd = tvwVdrv.Nodes.Add(rootNode.Key, tvwChild, "\\vRoot\Err404.msg", "No vDrives Loaded.", 4)
Else
keys() = R.EnumRegKeys(&H80000001, "Software\BOOPS")
For i = LBound(keys()) To UBound(keys())
mapFld = R.qVal(&H80000001, "Software\BOOPS\" & keys(i), "vMap")
vIcon = R.qVal(&H80000001, "Software\BOOPS\" & keys(i), "vIcon")
If vIcon = "True" Then
picIco.Picture = LoadPicture(mapFld & "\vDrive.ico")
imgList1.ListImages.Add 5 + i, , picIco.Picture
Set nd = tvwVdrv.Nodes.Add(rootNode.Key, tvwChild, mapFld & "\", "(" & keys(i) & ")", 5 + i)
Else
Set nd = tvwVdrv.Nodes.Add(rootNode.Key, tvwChild, mapFld & "\", "(" & keys(i) & ")", 5)
nd.Bold = True
End If
If err = 0 Then AddDummyChild nd
Next
End If
End Sub
'The following 3 subs are from Microsoft's book "Programming Microsoft Visual Basic 6.0"
Sub AddDummyChild(nd As Node)
' add a dummy child node, if necessary
If nd.Children = 0 Then
' dummy nodes' Text property is "***"
tvwVdrv.Nodes.Add nd.index, tvwChild, , "***"
End If
End Sub
Private Sub tvwVdrv_Expand(ByVal Node As MSComctlLib.Node)
' a node if being expanded
Dim nd As Node
' exit if the node had been already expanded in the past
If Node.Children = 0 Or Node.Children > 1 Then Exit Sub
' also exit if it doesn't have a dummy child node
If Node.Child.Text <> "***" Then Exit Sub
' remove the dummy child item
tvwVdrv.Nodes.Remove Node.Child.index
' add all the subdirs of this Node object
AddSubdirs Node
End Sub
Private Sub AddSubdirs(ByVal Node As MSComctlLib.Node)
' add all the subdirs under a node
Dim fld As Scripting.Folder
Dim nd As Node
' the path in the node is hold in its key property
' cycle on all its subdirectories
For Each fld In FSO.GetFolder(Node.Key).SubFolders
Set nd = tvwVdrv.Nodes.Add(Node, tvwChild, fld.Path, fld.name, 2)
nd.ExpandedImage = 3
' if this directory has subfolders, add a "+" sign
If fld.SubFolders.Count Then AddDummyChild nd
Next
End Sub
Private Sub tvwVdrv_NodeClick(ByVal Node As MSComctlLib.Node)
If tvwVdrv.SelectedItem.Bold = True Then
cmdRem.Enabled = True
Else
cmdRem.Enabled = False
End If
If tvwVdrv.SelectedItem.Key = "\\vRoot\" Then
flb1.Hidden = False
flb1.Normal = False
flb1.Archive = False
flb1.ReadOnly = False
flb1.System = False
ElseIf tvwVdrv.SelectedItem.Key = "\\vRoot\Err404.msg" Then
flb1.Hidden = False
flb1.Normal = False
flb1.Archive = False
flb1.ReadOnly = False
flb1.System = False
cmdRem.Enabled = False
Else
flb1.Path = tvwVdrv.SelectedItem.Key
flb1.Hidden = True
flb1.Normal = True
flb1.Archive = True
flb1.ReadOnly = True
flb1.System = True
End If
lblRpath.Caption = tvwVdrv.SelectedItem.Key
End Sub