VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 5511|回复: 14

FSO文件系统精解示例

[复制链接]
 楼主| 发表于 2007-11-24 10:02:25 | 显示全部楼层 |阅读模式
'此程序需加载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)        '光标跳一个字,定位到1行3列
         MsgBox "指针定位到 " & txtstream.Line & " 行" & txtstream.Column & " 列"
         MsgBox txtstream.Read(1)  '读取1个字符,从文档的指针处开始读取
        txtstream.SkipLine        '跳一行,下一次读取光标定位到第二行的开始处。即2行1列
        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

[ 本帖最后由 icecept 于 2009-3-11 01:51 编辑 ]

fso示例.rar

19.55 KB, 下载次数: 529

评分

参与人数 2威望 +13 人气 +1 收起 理由
tonycasablanca + 5 + 1 好!
script + 8 支持FSO

查看全部评分

本帖被以下淘专辑推荐:

 楼主| 发表于 2007-11-24 10:02:49 | 显示全部楼层
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
回复 支持 反对

使用道具 举报

发表于 2007-11-24 10:35:07 | 显示全部楼层
相当全面哈
回复 支持 反对

使用道具 举报

发表于 2007-11-24 10:37:45 | 显示全部楼层
够详细了.......
回复 支持 反对

使用道具 举报

发表于 2007-11-24 15:42:09 | 显示全部楼层
楼主辛苦了啊,好东西,长见识了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-11-24 18:07:00 | 显示全部楼层
用FSO操作文件夹和文件是最方便的,这是我经常用的,我还有一个经常用的就是windows script host它操作注册表和建立方式,还有一些对windows特殊的操作。想必会对大家有很大的帮助。等我把windows script host所有的方法和属性全部弄通之后,加上详细的注释,就发上来给大家分享。

[ 本帖最后由 icecept 于 2007-11-24 18:08 编辑 ]
回复 支持 反对

使用道具 举报

发表于 2007-11-27 12:11:48 | 显示全部楼层
留名看看
回复 支持 反对

使用道具 举报

发表于 2007-11-27 12:47:46 | 显示全部楼层
以我的名script,当然要顶了
我初次接触程序的就是FSO.vbs,好有感触啊

但现在好多系统都屏蔽了FSO对象,在程序里面已经不起作用了

[ 本帖最后由 script 于 2007-11-27 12:50 编辑 ]
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-12-29 19:13:39 | 显示全部楼层

回复 #8 script 的帖子

应该有办法的,比如在写程序之前,写一个fso解锁程序。
回复 支持 反对

使用道具 举报

发表于 2009-3-7 15:37:36 | 显示全部楼层
绝对好帖!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-8-19 22:47

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表