1![]()
'FSO的几个应用函数
2![]()
3![]()
'1.读取文件中所有字符的函数
4![]()
'其实就是通过ReadLine（读取行），通过 While Not cnrs.AtEndOfStream 的条件进行循环读取行，
5![]()
'来达到读取文件中所有字符。当然也可以使用ReadAll代替多个ReadLine，但主要缺点是将格式进行换行等问题需要再次解决。
6![]()
'引用函数 call FSOFileRead("xxx文件") 即可
7![]()
8![]()
Function FileReadAll(filename As String) As String
9![]()
On Error GoTo errlabel
10![]()
Dim fso As New FileSystemObject
11![]()
If Not fso.FileExists(filename) Then
12![]()
FileReadAll = ""
13![]()
Exit Function
14![]()
Else
15![]()
Dim cnrs As TextStream
16![]()
Dim rsline As String
17![]()
rsline = ""
18![]()
Set cnrs = fso.OpenTextFile(filename, 1)
19![]()
While Not cnrs.AtEndOfStream
20![]()
rsline = rsline & cnrs.ReadLine
21![]()
Wend
22![]()
FileReadAll = rsline
23![]()
Exit Function
24![]()
End If
25![]()
errlabel:
26![]()
FileReadAll = ""
27![]()
End Function
28![]()
29![]()
'2读取文件中某一行中所有字符的函数
30![]()
'这次即使用了readall方法，通过split函数将读取的内容以换行为条件，进行数组的定义，
31![]()
'提取 lineNum-1（数组从0记数） 所对应的数组值即为 读取的该行值 ，也就是该行中所有的字符了。
32![]()
'函数的调用 call FSOlinedit("xxx文件",35) 表示显示xxx文件的第35行内容
33![]()
34![]()
Function LineEdit(filename As String, lineNum As Integer) As String
35![]()
On Error GoTo errlabel
36![]()
If lineNum < 1 Then
37![]()
LineEdit = ""
38![]()
Exit Function
39![]()
End If
40![]()
Dim fso As New FileSystemObject
41![]()
If Not fso.FileExists(filename) Then
42![]()
LineEdit = ""
43![]()
Exit Function
44![]()
Else
45![]()
Dim f As TextStream
46![]()
Dim tempcnt As String
47![]()
Dim temparray
48![]()
Set f = fso.OpenTextFile(filename, 1)
49![]()
If Not f.AtEndOfStream Then tempcnt = f.ReadAll
50![]()
f.Close
51![]()
Set f = Nothing
52![]()
temparray = Split(tempcnt, Chr(13) & Chr(10))
53![]()
If lineNum > UBound(temparray) + 1 Then
54![]()
LineEdit = ""
55![]()
Exit Function
56![]()
Else
57![]()
LineEdit = temparray(lineNum - 1)
58![]()
End If
59![]()
End If
60![]()
Exit Function
61![]()
errlabel:
62![]()
LineEdit = ""
63![]()
End Function
64![]()
65![]()
'3.读取文件中最后一行内容的函数
66![]()
'其实和读取某一行的函数类似，主要即是 数组的上界ubound值 就是最末的值 ，故为最后一行。函数的引用也很简单。
67![]()
68![]()
Function LastLine(filename As String) As String
69![]()
On Error GoTo errlabel
70![]()
Dim fso As New FileSystemObject
71![]()
If Not fso.FileExists(filename) Then
72![]()
LastLine = ""
73![]()
Exit Function
74![]()
End If
75![]()
Dim f As TextStream
76![]()
Dim tempcnt As String
77![]()
Dim temparray
78![]()
Set f = fso.OpenTextFile(filename, 1)
79![]()
If Not f.AtEndOfStream Then
80![]()
tempcnt = f.ReadAll
81![]()
f.Close
82![]()
Set f = Nothing
83![]()
temparray = Split(tempcnt, Chr(13) & Chr(10))
84![]()
LastLine = temparray(UBound(temparray))
85![]()
End If
86![]()
Exit Function
87![]()
errlabel:
88![]()
LastLine = ""
89![]()
End Function
90![]()
91![]()
'在ASP中自动创建多级文件夹的函数
92![]()
'FSO中有个方法是CreateFolder,但是这个方法只能在其上一级文件夹存在的情况下创建新的文件夹,
93![]()
'所以我就写了一个自动创建多级文件夹的函数,在生成静态页面等方面使用非常方便.
94![]()
'--------------------------------
95![]()
' 自动创建指定的多级文件夹
96![]()
' strPath为绝对路径
97![]()
98![]()
Function AutoCreateFolder(strPath) As Boolean
99![]()
On Error Resume Next
100![]()
Dim astrPath
101![]()
Dim ulngPath As Integer
102![]()
Dim i As Integer
103![]()
Dim strTmpPath As String
104![]()
105![]()
If InStr(strPath, "\") <= 0 Or InStr(strPath, ":") <= 0 Then
106![]()
AutoCreateFolder = False
107![]()
Exit Function
108![]()
End If
109![]()
Dim objFSO As New FileSystemObject
110![]()
If objFSO.FolderExists(strPath) Then
111![]()
AutoCreateFolder = True
112![]()
Exit Function
113![]()
End If
114![]()
astrPath = Split(strPath, "\")
115![]()
ulngPath = UBound(astrPath)
116![]()
strTmpPath = ""
117![]()
For i = 0 To ulngPath
118![]()
strTmpPath = strTmpPath & astrPath(i) & "\"
119![]()
If Not objFSO.FolderExists(strTmpPath) Then
120![]()
' 创建
121![]()
objFSO.CreateFolder (strTmpPath)
122![]()
End If
123![]()
Next
124![]()
Set objFSO = Nothing
125![]()
If Err = 0 Then
126![]()
AutoCreateFolder = True
127![]()
Else
128![]()
AutoCreateFolder = False
129![]()
End If
130![]()
End Function
131![]()
132![]()
'一个文件备份通用过程:
133![]()
'Filename = 文件名，Drive = 驱动器，Folder = 文件夹(一层)
134![]()
Public 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
170![]()
End Sub
171![]()
172![]()
'延时过程，Delay 单位约为 1 秒
173![]()
Private Sub Waitfor(Delay As Single)
174![]()
Dim StartTime As Single
175![]()
StartTime = Timer
176![]()
Do Until (Timer - StartTime) > Delay
177![]()
Loop
178![]()
End Sub
179![]()
'FSO的几个应用函数2
3
'1.读取文件中所有字符的函数4
'其实就是通过ReadLine（读取行），通过 While Not cnrs.AtEndOfStream 的条件进行循环读取行，5
'来达到读取文件中所有字符。当然也可以使用ReadAll代替多个ReadLine，但主要缺点是将格式进行换行等问题需要再次解决。6
'引用函数 call FSOFileRead("xxx文件") 即可7
8
Function FileReadAll(filename As String) As String9
On Error GoTo errlabel10
Dim fso As New FileSystemObject11
If Not fso.FileExists(filename) Then12
FileReadAll = ""13
Exit Function14
Else15
Dim cnrs As TextStream16
Dim rsline As String17
rsline = ""18
Set cnrs = fso.OpenTextFile(filename, 1)19
While Not cnrs.AtEndOfStream20
rsline = rsline & cnrs.ReadLine21
Wend22
FileReadAll = rsline23
Exit Function24
End If25
errlabel:26
FileReadAll = ""27
End Function28
29
'2读取文件中某一行中所有字符的函数30
'这次即使用了readall方法，通过split函数将读取的内容以换行为条件，进行数组的定义，31
'提取 lineNum-1（数组从0记数） 所对应的数组值即为 读取的该行值 ，也就是该行中所有的字符了。32
'函数的调用 call FSOlinedit("xxx文件",35) 表示显示xxx文件的第35行内容33
34
Function LineEdit(filename As String, lineNum As Integer) As String35
On Error GoTo errlabel36
If lineNum < 1 Then37
LineEdit = ""38
Exit Function39
End If40
Dim fso As New FileSystemObject41
If Not fso.FileExists(filename) Then42
LineEdit = ""43
Exit Function44
Else45
Dim f As TextStream46
Dim tempcnt As String47
Dim temparray48
Set f = fso.OpenTextFile(filename, 1)49
If Not f.AtEndOfStream Then tempcnt = f.ReadAll50
f.Close51
Set f = Nothing52
temparray = Split(tempcnt, Chr(13) & Chr(10))53
If lineNum > UBound(temparray) + 1 Then54
LineEdit = ""55
Exit Function56
Else57
LineEdit = temparray(lineNum - 1)58
End If59
End If60
Exit Function61
errlabel:62
LineEdit = ""63
End Function64
65
'3.读取文件中最后一行内容的函数66
'其实和读取某一行的函数类似，主要即是 数组的上界ubound值 就是最末的值 ，故为最后一行。函数的引用也很简单。67
68
Function LastLine(filename As String) As String69
On Error GoTo errlabel70
Dim fso As New FileSystemObject71
If Not fso.FileExists(filename) Then72
LastLine = ""73
Exit Function74
End If75
Dim f As TextStream76
Dim tempcnt As String77
Dim temparray78
Set f = fso.OpenTextFile(filename, 1)79
If Not f.AtEndOfStream Then80
tempcnt = f.ReadAll81
f.Close82
Set f = Nothing83
temparray = Split(tempcnt, Chr(13) & Chr(10))84
LastLine = temparray(UBound(temparray))85
End If86
Exit Function87
errlabel:88
LastLine = ""89
End Function90
91
'在ASP中自动创建多级文件夹的函数92
'FSO中有个方法是CreateFolder,但是这个方法只能在其上一级文件夹存在的情况下创建新的文件夹,93
'所以我就写了一个自动创建多级文件夹的函数,在生成静态页面等方面使用非常方便.94
'--------------------------------95
' 自动创建指定的多级文件夹96
' strPath为绝对路径97
98
Function AutoCreateFolder(strPath) As Boolean99
On Error Resume Next100
Dim astrPath101
Dim ulngPath As Integer102
Dim i As Integer103
Dim strTmpPath As String104
105
If InStr(strPath, "\") <= 0 Or InStr(strPath, ":") <= 0 Then106
AutoCreateFolder = False107
Exit Function108
End If109
Dim objFSO As New FileSystemObject110
If objFSO.FolderExists(strPath) Then111
AutoCreateFolder = True112
Exit Function113
End If114
astrPath = Split(strPath, "\")115
ulngPath = UBound(astrPath)116
strTmpPath = ""117
For i = 0 To ulngPath118
strTmpPath = strTmpPath & astrPath(i) & "\"119
If Not objFSO.FolderExists(strTmpPath) Then120
' 创建121
objFSO.CreateFolder (strTmpPath)122
End If123
Next124
Set objFSO = Nothing125
If Err = 0 Then126
AutoCreateFolder = True127
Else128
AutoCreateFolder = False129
End If130
End Function131
132
'一个文件备份通用过程:133
'Filename = 文件名，Drive = 驱动器，Folder = 文件夹(一层)134
Public 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 Long137
Counter = 0138
Do While Counter < 6 '如果驱动器没准备好，继续检测。共检测 6 秒139
Counter = Counter + 1140
Call Waitfor(1) '间隔 1 秒141
If fso.Drives(Drive).IsReady = True Then142
Exit Do143
End If144
Loop145
If fso.Drives(Drive).IsReady = False Then '6 秒后目标盘仍未准备就绪，退出146
MsgBox " 目标驱动器 " & Drive & " 没有准备好！ ", vbCritical147
Exit Sub148
End If149
If fso.GetDrive(Drive).FreeSpace < fso.GetFile(filename).Size Then150
MsgBox "目标驱动器空间太小！", vbCritical '目标驱动器空间不够，退出151
Exit Sub152
End If153
If Right(Drive, 1) <> ":" Then154
Drive = Drive & ":"155
End If156
If Left(folder, 1) <> "\" Then157
folder = "\" & folder158
End If159
If Right(folder, 1) <> "\" Then160
folder = folder & "\"161
End If162
Dest_path = Drive & folder163
If Not fso.FolderExists(Dest_path) Then '如果目标文件夹不存在，创建之164
fso.CreateFolder Dest_path165
End If166
fso.CopyFile filename, Dest_path & fso.GetFileName(filename), True167
'拷贝，直接覆盖同名文件168
MsgBox " 文件备份完毕。", vbOKOnly169
Set fso = Nothing170
End Sub171
172
'延时过程，Delay 单位约为 1 秒173
Private Sub Waitfor(Delay As Single)174
Dim StartTime As Single175
StartTime = Timer176
Do Until (Timer - StartTime) > Delay177
Loop178
End Sub179
作者：peterzb（个人开发历程知识库 -
博客园）
出处：http://peterzb.cnblogs.com/
文章版权归本人所有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。
浙公网安备 33010602011771号