📄 frmmain.frm
字号:
VERSION 5.00
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Fake Drive 0.1b"
ClientHeight = 6420
ClientLeft = 45
ClientTop = 330
ClientWidth = 4230
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6420
ScaleWidth = 4230
StartUpPosition = 1 'CenterOwner
Begin VB.ComboBox Combo1
Height = 315
Left = 360
TabIndex = 11
Top = 4680
Width = 495
End
Begin VB.DirListBox Dir1
Height = 2115
Left = 240
TabIndex = 8
Top = 1080
Width = 3735
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 240
TabIndex = 7
Top = 360
Width = 2055
End
Begin VB.Frame Frame1
Height = 2655
Left = 120
TabIndex = 0
Top = 3360
Width = 3975
Begin VB.CommandButton Command3
Caption = "&Exit"
Height = 375
Left = 2640
TabIndex = 6
Top = 2040
Width = 1095
End
Begin VB.TextBox Text1
Height = 285
Left = 240
TabIndex = 5
Top = 600
Width = 3495
End
Begin VB.CommandButton Command2
Caption = "&Delete Drive"
Height = 375
Left = 1440
TabIndex = 4
Top = 2040
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "&Create Drive"
Height = 375
Left = 240
TabIndex = 3
Top = 2040
Width = 1095
End
Begin VB.Line Line2
BorderColor = &H00FFFFFF&
X1 = 240
X2 = 3720
Y1 = 1920
Y2 = 1920
End
Begin VB.Line Line1
BorderColor = &H80000003&
BorderWidth = 2
X1 = 240
X2 = 3720
Y1 = 1920
Y2 = 1920
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "New Drive Letter:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 240
TabIndex = 2
Top = 1080
Width = 1515
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Folder Path:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 240
TabIndex = 1
Top = 360
Width = 1050
End
End
Begin VB.Label Label5
Caption = "(C) 2001 Mahatab-ur-Rashid"
Height = 255
Left = 120
TabIndex = 12
Top = 6120
Width = 3975
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "Select Folder:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 240
TabIndex = 10
Top = 840
Width = 1200
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "Select drive:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Left = 240
TabIndex = 9
Top = 120
Width = 1095
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===================================================================
' FAKE DRIVE
' -Mahatab-ur-Rashid [2001]
'===================================================================
' E-mail: mahatabur@yahoo.com
' Web site: http://www15.brinkster.com/mahatabur
'===================================================================
'NOTE: This is only a few lines of code, so I did not rename any
' Control in this projrct.
'
' I used DOS "Subst" command to creat virtual drive.
'
'-------------------------------------------------------------------
'SUBST Command reference
'-------------------------------------------------------------------
' Associates a path with a drive letter.
' subst [drive1: [drive2:]path]
' subst drive1: /d
' Parameters
' none
' Used without parameters, subst displays the names of the virtual drives in effect.
' drive1:
' Specifies the virtual drive to which you want to assign a path.
' drive2:
' Specifies the physical drive that contains the specified path (if different from the current drive).
' Path
' Specifies the path that you want to assign to a virtual drive.
' /d
' Deletes a virtual drive.
'===================================================================
'
' I hope beginner vb developer will love it.
' Enjoy!
'
'===================================================================
Private Sub Command1_Click()
'====================================================================
' We will code here with some trick. Look below, when a error in line
' Path = CurDir(Combo1.Text & ":") ,we creat a virtual drive.
' That means there is no such drive which user assign.
'====================================================================
On Error GoTo Action
Path = CurDir(Combo1.Text & ":") ' Is drive available, If not (It means error occurs)
' then we can now creat a vartual or Fake drive.
' Look in Error ( Action: ) section below
ChDir (Text1.Text) ' Check for valid path, If not valid path then error
' occurs
If Text1.Text = "" Then
MsgBox "Please Enter a Path", vbExclamation, "Select or Enter a Path"
Text1.SetFocus
Exit Sub
End If
MsgBox Combo1.Text & ":" & " Drive is already exist!", vbInformation, "Choose other Drive"
Action:
If Err.Number = 76 Then ' Text1.Text does not contain a valid path
MsgBox Err.Description, vbInformation, "Enter a valid path"
Exit Sub
End If
If Err.Number <> 0 Then ' Ok, error occurs in, Path = CurDir(Combo1.Text & ":") Line
' That means no such drive exist... so we can creat now
' a vartual drive with user assigned name
Path = Combo1.Text & ": " & Text1.Text
Shell "Subst " & Path, vbHide ' Shell command is using for execute a file named Subst (Come with DOS)
' With DOS Subst command we are creating a virtual drive
MsgBox "Fake folder is ready", vbInformation, "Fake Folder 0.1b"
End If
End Sub
Private Sub Command2_Click()
If Combo1.Text = "" Then
MsgBox "Please Select a drive letter", vbExclamation, "Select a Drive letter"
Exit Sub
End If
Shell "Subst " & Combo1.Text & ": /d" ' Deleting Fake drive
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Dir1_Change()
Text1.Text = Dir1.Path
End Sub
Private Sub Drive1_Change()
On Error GoTo ErrHnd
Dir1.Path = Drive1.Drive
ErrHnd:
If Err.Number <> 0 Then
MsgBox Err.Description, vbCritical, " ERROR!"
End If
End Sub
Private Sub Form_Load()
Text1.Text = Dir1.Path ' Store "A" to "Z" characters in Combo1
For i = 65 To (65 + 25)
Combo1.AddItem Chr(i)
Next i
Combo1.ListIndex = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -