FSO的几个应用函数[VB]

 

  1'FSO的几个应用函数
  2
  3'1.读取文件中所有字符的函数
  4'其实就是通过ReadLine（读取行），通过 While Not cnrs.AtEndOfStream 的条件进行循环读取行，
  5'来达到读取文件中所有字符。当然也可以使用ReadAll代替多个ReadLine，但主要缺点是将格式进行换行等问题需要再次解决。
  6'引用函数 call FSOFileRead("xxx文件") 即可
  7
  8Function FileReadAll(filename As String) As String
  9On Error GoTo errlabel
 10Dim fso As New FileSystemObject
 11If Not fso.FileExists(filename) Then
 12FileReadAll = ""
 13Exit Function
 14Else
 15Dim cnrs As TextStream
 16Dim rsline As String
 17rsline = ""
 18Set cnrs = fso.OpenTextFile(filename, 1)
 19While Not cnrs.AtEndOfStream
 20rsline = rsline & cnrs.ReadLine
 21Wend
 22FileReadAll = rsline
 23Exit Function
 24End If
 25errlabel:
 26FileReadAll = ""
 27End Function
 28
 29'2读取文件中某一行中所有字符的函数
 30'这次即使用了readall方法，通过split函数将读取的内容以换行为条件，进行数组的定义，
 31'提取 lineNum-1（数组从0记数） 所对应的数组值即为 读取的该行值 ，也就是该行中所有的字符了。
 32'函数的调用 call FSOlinedit("xxx文件",35) 表示显示xxx文件的第35行内容
 33
 34Function LineEdit(filename As String, lineNum As Integer) As String
 35On Error GoTo errlabel
 36If lineNum < 1 Then
 37LineEdit = ""
 38Exit Function
 39End If
 40Dim fso As New FileSystemObject
 41If Not fso.FileExists(filename) Then
 42LineEdit = ""
 43Exit Function
 44Else
 45Dim f As TextStream
 46Dim tempcnt As String
 47Dim temparray
 48Set f = fso.OpenTextFile(filename, 1)
 49If Not f.AtEndOfStream Then tempcnt = f.ReadAll
 50f.Close
 51Set f = Nothing
 52temparray = Split(tempcnt, Chr(13) & Chr(10))
 53If lineNum > UBound(temparray) + 1 Then
 54LineEdit = ""
 55Exit Function
 56Else
 57LineEdit = temparray(lineNum - 1)
 58End If
 59End If
 60Exit Function
 61errlabel:
 62LineEdit = ""
 63End Function
 64
 65'3.读取文件中最后一行内容的函数
 66'其实和读取某一行的函数类似，主要即是 数组的上界ubound值 就是最末的值 ，故为最后一行。函数的引用也很简单。
 67
 68Function LastLine(filename As String) As String
 69On Error GoTo errlabel
 70Dim fso As New FileSystemObject
 71If Not fso.FileExists(filename) Then
 72LastLine = ""
 73Exit Function
 74End If
 75Dim f As TextStream
 76Dim tempcnt As String
 77Dim temparray
 78Set f = fso.OpenTextFile(filename, 1)
 79If Not f.AtEndOfStream Then
 80tempcnt = f.ReadAll
 81f.Close
 82Set f = Nothing
 83temparray = Split(tempcnt, Chr(13) & Chr(10))
 84LastLine = temparray(UBound(temparray))
 85End If
 86Exit Function
 87errlabel:
 88LastLine = ""
 89End Function
 90
 91'在ASP中自动创建多级文件夹的函数
 92'FSO中有个方法是CreateFolder,但是这个方法只能在其上一级文件夹存在的情况下创建新的文件夹,
 93'所以我就写了一个自动创建多级文件夹的函数,在生成静态页面等方面使用非常方便.
 94'--------------------------------
 95' 自动创建指定的多级文件夹
 96' strPath为绝对路径
 97
 98Function AutoCreateFolder(strPath) As Boolean
 99On Error Resume Next
100Dim astrPath
101Dim ulngPath As Integer
102Dim i As Integer
103Dim strTmpPath As String
104
105If InStr(strPath, "\") <= 0 Or InStr(strPath, ":") <= 0 Then
106AutoCreateFolder = False
107Exit Function
108End If
109Dim objFSO As New FileSystemObject
110If objFSO.FolderExists(strPath) Then
111AutoCreateFolder = True
112Exit Function
113End If
114astrPath = Split(strPath, "\")
115ulngPath = UBound(astrPath)
116strTmpPath = ""
117For i = 0 To ulngPath
118strTmpPath = strTmpPath & astrPath(i) & "\"
119If Not objFSO.FolderExists(strTmpPath) Then
120' 创建
121objFSO.CreateFolder (strTmpPath)
122End If
123Next
124Set objFSO = Nothing
125If Err = 0 Then
126AutoCreateFolder = True
127Else
128AutoCreateFolder = False
129End If
130End Function
131
132   '一个文件备份通用过程:
133   'Filename = 文件名，Drive = 驱动器，Folder = 文件夹(一层)
134Public Sub BackupFile(filename As String, Drive As String, folder As String)
135   Dim fso As New FileSystemObject '创建 FSO 对象实例
136   Dim Dest_path As String, Counter As Long
137   Counter = 0
138   Do While Counter < 6 '如果驱动器没准备好，继续检测。共检测 6 秒
139   Counter = Counter + 1
140   Call Waitfor(1) '间隔 1 秒
141   If fso.Drives(Drive).IsReady = True Then
142   Exit Do
143   End If
144   Loop
145   If fso.Drives(Drive).IsReady = False Then '6 秒后目标盘仍未准备就绪，退出
146   MsgBox " 目标驱动器 " & Drive & " 没有准备好！ ", vbCritical
147   Exit Sub
148   End If
149   If fso.GetDrive(Drive).FreeSpace < fso.GetFile(filename).Size Then
150   MsgBox "目标驱动器空间太小！", vbCritical '目标驱动器空间不够，退出
151   Exit Sub
152   End If
153   If Right(Drive, 1) <> ":" Then
154   Drive = Drive & ":"
155   End If
156   If Left(folder, 1) <> "\" Then
157   folder = "\" & folder
158   End If
159   If Right(folder, 1) <> "\" Then
160   folder = folder & "\"
161   End If
162   Dest_path = Drive & folder
163   If Not fso.FolderExists(Dest_path) Then '如果目标文件夹不存在，创建之
164   fso.CreateFolder Dest_path
165   End If
166   fso.CopyFile filename, Dest_path & fso.GetFileName(filename), True
167   '拷贝，直接覆盖同名文件
168   MsgBox " 文件备份完毕。", vbOKOnly
169   Set fso = Nothing
170End Sub
171   
172'延时过程，Delay 单位约为 1 秒
173Private Sub Waitfor(Delay As Single)
174   Dim StartTime As Single
175   StartTime = Timer
176   Do Until (Timer - StartTime) > Delay
177   Loop
178End Sub
179