vb编写文件管理器设计方案

Text1.SelLength = Len(Text1.Text)
hand:
MsgBox "输入不合法"
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
File1.Path = Dir1.Path
End Sub
Private Sub Dir1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Right$(abc, 1) = "\" Then
abc = Left$(abc, lenfile - 1)
If Right$(abc, 1) = ":" Then
abc = abc & "\"
End If
Exit Do
End If
abc = Left$(abc, lenfile - 1)
lenfile = Len(abc)
Fname = File1.Path & File1.FileName
Else
Fname = File1.Path & "\" & File1.FileName
End If
If File1.FileName = "" Then
fname21 = File1.Path & File1.FileName
Else
fname21 = File1.Path & "\" & File1.FileName
End If
If fname21 <> "" Then '获得上级目录
retempdir = fname21
lenfile = Len(retempdir)
End If
End Sub '文件重命名
Private Sub Combo1_KeyPress(KeyAscii As Integer)
On Error GoTo hand4
If KeyAscii = 13 Then
File1.Pattern = Combo1.Text
Combo1.SelStart = 0
b11 = Command1.Height
b12 = Command1.Left
b13 = Command1.Width
b14 = Command1.Top
c11 = Text1.Height
c12 = Text1.Left
c13 = Text1.Width
c14 = Text1.Top
End Sub
If Button = 2 Then
PopupMenu bianji
End If
End SubHale Waihona Puke Baidu
Private Sub Form_Load()
Label2.Visible = False
Text1.Visible = False
Command1.Visible = False
Combo1.AddItem "*.bmp"
Loop
Dir1.Path = abc
ChDir Dir1.Path
End If '返回上级目录
Exit Sub
hand:
MsgBox "文件不可重命名" '文件夹重命名
End If
If File1.FileName <> "" Then '文件重命名
If Right(File1.Path, 1) = "\" Then
If Right$(retempdir, 1) = ":" Then
retempdir = retempdir & "\"
End If
retempdir = Left$(retempdir, lenfile - 1)
lenfile = Len(retempdir)
Loop
End If '获得上级目录
On Error GoTo hand
oldname = File1.Path
newname = retempdir & e
Name oldname As newname
If CurDir <> "" Then '返回上级目录
abc = CurDir
lenfile = Len(abc)
Do While lenfile <> 1
Combo1.SelLength = Len(Combo1.Text)
End If
Exit Sub
hand4:
MsgBox "输入不合法"
End Sub
Private Sub Command1_Click()
On Error GoTo hand
File1.Pattern = Text1.Text
Text1.SelStart = 0
Do While lenfile <> 1
If Right$(retempdir, 1) = "\" Then
retempdir = Left$(retempdir, lenfile - 1)
If Right$(retempdir, 1) = ":" Then
retempdir = retempdir & "\"
Do While Right$(retempdir, 1) <> "\"
If Right$(retempdir, 1) = ":" Then
retempdir = retempdir & "\"
End If
retempdir = Left$(retempdir, lenfile - 1)
lenfile = Len(retempdir)
Label2.Left = 2880 * j
Label2.Width = 975 * j
Label2.Top = 4320 * k
Label3.Height = 255 * k
Label3.Left = 1320 * j
Label3.Width = 1335 * j
Label3.Top = 3600 * k
If Button = 2 Then
PopupMenu wenjian
End If
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_DblClick()
Combo1.AddItem "*.txt"
Combo1.AddItem "*.doc"
Combo1.AddItem "*.*"
w = Me.Width
h = Me.Height
a11 = File1.Height
a12 = File1.Left
a13 = File1.Width
a14 = File1.Top
Dim retval
Dim Fname As String
On Error GoTo hand
If Right(File1.Path, 1) = "\" Then
Fname = File1.Path & File1.FileName
Else
Fname = File1.Path & "\" & File1.FileName
End If
Exit Do
End If
retempdir = Left$(retempdir, lenfile - 1)
lenfile = Len(retempdir)
Loop
Dir1.Path = retempdir
ChDir Dir1.Path
End If
Exit Sub
hand1:
MsgBox "文件重名不可重命名"
Dim Fname As String
If Right(File1.Path, 1) = "\" And File1.FileName <> "" Then
Fname = File1.Path & File1.FileName
Else
Fname = File1.Path & "\" & File1.FileName
MsgBox "名称不为空"
Exit Sub
End If
If File1.FileName = "" Then '文件夹重命名
If File1.Path <> "" Then '获得上级目录
retempdir = File1.Path
lenfile = Len(retempdir)
Do While Right$(retempdir, 1) <> "\"
Private Sub guanbi_Click()
End
End Sub
Private Sub Form_Resize()
Dim j As Single
Dim k As Single
j = Me.Width / w
k = Me.Height / h
File1.Height = a11 * k
File1.Left = a12 * j
Private Sub chongmingming_Click()
Dim newname As String, retempdir As String, lenfile As Integer, oldname As String
e = InputBox("重命名", "输入新名字")
If e = "" Then
End If
retval = Shell(Fname, 1) '执行程序
Exit Sub
hand:
MsgBox "该文件非可执行文件"
End Sub
Private Sub File1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
File1.Width = a13 * j
File1.Top = a14 * k
Dir1.Height = 1770 * k
Dir1.Left = 480 * j
Dir1.Width = 3015 * j
Dir1.Top = 1320 * k
Command1.Height = b11 * k
Command1.Left = b12 * j
End If
m = Fname
p = File1.FileName
End If
End Sub
Private Sub shanchu_Click()
Dim Fname As String
If Right(File1.Path, 1) = "\" And File1.FileName <> "" Then
Loop
End If '获得上级目录
oldname = fname21
newname = retempdir & e
On Error GoTo hand1
Name oldname As newname
If CurDir <> "" Then
retempdir = CurDir
lenfile = Len(retempdir)
VB语言编写文件资源管理器
一、程序内部结构图
图1
图2
图3
图4
二、添加的对象名称
图5
图6
图7
图8
三、下方为本程序代码
Dim m As String, p As String, SourceFile As String, DestinationFile As String, w As Single, h As Single, a11 As Single, a12 As Single, a13 As Single, a14 As Single, b11 As Single, b12 As Single, b13 As Single, b14 As Single, c11 As Single, c12 As Single, c13 As Single, c14 As Single, fname21 As String
Combo1.Left = 1200 * j
Combo1.Width = 1935 * j
Combo1.Top = 3960 * k
End Sub
Private Sub fuzhi_Click()
If File1.FileName = "" Then
MsgBox "文件夹不可复制"
End If
If File1.FileName <> "" Then
Command1.Width = b13 * j
Command1.Top = b14 * k
Text1.Height = c11 * k
Text1.Left = c12 * j
Text1.Width = c13 * j
Text1.Top = c14 * k
Label2.Height = 255 * k
Label1.Height = 375 * k
Label1.Left = 240 * j
Label1.Width = 495 * j
Label1.Top = 840 * k
Drive1.Left = 840 * j
Drive1.Width = 5895 * j
Drive1.Top = 840 * k