📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "虚拟光驱系统"
ClientHeight = 5145
ClientLeft = 45
ClientTop = 330
ClientWidth = 9795
Icon = "Form1.frx":0000
MaxButton = 0 'False
ScaleHeight = 343
ScaleMode = 3 'Pixel
ScaleWidth = 653
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox pic
AutoRedraw = -1 'True
BackColor = &H00FF0000&
BorderStyle = 0 'None
Height = 480
Left = 120
ScaleHeight = 480
ScaleWidth = 480
TabIndex = 21
Top = 5280
Width = 480
End
Begin VB.CommandButton Command1
Caption = "退出"
Height = 375
Left = 8280
TabIndex = 3
Tag = "Exit this screen."
Top = 4680
Width = 1455
End
Begin VB.Frame Frame2
Caption = "系统提示"
Height = 4575
Left = 5840
TabIndex = 1
Top = 0
Width = 3855
Begin VB.Label Label12
Caption = $"Form1.frx":08CA
BeginProperty Font
Name = "宋体"
Size = 8.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00004000&
Height = 1095
Left = 120
TabIndex = 19
Top = 1200
Width = 3495
End
Begin VB.Label Label11
Height = 255
Left = 120
TabIndex = 18
Top = 1200
Width = 3495
End
Begin VB.Label Label10
Height = 15
Left = 120
TabIndex = 17
Top = 1320
Width = 3615
End
Begin VB.Label Label9
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 135
Left = 120
TabIndex = 16
Top = 1080
Width = 3615
End
Begin VB.Label Label8
Caption = "在需要创建虚拟光驱的目录上，右键单击，在弹出的菜单中选择【Create Virtual Drive】。"
BeginProperty Font
Name = "宋体"
Size = 8.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 615
Left = 120
TabIndex = 15
Top = 480
Width = 3255
End
Begin VB.Label Label7
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 135
Left = 120
TabIndex = 14
Top = 600
Width = 3615
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "用户可以通过以下方法添加虚拟目录："
Height = 180
Left = 120
TabIndex = 13
Top = 240
Width = 3615
WordWrap = -1 'True
End
Begin VB.Label Label4
Alignment = 2 'Center
BackStyle = 0 'Transparent
ForeColor = &H000000FF&
Height = 255
Left = 240
TabIndex = 6
Top = 3480
Width = 3375
End
Begin VB.Label Label3
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "forway@zj.com"
ForeColor = &H00FF0000&
Height = 255
Left = 240
TabIndex = 5
Top = 3240
Width = 3375
End
Begin VB.Label Label2
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0E0FF&
BorderStyle = 1 'Fixed Single
Caption = "Modified by ForWay"
BeginProperty Font
Name = "Arial"
Size = 8.25
Charset = 178
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 735
Left = 120
TabIndex = 4
Top = 3000
Width = 3615
End
Begin VB.Label Label1
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H0080FFFF&
BorderStyle = 1 'Fixed Single
Caption = "Current Tool Quick Tip"
ForeColor = &H00FF0000&
Height = 615
Left = 120
TabIndex = 2
Top = 3840
Width = 3615
End
End
Begin VB.Frame Frame1
Caption = "虚拟光驱"
Height = 5055
Left = 120
TabIndex = 0
Top = 0
Width = 5655
Begin TVDRV2003.ImList ImList1
Height = 4695
Left = 120
TabIndex = 22
Top = 240
Width = 3855
_extentx = 6800
_extenty = 8281
titlecolor = 255
tipcolor = 16761024
backcolor = 16711680
titlefont = "Form1.frx":0983
tipfont = "Form1.frx":09A9
titlecolor = 255
tipcolor = 16761024
titlefont = "Form1.frx":09CF
tipfont = "Form1.frx":09F5
End
Begin VB.CommandButton Command6
Caption = "自动运行"
Enabled = 0 'False
Height = 375
Left = 4080
TabIndex = 11
Tag = "Change Selected Virtual Drive Autorun, which will run automatically when you double click it."
Top = 2280
Width = 1455
End
Begin VB.CommandButton Command5
Caption = "改变图标"
Height = 375
Left = 4080
TabIndex = 10
Tag = "Change Selected Virtual Drive's Icon"
Top = 1800
Width = 1455
End
Begin VB.CommandButton Command4
Caption = "修改路径"
Height = 375
Left = 4080
TabIndex = 9
Tag = "Change Selected Virtual Drive's Path Which Connected With."
Top = 1320
Width = 1455
End
Begin VB.CommandButton Command3
Caption = "删除"
Height = 375
Left = 4080
TabIndex = 8
Tag = "Remove Selected Virtual Drive."
Top = 720
Width = 1455
End
Begin VB.CommandButton Command2
Caption = "添加"
Height = 375
Left = 4080
TabIndex = 7
Tag = "Add a new virtual drive. only select the path."
Top = 240
Width = 1455
End
Begin VB.Label Label13
Caption = " "
Height = 2175
Left = 4080
TabIndex = 20
Top = 2760
Width = 1455
End
End
Begin VB.Label Label5
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "Ready"
ForeColor = &H80000008&
Height = 255
Left = 5840
TabIndex = 12
Top = 4680
Width = 2295
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Const MAX_PATH = 260
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SYSICONINDEX = &H4000
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1 ' get small icon
Private Const ILD_TRANSPARENT = &H1
Private Type SHFILEINFO 'Structure used by SHGetFileInfo
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
'Get File Informatio,
'We Use It to get the Icon of the drive
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
'Draw the Icon On the Picture
Private Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl&, ByVal I&, ByVal hDCDest&, ByVal x&, ByVal Y&, ByVal Flags&) As Long
'Draw the Icon On the Picture
Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
'Delete Icon Resource From The Memory
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
'Get the Logical Drives Letters on the system
Private Declare Function GetLogicalDrives Lib "Kernel32" () As Long
'Get The String Provides Us with the logical drives
Private Declare Function GetLogicalDriveStrings Lib "Kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'get windows Path
Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private shinfo As SHFILEINFO
Public TokenDrives As New Collection, FreeDrives As New Collection 'Vars
Private mCommand As String 'Private variable for the CommandLine property
Private mOutputs As String 'Private variable for the ReadOnly Outputs property
Public MySubSt As String
'/////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////
'A:Z = 65:90 ascii codes
'/////////////////////////////////////////////////////////
'Function to add a drive only into our imagged list.
Function AddDrive(sDrive As String, Title As String, Path As String)
'wait for the drive
DoEvents
Dim hIcon, himl As Long
'get the drive Icon
himl = SHGetFileInfo(sDrive, 0&, shinfo, Len(shinfo), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON)
'Clear Temporary Picture which will recive the picture of the drive
pic.Cls
'drawing the picture of the drive
ImageList_Draw himl, shinfo.iIcon, pic.hdc, 0, 0, ILD_TRANSPARENT
pic.Refresh
'wait for completing
DoEvents
'Empty Resources
DestroyIcon shinfo.iIcon
'add to ImList1
ImList1.AddItem Title, Path, "Related To " & Left$(Path, 2), , pic.Image
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -