FSO的几个应用函数[VB]

简介:

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


本文转自peterzb博客园博客,原文链接:http://www.cnblogs.com/peterzb/archive/2006/04/23/382793.html,如需转载请自行联系原作者。
目录
相关文章
|
10月前
|
存储 编解码 API
Vb-视频总结
视频内容主要是针对Vb进行一个详细的介绍和告知大家如何去操作中调用代码以及如何正确的运行和书写,每个视频都是有详细的介绍和讲解,里面的主要内容: 常用系统函数、窗体事件、窗体之间的相互传递、以及什么是全局对象、定义的相关内容、分类、API函数的使用等等,下面就列举几项。
83 0
|
10月前
|
图形学
VB-总结
  转眼之间,vb例子马上接近尾声了,还记得之前我总结的错误经验,在之后的过程中也是出现过,但是出现之后也不是像之前那样不知道该如何去解决和摸索,面对错误问题因为已经出现过一次所以根据出现错误的类型来判断自己是否能解决,不总结可能会导致错误会频繁出现,因为犯错的点经过时间的洗礼就慢慢淡忘,通过一定形式的总结可能会印象深一点。
57 0
|
C++
使用dumpbin查看dll有哪些函数
使用dumpbin查看dll有哪些函数
96 0
|
程序员
vb中MSFlexgrid 和 MSHFlexgrid 的区别以及详解
vb中MSFlexgrid 和 MSHFlexgrid 的区别以及详解
232 0
VB编程:FileLen函数获取文件的大小
VB编程:FileLen函数获取文件的大小
272 0
|
程序员 API 开发工具