📄 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 = "虚拟磁盘创建 Ver1.0 "
ClientHeight = 4905
ClientLeft = 150
ClientTop = 435
ClientWidth = 6615
Icon = "frmmain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4905
ScaleWidth = 6615
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton cmdexit
Caption = "退出(&E)"
Height = 350
Left = 4320
TabIndex = 13
Top = 4245
Width = 1215
End
Begin Project1.Line3D Line3D2
Height = 30
Left = 0
TabIndex = 12
Top = 15
Width = 720
_extentx = 1270
_extenty = 53
End
Begin VB.CommandButton cmdabout
Caption = "关于"
Height = 350
Left = 2880
TabIndex = 11
Top = 4245
Width = 1215
End
Begin Project1.Line3D Line3D1
Height = 30
Left = 0
TabIndex = 10
Top = 3960
Width = 1905
_extentx = 3360
_extenty = 53
End
Begin VB.CommandButton cmdbroswe
Caption = "...."
Height = 360
Left = 6060
TabIndex = 9
Top = 495
Width = 420
End
Begin VB.TextBox txtPathName
BeginProperty Font
Name = "Verdana"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 345
Left = 2340
Locked = -1 'True
TabIndex = 8
Top = 510
Width = 3660
End
Begin VB.CheckBox chkrestore
Caption = "在下次Windows启动时复原当前虚拟驱动器."
Height = 285
Left = 165
TabIndex = 6
Top = 3510
Width = 7050
End
Begin VB.ComboBox cbodrives
Height = 315
Left = 120
TabIndex = 4
Top = 510
Width = 1830
End
Begin VB.CommandButton cmddelete
Caption = "删除(&D)"
Enabled = 0 'False
Height = 350
Left = 1455
TabIndex = 3
Top = 4245
Width = 1215
End
Begin MSComctlLib.ImageList ImageList1
Left = 5760
Top = 0
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 16711935
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 1
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmmain.frx":0442
Key = ""
EndProperty
EndProperty
End
Begin MSComctlLib.ListView lstDrives
Height = 2025
Left = 120
TabIndex = 2
Top = 1320
Width = 6360
_ExtentX = 11218
_ExtentY = 3572
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.CommandButton cmdcreate
Caption = "创建(&C)"
Enabled = 0 'False
Height = 350
Left = 75
TabIndex = 1
Top = 4245
Width = 1215
End
Begin VB.Image Image2
Height = 195
Left = 4695
Picture = "frmmain.frx":0554
Top = 225
Width = 240
End
Begin VB.Label Label3
Caption = "虚拟的文件路径"
ForeColor = &H00000000&
Height = 195
Left = 2415
TabIndex = 7
Top = 210
Width = 2280
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "当前在使用的虚拟磁盘."
Height = 180
Left = 120
TabIndex = 5
Top = 1050
Width = 1890
End
Begin VB.Image Image1
Height = 240
Left = 1635
Picture = "frmmain.frx":0657
Top = 180
Width = 240
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "可分配的磁盘"
Height = 180
Left = 120
TabIndex = 0
Top = 210
Width = 1080
End
Begin VB.Menu mnufile
Caption = "文件(&F)"
Begin VB.Menu mnuexit
Caption = "退出(&E)"
End
End
Begin VB.Menu mnuabout
Caption = "关于(&A)"
End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/04/08
'描 述：创建虚拟磁盘
'网 站：http://www.mndsoft.com
'e-mail：mnd@mndsoft.com/blog/
'OICQ : 88382850
'****************************************************************************
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long
Public AbsPath As String
Public AbsRoot As String
Dim mOld As String
Private Function SetUpVDrives() As Long
Dim Counter As Integer, iWait As Long
Dim mCount As String, Strln As String, mDrive As String, mPath As String, vData As Variant
mCount = CInt(Val(GetSetting("dmVDriveC", "Config", "Count")))
If mCount = 0 Then Exit Function ' we exit if nothing found
ChDir AbsRoot ' 改变默认到系统根目录 C:\
For Counter = 1 To mCount
Strln = GetSetting("dmVDriveC", "Config", "Drives" & Counter)
vData = Split(Strln, "=>")
mDrive = Mid(vData(0), 1, 2) ' 压缩驱动器
mPath = vData(1) ' 压缩路径
iWait = Shell("command.com /c" & "subst " & mDrive & " " & mPath, vbHide) '执行
SHWait iWait '等待执行
DoEvents
Next
SetUpVDrives = 1
' 清除旧的数据
Erase vData
Counter = 0
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -