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

《vb编写文件管理器设计方案.docx》由会员分享，可在线阅读，更多相关《vb编写文件管理器设计方案.docx（20页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

1、vb编写文件管理器设计方案 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 S

2、ingle, c11 As Single, c12 As Single, c13 As Single, c14 As Single, fname21 As String Private Sub chongmingming_Click() Dim newname As String, retempdir As String, lenfile As Integer, oldname As String e = InputBox(重命名, 输入新名字) If e = Then MsgBox 名称不为空 Exit Sub End If If File1.FileName = Then 文件夹重命名 I

3、f File1.Path Then 获得上级目录 retempdir = File1.Path lenfile = Len(retempdir) Do While Right$(retempdir, 1) 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

4、 = retempdir & e Name oldname As newname If CurDir Then 返回上级目录 abc = CurDir lenfile = Len(abc) Do While lenfile 1 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) Loop Dir1.Path = abc

5、ChDir Dir1.Path End If 返回上级目录 Exit Sub hand: MsgBox 文件不可重命名 文件夹重命名 End If If File1.FileName Then 文件重命名 If Right(File1.Path, 1) = Then fname21 = File1.Path & File1.FileName Else fname21 = File1.Path & & File1.FileName End If If fname21 Then 获得上级目录retempdir = fname21 lenfile = Len(retempdir) Do While

6、Right$(retempdir, 1) If Right$(retempdir, 1) = : Then retempdir = retempdir & End If retempdir = Left$(retempdir, lenfile - 1) lenfile = Len(retempdir) Loop End If 获得上级目录 oldname = fname21 newname = retempdir & e On Error GoTo hand1 Name oldname As newname If CurDir Then retempdir = CurDir lenfile =

7、 Len(retempdir) Do While lenfile 1 If Right$(retempdir, 1) = Then retempdir = Left$(retempdir, lenfile - 1) If Right$(retempdir, 1) = : Then retempdir = retempdir & End If Exit Do End If retempdir = Left$(retempdir, lenfile - 1) lenfile = Len(retempdir) Loop Dir1.Path = retempdir ChDir Dir1.Path End

8、 If Exit Sub hand1: MsgBox 文件重名不可重命名 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 Combo1.SelLength = Len(Combo1.Text) End If Exit Sub hand4: MsgBox 输入不合法 End Sub Private Sub Command1_Cl

9、ick() On Error GoTo hand File1.Pattern = Text1.Text Text1.SelStart = 0 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)

10、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() Dim retval Dim Fname As String On Error GoTo hand If Right(File1.Path, 1) = Then Fname = File1.Path & File1.FileName Else Fname = Fil

11、e1.Path & & File1.FileName 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) If Button = 2 Then PopupMenu bianji End If End Sub Private Sub Form_Load() Label2.Visible = False Text1.Vis

12、ible = False Command1.Visible = False Combo1.AddItem *.bmp 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 b11 = Command1.Height b12 = Command1.Left b13 = Command1.Width b14 = Command1.Top c

13、11 = Text1.Height c12 = Text1.Left c13 = Text1.Width c14 = Text1.Top End Sub 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 File1.Width = a13 * j File1.Top = a14 * k Dir1.

14、Height = 1770 * k Dir1.Left = 480 * j Dir1.Width = 3015 * j Dir1.Top = 1320 * k Command1.Height = b11 * k Command1.Left = b12 * j 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 Label2.Left

15、= 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 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 = 84

16、0 * k 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 Dim Fname As String If Right(File1.Path, 1) = And File1.FileName Then Fname = File1.Path & File1.FileName Else Fname = Fi

17、le1.Path & & File1.FileName 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 Fname = File1.Path & File1.FileName Else Fname = File1.Path & & File1.FileName End If If File1.FileName = Then On Error GoT

18、o hand RmDir (File1.Path) If CurDir Then retempdir = CurDir lenfile = Len(retempdir) Do While lenfile 1 If Right$(retempdir, 1) = Then retempdir = Left$(retempdir, lenfile - 1) If Right$(retempdir, 1) = : Then retempdir = retempdir & End If Exit Do End If retempdir = Left$(retempdir, lenfile - 1) le

19、nfile = Len(retempdir) Loop Dir1.Path = retempdir ChDir Dir1.Path End If Exit Sub hand: MsgBox 文件夹下有子文件 End If If File1.FileName Then Kill (Fname) End If File1.Refresh End Sub Private Sub sousuo_Click() Label2.Visible = Not Label2.Visible Text1.Visible = Not Text1.Visible Command1.Visible = Not Comm

20、and1.Visible End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) On Error GoTo hand4 If KeyAscii = 13 Then File1.Pattern = Text1.Text Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End If Exit Sub hand4: MsgBox 输入不合法 End Sub Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Butt

21、on) If Button.Index = 1 Then d = InputBox(新建文件夹, 输入新建文件夹的名称) If d Then On Error GoTo hand MkDir (File1.Path & & d) End If If d = Then MsgBox 文件名不为空 End If Dir1.Refresh Exit Sub hand: MsgBox 有相同文件名不可创建 End If If Button.Index = 2 Then If File1.FileName = Then MsgBox 本地文件夹不可复制 End If If File1.FileName

22、Then Dim Fname1 As String If Right(File1.Path, 1) = And File1.FileName Then Fname1 = File1.Path & File1.FileName Else Fname1 = File1.Path & & File1.FileName End If m = Fname1 p = File1.FileName End If End If If Button.Index = 3 Then On Error GoTo hand31 Source = m 指定源文件名。 DestinationFile = File1.Pat

23、h & & p 指定目的文件名。 FileCopy Source, DestinationFile 将源文件的内容复制到目的文件中。If CurDir Then 返回上级目录 abc = CurDir lenfile = Len(abc) Do While lenfile 1 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(a

24、bc) Loop Dir1.Path = abc ChDir Dir1.Path End If 返回上级目录 Exit Sub hand31: MsgBox 有相同文件名不可复制 End If If Button.Index = 4 Then Dim Fname As String If Right(File1.Path, 1) = And File1.FileName Then Fname = File1.Path & File1.FileName Else Fname = File1.Path & & File1.FileName End If If File1.FileName = Th

25、en On Error GoTo hand4 RmDir (File1.Path) If CurDir Then retempdir = CurDir lenfile = Len(retempdir) Do While lenfile 1 If Right$(retempdir, 1) = Then retempdir = Left$(retempdir, lenfile - 1) If Right$(retempdir, 1) = : Then retempdir = retempdir & End If Exit Do End If retempdir = Left$(retempdir,

26、 lenfile - 1) lenfile = Len(retempdir) Loop Dir1.Path = retempdir ChDir Dir1.Path End If Exit Sub hand4: MsgBox 文件夹下有子文件 End If If File1.FileName Then Kill (Fname) End If File1.Refresh End If If Button.Index = 5 Then Label2.Visible = Not Label2.Visible Text1.Visible = Not Text1.Visible Command1.Visi

27、ble = Not Command1.Visible If KeyAscii = 13 Then File1.Pattern = Text1.Text Text1.SelStart = 0 Text1.SelLength = Len(Text1.Text) End If End If End Sub Private Sub tuichu_Click() End End Sub Private Sub xinjian_Click() d = InputBox(新建文件夹, 输入新建文件夹的名称) If d Then On Error GoTo hand MkDir (File1.Path & & d) End If If d = Then MsgBox 文件名不为空 End If Dir1.Refresh Exit Sub hand: MsgBox 有相同文件名不可创建 End Sub Private Sub zhantie_Click()