FSO文件系统对文件和文件夹的详细操作

 *************************************************************************
'**模 块 名：Form1
**说 明：永远的魔灵 by icecept(郭卫）
'**创 建 人：icecept(魔灵)
'**日 期：2009-11-15 20:27:03
'**修 改 人：icecept(魔灵)
'**版 本：V1.0.0
'**E-mail   ：[e-mail] QQ：543375508
'**网 址：http://hi.baidu.com/icecept http://icecept.jimdo.com
'*************************************************************************

'此程序需加载microsoft scripting runtime
Dim FsoSys As New FileSystemObject
Private Sub Command1_Click()
'建立目录
If FsoSys.FolderExists(CheckFilePath(App.Path) & "x1") Then   '查看文件夹是否存在
       MsgBox ("目录" & CheckFilePath(App.Path) & "x1已存在")
Else
       FsoSys.CreateFolder CheckFilePath(App.Path) & "x1"
       MsgBox "目录" & CheckFilePath(App.Path) & "x1建立成功"
End If
End Sub
Private Sub Command10_Click()
'得到系统文件夹
MsgBox FsoSys.GetSpecialFolder(SystemFolder)
End Sub
Private Sub Command11_Click()
'得到临时文件夹
MsgBox FsoSys.GetSpecialFolder(TemporaryFolder)
End Sub
Private Sub Command12_Click()
If FsoSys.FolderExists(CheckFilePath(App.Path) & "1") Then             '查看文件夹是否存在
       If FsoSys.FileExists(CheckFilePath(App.Path) & "开闭光驱.exe") Then   '查看文件是否存在
         FsoSys.CopyFile CheckFilePath(App.Path) & "1/开闭光驱.exe", FsoSys.GetSpecialFolder(SystemFolder) & "/开闭光驱.exe" '复制文件
         'fsoSys.MoveFile CheckFilePath(App.Path) & "1/开闭光驱.exe", fsoSys.GetSpecialFolder(SystemFolder) & "/开闭光驱.exe" '移动文件
         MsgBox CheckFilePath(App.Path) & "1/开闭光驱.exe" & vbCrLf & vbCrLf & "成功复制到" & FsoSys.GetSpecialFolder(SystemFolder) & "/开闭光驱.exe"
       Else
         MsgBox ("文件" & CheckFilePath(App.Path) & "1/开闭光驱.exe" & "不存在")
       End If
Else
       MsgBox ("目录" & CheckFilePath(App.Path) & "1" & "不存在")
End If
End Sub
Private Sub Command13_Click()
'读取文件
Dim txtstream As TextStream
If FsoSys.FileExists(CheckFilePath(App.Path) & "x1/11.txt") Then
       'ForReading表示打开一个只读文件，ForAppending表示打开一个文件并把内容写到文件末尾
       'true表示当文件不存在时创建新文件,false表示当文件不存在时会产生一个错误(默认值)
       Set txtstream = FsoSys.OpenTextFile(CheckFilePath(App.Path) & "x1/11.txt", ForReading)
       MsgBox txtstream.ReadAll   '读取整个文档,从文档的指针处开始读取
       Set txtstream = FsoSys.OpenTextFile(CheckFilePath(App.Path) & "x1/11.txt", ForReading) '重新打开，为第二次读取作准备
       MsgBox txtstream.Read(1)   '读取1个字符,从文档的指针处开始读取
       txtstream.Skip (1)        '光标跳一个字，定位到１行３列
      MsgBox "指针定位到 " & txtstream.Line & " 行" & txtstream.Column & " 列"
      MsgBox txtstream.Read(1)   '读取1个字符,从文档的指针处开始读取
       txtstream.SkipLine        '跳一行，下一次读取光标定位到第二行的开始处。即２行１列
       MsgBox "指针定位到 " & txtstream.Line & " 行" & txtstream.Column & " 列" 'Line行号   Column列号
       MsgBox txtstream.ReadLine '读取1行,从文档的指针处开始读取
       If txtstream.AtEndOfLine = True Then MsgBox "已经到行尾"
       If txtstream.AtEndOfStream = True Then MsgBox "已经到文件尾"
       txtstream.Close
Else
       MsgBox "文件" & CheckFilePath(App.Path) & "x1/11.txt不存在"
End If
End Sub
Private Sub Command14_Click()
Set FsoDrive = FsoSys.GetDrive("c:")
MsgBox "返回驱动器的名字，但不检测指定的路径是否存在:" & vbCrLf & cbcrlf & FsoSys.GetDriveName("j:/通讯录 ")
MsgBox "驱动器上用户可以使用的空间:" & Format(FsoDrive.AvailableSpace / 1024 / 1024 / 1024, "0.000") & "GB"
MsgBox "驱动器的盘符字母:" & FsoDrive.DriveLetter
MsgBox "驱动器的类型:" & ShowDriveType(FsoDrive.DriveType)
MsgBox "驱动器上的文件系统类型:" & FsoDrive.FileSystem
MsgBox "驱动器上的可用空间:" & Format(FsoDrive.FreeSpace / 1024 / 1024 / 1024, "0.000") & "GB"
MsgBox "驱动器是否准备好:" & FsoDrive.IsReady
MsgBox "驱动器的路径:" & FsoDrive.Path
MsgBox "驱动器的根文件夹:" & FsoDrive.RootFolder
MsgBox "磁盘序列号:" & FsoDrive.SerialNumber
MsgBox "驱动器有总空间:" & Format(FsoDrive.TotalSize / 1024 / 1024 / 1024, "0.000") & "GB"
MsgBox "驱动器的卷标名:" & FsoDrive.VolumeName
End Sub
Private Sub Command15_Click()
'得到驱动器句柄
MsgBox FsoSys.GetDrive("c:/")
End Sub
Private Sub Command16_Click()
'得到文件夹句柄
MsgBox FsoSys.GetFolder(App.Path)
End Sub
Private Sub Command17_Click()
'得到文件句柄
MsgBox FsoSys.GetFile(App.Path & "/fso示例.exe")
End Sub
Private Sub Command18_Click()
'得到文件版本
MsgBox FsoSys.GetFileVersion(App.Path & "/fso示例.exe")
End Sub
Private Sub Command19_Click()
'得到文件扩展名
MsgBox FsoSys.GetExtensionName(App.Path & "/fso示例.exe")
End Sub
Private Sub Command2_Click()
'检查目录是否存在
If FsoSys.FolderExists(CheckFilePath(App.Path) & "x1") Then
       MsgBox ("目录" & CheckFilePath(App.Path) & "x1已存在")
Else
       MsgBox ("目录" & CheckFilePath(App.Path) & "x1不存在")
End If
End Sub
Private Sub Command20_Click()
'得到文件名称
MsgBox FsoSys.GetBaseName(App.Path & "/fso示例.exe")
End Sub
Private Sub Command21_Click()
'得到父目录
MsgBox "源目录:" & App.Path & vbCrLf & vbCrLf & "父目录:" & FsoSys.GetParentFolderName(App.Path)
End Sub
Private Sub Command22_Click()
'返回一个完整路径
MsgBox "此示例返回从app.path + 华容道的完整路径" & vbCrLf & vbCrLf & FsoSys.GetAbsolutePathName("华容道")
End Sub
Private Sub Command23_Click()
'获取文件夹的有关信息
Dim sReturn As String
Set folder1 = FsoSys.GetFolder(App.Path)
sReturn = "文件夹的属性是 " & CheckFolderAttrib(folder1.Attributes) & vbCrLf
'获取最近一次访问的时间
sReturn = sReturn & "文件夹最近访问的时间是 " & folder1.DateLastAccessed & vbCrLf
'获取最后一次修改的时间
sReturn = sReturn & "文件夹最后修改的时间是 " & folder1.DateLastModified & vbCrLf
'获取文件夹的大小
sReturn = sReturn & "文件夹的尺寸是 " & Round(folder1.Size / 1024, 0)
sReturn = sReturn & "Kb" & vbCrLf
'判断文件或文件夹类型
sReturn = sReturn & "该对象的类型是" & folder1.Type & vbCrLf
MsgBox sReturn
End Sub
Private Sub Command24_Click()
MsgBox FsoSys.BuildPath("c:/", "temp")
End Sub
Private Sub Command25_Click()
'当fsoSys.GetDrive ("c:/windows")这样用时就会出错,它只能写成fsoSys.GetDrive ("c:/")
'所以最好加上fsoSys.GetDriveName("c:/windows")
MsgBox FsoSys.GetDrive(FsoSys.GetDriveName("c:/windows"))
End Sub
Private Sub Command27_Click()
Dim FsoFolder As Folder
Dim FsoFile As File
Set FsoFolder = FsoSys.GetFolder("c:/")
Debug.Print FsoFolder.Path & "下的文件有： "
For Each FsoFile In FsoFolder.Files
       Debug.Print FsoFile.Name
Next
End Sub
Private Sub Command28_Click()
Dim FsoFolder As Folder
Dim FsoFile As File
Dim SubFolder As Folder
Set FsoFolder = FsoSys.GetFolder("C:/")
Debug.Print FsoFolder.Path & "下的子文件夹有："
For Each SubFolder In FsoFolder.SubFolders
       Debug.Print SubFolder.Name
Next
End Sub
Private Sub Command29_Click()
Dim FsoDrive As Drive
For Each FsoDrive In FsoSys.Drives
       Debug.Print FsoDrive.DriveLetter
Next
End Sub
Private Sub Command3_Click()
'查看驱动器是否存在
If FsoSys.DriveExists("c:/") Then
       MsgBox "c:/,驱动器已经存在"
End If
End Sub
Private Sub Command30_Click()
    Dim FsoDrive As Drive
    For Each FsoDrive In FsoSys.Drives
       Debug.Print FsoDrive.Path & "是" & ShowDriveType(FsoDrive.DriveType)
Next
End Sub
Private Sub Command4_Click()
'删除目录
If FsoSys.FolderExists(CheckFilePath(App.Path) & "x1") Then
       FsoSys.DeleteFolder CheckFilePath(App.Path) & "x1", True
       MsgBox "目录" & CheckFilePath(App.Path) & "x1删除成功"
Else
       MsgBox "目录" & CheckFilePath(App.Path) & "x1不存在"
End If
End Sub
Private Sub Command5_Click()
'建立文本文件
On Error GoTo errline
Dim txtstream As TextStream
If FsoSys.FolderExists(CheckFilePath(App.Path) & "x1") Then
       '当createtextfile第二个参数为true时，覆盖已有文件，为false时产生文件已经存在的错误
       'Set txtstream = fsoSys.CreateTextFile(CheckFilePath(App.Path) & "x1/11.txt", True)
       Set txtstream = FsoSys.CreateTextFile(CheckFilePath(App.Path) & "x1/11.txt", False)
       MsgBox CheckFilePath(App.Path) & "x1/11.txt,建立成功"
       txtstream.Write "郭卫非常"
       txtstream.WriteLine "爱"     '从文档的指针处开始写，郭卫与爱在同一行输出，换一行输出王淑华和郭子航
       txtstream.Write "王淑华"     '从文档的指针处开始写，王淑华和郭子航会写在一行上
       txtstream.Write "和"
       txtstream.WriteLine "郭子航"   '从文档的指针处开始写，writeline 会紧接着write后面输出
       txtstream.Close
Else
       MsgBox ("目录" & CheckFilePath(App.Path) & "x1不存在")
End If
errline:
If Err.Number = 58 Then
       MsgBox Err.Description, vbOKOnly Or vbInformation, "错误"
End If
End Sub
Private Sub Command6_Click()
'检查文件是否存在
If FsoSys.FileExists(CheckFilePath(App.Path) & "x1/11.txt") Then
       MsgBox CheckFilePath(App.Path) & "x1/11.txt文件已存在"
Else
       MsgBox CheckFilePath(App.Path) & "x1/11.txt文件不存在"
End If
End Sub
Private Sub Command7_Click()
If FsoSys.FolderExists(CheckFilePath(App.Path) & "x1") Then
       If FsoSys.FileExists(CheckFilePath(App.Path) & "x1/11.txt") Then
         FsoSys.DeleteFile (CheckFilePath(App.Path) & "x1/11.txt")
         MsgBox "文件删除成功"
       Else
         MsgBox "文件不存在"
       End If
Else
       MsgBox ("目录" & CheckFilePath(App.Path) & "x1不存在")
End If
End Sub
Private Sub Command8_Click()
'得到光驱的盘符
MsgBox GetCDROM()
End Sub
Private Sub Command9_Click()
'得到windows文件夹
MsgBox FsoSys.GetSpecialFolder(windowsforlder)
End Sub

Function CheckFilePath(Path As String) As String
'检查档位文件是否在根目录下
If Right(Path, 1) <> "/" Then
       CheckFilePath = Path & "/"
Else
       CheckFilePath = Path
End If
End Function

Function ShowDriveType(Driver)
Select Case Driver
       Case 0: ShowDriveType = "设备无法识别"
       Case 1: ShowDriveType = "软盘驱动器"
       Case 2: ShowDriveType = "硬盘驱动器"
       Case 3: ShowDriveType = "网络硬盘驱动器"
       Case 4: ShowDriveType = "光盘驱动器"
       Case 5: ShowDriveType = "RAM虚拟磁盘"
End Select
End Function

Function GetCDROM() ' 返回光驱的盘符(字母)
Dim Fso As New FileSystemObject '创建 FSO 对象的一个实例
Dim FsoDrive As Drive, FsoDrives As Drives '定义驱动器、驱动器集合对象
Set FsoDrives = Fso.Drives
For Each FsoDrive In FsoDrives '遍历所有可用的驱动器
       If FsoDrive.DriveType = CDRom Then '如果驱动器的类型为 CDrom
         GetCDROM = FsoDrive.DriveLetter '输出其盘符
         Exit Function
       Else
         GetCDROM = ""
       End If
Next
Set Fso = Nothing
Set FsoDrive = Nothing
Set FsoDrives = Nothing
End Function

Function CheckFolderAttrib(Attrib As Integer) As String
Select Case Attrib
       Case Normal '0
       CheckFolderAttrib = "常规"
       Case ReadOnly   '1
       CheckFolderAttrib = "只读"
       Case Hidden '2
       CheckFolderAttrib = "隐藏"
       Case System '4
       CheckFolderAttrib = "系统"
       Case Volume '8
       CheckFolderAttrib = "磁盘驱动器卷标"
       Case Directory '16
       CheckFolderAttrib = "只读文件夹"
       Case Archive '32
       CheckFolderAttrib = "存档"
       Case Alias '64
       CheckFolderAttrib = "快捷方式"
       Case Compressed   '128
       CheckFolderAttrib = "压缩文件"
End Select
End Function

附件: fso示例.rar