form4.frm

模拟文件管理系统

VERSION 5.00
Begin VB.Form Form4 
   BackColor       =   &H00FFC0FF&
   Caption         =   "文件浏览器"
   ClientHeight    =   6795
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8460
   LinkTopic       =   "Form4"
   ScaleHeight     =   6795
   ScaleWidth      =   8460
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command2 
      Caption         =   "返回"
      Height          =   495
      Left            =   3360
      TabIndex        =   18
      Top             =   4560
      Width           =   1335
   End
   Begin VB.Frame frame1 
      Caption         =   "源文件"
      Height          =   6135
      Left            =   240
      TabIndex        =   9
      Top             =   240
      Width           =   2775
      Begin VB.DriveListBox Drive1 
         Height          =   300
         Left            =   120
         TabIndex        =   12
         Top             =   360
         Width           =   2415
      End
      Begin VB.DirListBox Dir1 
         Height          =   1560
         Left            =   120
         TabIndex        =   11
         Top             =   840
         Width           =   2415
      End
      Begin VB.FileListBox File1 
         Height          =   2970
         Left            =   120
         TabIndex        =   10
         Top             =   2640
         Width           =   2415
      End
   End
   Begin VB.Frame Frame2 
      Height          =   5895
      Left            =   3120
      TabIndex        =   8
      Top             =   360
      Width           =   1815
      Begin VB.CommandButton Command4 
         Caption         =   "退出"
         Height          =   495
         Left            =   240
         TabIndex        =   19
         Top             =   5040
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "复制"
         Height          =   495
         Index           =   1
         Left            =   240
         TabIndex        =   17
         Top             =   1080
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "移动"
         Height          =   495
         Index           =   2
         Left            =   240
         TabIndex        =   16
         Top             =   1800
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "删除"
         Height          =   495
         Index           =   3
         Left            =   240
         TabIndex        =   15
         Top             =   2640
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "更名"
         Height          =   495
         Index           =   4
         Left            =   240
         TabIndex        =   14
         Top             =   3360
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "属性"
         Height          =   495
         Index           =   0
         Left            =   240
         TabIndex        =   13
         Top             =   360
         Width           =   1335
      End
   End
   Begin VB.Frame frame3 
      Caption         =   "目标文件"
      Height          =   6015
      Left            =   5160
      TabIndex        =   4
      Top             =   240
      Width           =   3135
      Begin VB.DriveListBox Drive2 
         Height          =   300
         Left            =   240
         TabIndex        =   7
         Top             =   360
         Width           =   2535
      End
      Begin VB.DirListBox Dir2 
         Height          =   1560
         Left            =   240
         TabIndex        =   6
         Top             =   840
         Width           =   2535
      End
      Begin VB.FileListBox File2 
         Height          =   3150
         Left            =   240
         TabIndex        =   5
         Top             =   2640
         Width           =   2655
      End
   End
   Begin VB.CommandButton Command1 
      Caption         =   "复制"
      Height          =   495
      Index           =   1
      Left            =   3360
      TabIndex        =   3
      Top             =   1680
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "更名"
      Height          =   495
      Index           =   4
      Left            =   3360
      TabIndex        =   2
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "删除"
      Height          =   495
      Index           =   3
      Left            =   3360
      TabIndex        =   1
      Top             =   3360
      Width           =   1335
   End
   Begin VB.CommandButton Command1 
      Caption         =   "移动"
      Height          =   495
      Index           =   2
      Left            =   3360
      TabIndex        =   0
      Top             =   2520
      Width           =   1335
   End
End
Attribute VB_Name = "Form4"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fso As New FileSystemObject, drv As Drive
Dim fldr As Folder, fil As File, s As String

Private Sub Command2_Click()
Form4.Hide
Form1.Show
End Sub

Private Sub Command3_Click(Index As Integer)
On Error GoTo errorhandler
Set drv = fso.GetDrive(Drive1.Drive)
Select Case Index
  Case 0:
    Set fil = fso.GetFile(File1.FileName)
    msg = "最后修改日期:" & fil.DateLastModified & Chr(13)
    msg = msg & "文件名：" & fil.Name & Chr(13)
    msg = msg & "文件长度：" & fil.Size & Chr(13)
    msg = msg & "文件类型：" & fil.Type & Chr(13)
    MsgBox msg, , "文件管理器"
 Case 1:
     Set fil = fso.GetFile(File1.FileName)
     fil.Copy IIf(Right(Dir2.Path, 1) = "\", Dir2.Path, Dir2.Path & "\")
 Case 2:
     Set fil = fso.GetFile(File1.FileName)
     If Drive1.Drive <> Drive2.Drive Then
     MsgBox "不能在不同的驱动器之间移动", 48, "移动"
     Else
      fil.Move IIf(Right(Dir2.Path, 1) = "\", Dir2.Path, Dir2.Path & "\")
      End If
   Case 3:
     Set fil = fso.GetFile(File1.FileName)
     msg = "真的要删除文件吗？" & Chr(13) & Chr(13)
     s = MsgBox(msg & fil, 1 + 32 + 256, "删除文件")
     If s = 1 Then fil.Delete
   Case 4:
     Set fil = fso.GetFile(File1.FileName)
     msg = "请输入新文件名：" & Chr(13) & Chr(13) & "文件原名为："
     s = InputBox(msg & fil, "文件更名", fil.Name)
     If Len(Trim(s)) <> 0 Then fil.Name = s
    End Select
    File1.Refresh
    File2.Refresh
    Exit Sub
errorhandler:
       MsgBox "应该选择一个文件", , "文件管理器"
       
End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Dir1_Change()
File1.Path = Dir1.Path
ChDir Dir1.Path
End Sub

Private Sub Dir2_Change()
File2.Path = Dir2.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
ChDrive Drive1.Drive: ChDir Dir1.Path

End Sub

Private Sub Drive2_Change()
Dir2.Path = Drive2.Drive
End Sub