📄 frmdir.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmDir
BorderStyle = 4 'Fixed ToolWindow
ClientHeight = 3720
ClientLeft = 45
ClientTop = 270
ClientWidth = 4515
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3720
ScaleWidth = 4515
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin MSComctlLib.ListView lstv
Height = 1935
Left = 120
TabIndex = 7
Top = 960
Width = 3015
_ExtentX = 5318
_ExtentY = 3413
View = 1
LabelEdit = 1
LabelWrap = 0 'False
HideSelection = 0 'False
FullRowSelect = -1 'True
GridLines = -1 'True
TextBackground = -1 'True
_Version = 393217
Icons = "ImageList1"
SmallIcons = "ImageList1"
ColHdrIcons = "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.TextBox txt
Height = 270
Left = 120
TabIndex = 6
Top = 3240
Width = 3015
End
Begin VB.CommandButton cmd
Cancel = -1 'True
Caption = "取消"
Height = 375
Index = 1
Left = 3360
TabIndex = 2
Top = 1200
Width = 975
End
Begin VB.CommandButton cmd
Caption = "打开(&O)"
Default = -1 'True
Height = 375
Index = 0
Left = 3360
TabIndex = 1
Top = 360
Width = 975
End
Begin MSComctlLib.ImageList ImageList1
Left = 3600
Top = 2520
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 21
ImageHeight = 21
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 3
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDir.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDir.frx":00B0
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmDir.frx":0178
Key = ""
EndProperty
EndProperty
End
Begin VB.ComboBox cmb
Height = 300
Left = 120
TabIndex = 0
Top = 360
Width = 3015
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "文件名(&F):"
Height = 180
Index = 2
Left = 120
TabIndex = 5
Top = 3000
Width = 900
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "数据库(&T):"
Height = 180
Index = 1
Left = 120
TabIndex = 4
Top = 720
Width = 900
End
Begin VB.Label lbl
AutoSize = -1 'True
Caption = "服务器(&S):"
Height = 180
Index = 0
Left = 120
TabIndex = 3
Top = 120
Width = 900
End
End
Attribute VB_Name = "frmDir"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private mCol As Collection
Private mFiles As CDirectory
Private mFileName As String
Private mIsGetServer As Boolean
'Private mCurrentDir As CDirectory
'Private mCurrentFile As Long
'Private mCurrentLocation As Long
Public Function Display(Optional FilePath As String) As String
Dim i As Long
Dim v() As String
' v = MNotes.Servers
' For i = LBound(v) To UBound(v)
' cmb.AddItem v(i)
' Next i
If cmb.ListCount <> 0 Then cmb.ListIndex = 0
Dim strServer As String, strPath As String
On Error GoTo ErrHandler
If FilePath <> "" Then
i = InStr(1, FilePath, "!")
strServer = Left$(FilePath, i - 1)
cmb.Text = strServer
cmb_Click
strPath = Right$(FilePath, Len(FilePath) - i)
v = Split(strPath, "\")
strPath = ""
For i = LBound(v) To UBound(v) - 1
strPath = strPath & v(i) & "\"
OpenDirectory strPath
Next i
i = UBound(v)
strPath = strPath & v(i)
Dim n As ListItem, ns As ListItems
Set ns = Me.lstv.ListItems
If v(i) <> "" Then
'如何不区分大小写*********************************************
Set Me.lstv.SelectedItem = Me.lstv.ListItems.Item(strPath)
Me.txt.Text = strPath
End If
End If
ErrHandler:
Set mCol = New Collection
Me.Show vbModal
Display = mFileName
End Function
Private Sub cmb_Click()
Set mFiles = MNotes.getDirectory(cmb.Text)
OpenDirectory ".."
End Sub
Private Sub cmb_GotFocus()
If Not mIsGetServer Then
Dim v() As String
Dim i As Long
v = MNotes.Servers
For i = LBound(v) To UBound(v)
cmb.AddItem v(i)
Next i
mIsGetServer = True
End If
End Sub
Private Sub cmb_LostFocus()
cmb_Click
End Sub
Private Sub cmd_Click(Index As Integer)
Dim n As ListItem
Set n = lstv.SelectedItem
If n Is Nothing Then Exit Sub
Select Case Index
Case 0
If Right$(n.Key, 1) = "\" Or Right$(n.Key, 2) = ".." Then
OpenDirectory n.Key '如果是文件夹则打开
Else
mFileName = lstv.SelectedItem.Key '否则返回文件名(包含路径)
mFileName = Me.cmb.Text & "!" & mFileName
Unload Me
End If
Case 1
mFileName = ""
Unload Me
Case Else
End Select
End Sub
Private Sub lstv_Click()
Dim i As Long, strFile As String
If Not (lstv.SelectedItem Is Nothing) Then
strFile = lstv.SelectedItem.Key
'i = InStr(1, strFile, "|")
'txt.Text = Left$(strFile, i - 1)
txt.Text = strFile
End If
End Sub
Private Sub lstv_DblClick()
'MsgBox lstv.SelectedItem.Key
cmd_Click 0
End Sub
Private Sub lstv_KeyUp(KeyCode As Integer, Shift As Integer)
lstv_Click
End Sub
'打开子目录
Private Sub OpenDirectory(DirName As String)
'lstv.ListItems.Clear
'lstv.ListItems.Add , , , , 1
'mCurrentLocation = 1
On Error GoTo ErrHandler
Dim i As Long, l As Long, col As Collection
Dim clsdir As CDirectory
If Right$(DirName, 2) <> ".." Then
Set col = mFiles.SubDirectories
Set clsdir = col.Item(LCase(DirName))
Else
'打开当前目录的父目录如果没有则什么都不做
Set clsdir = mFiles.Parent
If clsdir Is Nothing Then
Set clsdir = mFiles
End If
End If
'******************************************
Set mFiles = clsdir
Set col = mFiles.Files
lstv.ListItems.Clear
Set clsdir = mFiles.Parent
If Not (clsdir Is Nothing) Then
lstv.ListItems.Add , mFiles.Text & "..", , , 1
End If
Dim strFile As String, strTitle As String
For i = 1 To col.Count
strFile = col.Item(i)
If strFile <> "" Then
l = InStr(1, strFile, "|")
strTitle = Right$(strFile, Len(strFile) - l)
strFile = Left$(strFile, l - 1)
If strTitle = "" Then strTitle = strFile
'*************************************************
lstv.ListItems.Add , strFile, strTitle, , 3
'*************************************************
End If
Next i
Set col = mFiles.SubDirectories
i = 1
Dim k As Long
For Each clsdir In col
strFile = clsdir.Text
strFile = Left$(strFile, Len(strFile) - 1)
k = InStrRev(strFile, "\")
strFile = Right$(strFile, Len(strFile) - k)
lstv.ListItems.Add , clsdir.Text, strFile, , 2
i = i + 1
Next clsdir
Dim strKey As String
strKey = txt.Text
If Right$(strKey, 1) <> "\" Then
l = Len(strKey)
Else
l = Len(strKey) - 1
End If
strKey = Left$(strKey, l)
If strKey <> Left$(txt.Text, l) And strKey <> "" Then
Set lstv.SelectedItem = lstv.ListItems.Item(strKey)
Me.txt.Text = strKey
Else
Set lstv.SelectedItem = lstv.ListItems.Item(1)
Me.txt.Text = lstv.SelectedItem.Key
End If
ErrHandler:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -