为方便自己看网络小说,自己写个txt按章节分段的小程序

为方便自己看网络小说,自己写个txt按章节分段的小程序
2011年08月08日
　　Const ForReading = 1, ForWriting = 2
　　Dim f, m
　　If ReportFileStatus(FileName) = 1 then
　　Set f = objFSO.OpenTextFile(FileName, ForReading)
　　While Not f.AtEndOfStream
　　m = m & RemoveHTML(f.ReadLine) & ""
　　Wend
　　ReadTxtFile = m
　　f.Close
　　Else
　　ReadTxtFile = -1
　　End if
　　End Function
　　'写文本文件
　　Public Function WriteTxtFile(FileName,TextStr,WriteORAppendType)
　　Const ForReading = 1, ForWriting = 2 , ForAppending = 8
　　Dim f, m
　　select Case WriteORAppendType
　　Case 1: '文件进行写操作
　　Set f = objFSO.OpenTextFile(FileName, ForWriting, True)
　　f.Write TextStr
　　f.Close
　　If ReportFileStatus(FileName) = 1 then
　　WriteTxtFile = 1
　　Else
　　WriteTxtFile = -1
　　End if
　　Case 2: '文件末尾进行写操作
　　If ReportFileStatus(FileName) = 1 then
　　Set f = objFSO.OpenTextFile(FileName, ForAppending ,1)
　　f.Write TextStr
　　f.Close
　　WriteTxtFile = 1
　　Else
　　WriteTxtFile = -1
　　End if
　　End select
　　End Function
　　'判断目录是否存在
　　Public Function ReportFolderStatus(fldr)
　　Dim msg
　　msg = -1
　　If (objFSO.FolderExists(fldr)) Then
　　msg = 1
　　Else
　　msg = -1
　　End If
　　ReportFolderStatus = msg
　　End Function
　　'创建的文件夹
　　Public Function CreateFolderDemo(FolderName)
　　Dim f
　　If ReportFolderStatus(FolderName) = 1 Then
　　CreateFolderDemo = -1
　　Else
　　Set f = objFSO.CreateFolder(FolderName)
　　CreateFolderDemo = 1
　　End if
　　End Function
　　'文件是否存在？
　　Public Function ReportFileStatus(FileName)
　　Dim msg
　　msg = -1
　　If (objFSO.FileExists(FileName)) Then
　　msg = 1
　　Else
　　msg = -1
　　End If
　　ReportFileStatus = msg
　　End Function
　　'按章节分段
　　Function CutHao(str)
　　Dim sRegExp, Match, Matches
　　Set sRegExp = New RegExp
　　sRegExp.IgnoreCase = True
　　sRegExp.Pattern = "第[一二两三四五六七八九十○零百0-9１２３４５６７８９０]{1,12}章"
　　set Matches = sRegExp.Execute(str)
　　if Matches.count then
　　For Each Match in Matches
　　i = i + 1
　　Next
　　end if
　　CutHao=str
　　Set sRegExp = Nothing
　　End Function
　　'HTML编码过滤
　　Function RemoveHTML(strHTML)
　　Dim objRegExp, Match, Matches
　　Set objRegExp = New Regexp
　　objRegExp.IgnoreCase = True
　　objRegExp.Global = True
　　'取闭合的
　　objRegExp.Pattern = ""
　　'进行匹配
　　Set Matches = objRegExp.Execute(strHTML)
　　' 遍历匹配集合，并替换掉匹配的项目
　　For Each Match in Matches
　　strHtml=Replace(strHTML,Match.Value,"")
　　strHtml=Replace(strHTML," ","")
　　Next
　　RemoveHTML=strHTML
　　Set objRegExp = Nothing
　　End Function
　　%>[b][/b]