用VB进行文本文件的再处理

越来越多的人开始认识到Internet这一信息资源的巨大宝库，但是把信息从网上下载下来后，繁杂多样的文件格式却给整理、使用带来相当大的麻烦。有的由于系统平台的变化，甚至显示出来是一团乱糟糟东西。那么要想更好、更方便地利用网络资源，一个得力的文本文件处理工具就显得非常必要。如果四处去寻找一个这样的工具，不仅不容易，找到后可能并不符合我们的要求，但是如果你有VB，那么为什么不自己开发一个这样的工具程序呢？相信我，这并不困难，只要你已经对VB有所了解，一个方便实用的小工具已经在等着你了！
先来分析一下这个程序要完成的主要任务吧，象这样的文本处理，可以归纳为两种形式，就是替换和清除，如果把清除看成是替换成空的话，那么唯一个任务就是替换了。就替换面言，可能会有以下几种形式：
1、将一段文字替换成另一段
2、将某两个特殊标识符之间的文字替换成另外一些文字
3、将某两个特殊标识符之间的文字按照某种规律进行转换
搞清这几个任务，我们就可以着手编程了。一个好的程序员，不应每次都是从零做起，平常一些基础模块的积累，可以增加我们制作大程序的信心。下面我先对程序中用到的我的基础库中的内容进行一下介绍，然后再解决每一个具体问题。
一、准备过程
1、字符串处理函数（StrHead）
用VB来实现这个程序，首先要解决的是如何方便地进行字符串处理，VB中原有的函数InStr和Mid，使用起来并不方便，我利用这两个函数编写出一个新的函数：StrHead，该函数根据指定的断点字符将字符串截断，断点前的字符串被返回，后面部分保留在原字符串中，该函数可以完成大部分字符串操作。函数代码如下：
Public Function StrHead(ss As String,
ByVal c As String) As String
Dim i As Long
i = InStr(ss, c)
If  i > 0 Then
StrHead = Mid(ss, 1, i - 1)
ss = Mid(ss, i + Len(c))
Else
StrHead = ss
ss = ""
End If
End Function
2、文本文件类（TextFile）
程序中涉及到很多文件操作，为了方便，可以先将对文件操作的过程封装到一个类中，这样不仅可以提高编程效率，还可以大大减少出错的机会。因为本课题主要是面对文本文件的，这样我们只编写一个处理文本文件读写类（TextFile）就可以了，该类的几个主要功能函数列在下面：
' 文本文件类(TextFile.cls)
Option Explicit
Dim FileNum As Integer
' 打开文件用于写
Public Function OpenWrit(fn As String) As Boolean
On Error GoTo OWErr
FileNum = FreeFile
Open fn For Output Access Write As #FileNum
OpenWrit = True
Exit Function
OWErr:
OpenWrit = False
End Function
' 打开文件用于读
Public Function OpenRead(fn As String) As Boolean
On Error GoTo ORErr
FileNum = FreeFile
Open fn For Input Access Read As #FileNum
OpenRead = True
Exit Function
ORErr:
OpenRead = False
End Function
' 关闭文件
Public Sub CloseFile()
If  FileNum > 0 Then
Close #FileNum
FileNum = 0
End If
End Sub
' 从文件中读取一行
Public Function GetLine(S As String) As Boolean
On Error GoTo NotGet
If  EOF(FileNum) Then GoTo NotGet
Line Input #FileNum, S
GetLine = True
Exit Function
NotGet:
GetLine = False
End Function
' 往文件中写入一行
Public Function PutLine(Byval S As String) As Boolean
On Error GoTo NotPut
Print #FileNum, S
PutLine = True
Exit Function
NotPut:
PutLine = False
End Function
' 类在结束时，自动关闭文件
Private Sub Class_Terminate()
CloseFile
End Sub
二、替换单元类
做为一个通用的工具，我们现在并不知道要将什么替换为什么，这些信息是要在使用者使用时告诉程序的，这就需要将各种替换任务进行参数化，用最简单明确的方式描述出来。这里我们实现的个替换单元类（reUnit），用它来接受参数并完成替换任务。
1、替换条件的描述及初始化
为了能在一次处理中，实现多种替换，定义一个“替换单元”类：reUnit，来承担主要的替换任务。这个类中定义了替换的条件：
Dim headChr As String '启始符
Dim tailChr As String '结束符
Dim reStr As String '替换为
Dim mapObj as Object '映射对象
通过上面三个变量来描述替换条件：headChr和tailChr代表检索的起点和终点，当tailChr为零长时，表示只对某字符串进行替换。reStr是替换后的字符串，为零长时即表示清除。该类用下面两个函数来设置上面的三个变量：
Public Sub Init(ByVal S As String)
headChr = EscStr(StrHead(S, ","))
tailChr = EscStr(StrHead(S, ","))
reStr = EscStr(S)
If  Left(reStr,1)="@" Then
'第一个字符是"@"，它所代表的是一个映射类
Set mapObj = CreateObject(Mid(reStr,2))
End If
End Sub
Private Function EscStr(ByVal S As String) As String
Dim h As Long
EscStr = ""
Do While Len(S) > 0
EscStr = EscStr & StrHead(S, "&")
If  Len(S) > 0 Then
h = "&H" & StrHead(S, ";")
EscStr = EscStr & Chr(h)
End If
Loop
End Function
函数Init接受一个字符串S，其中应包含“起点”、“终点”和替换后的字符串，他们之间用逗号分隔。为了能将非键盘字符加入其中，可以用“&HHHH;”的形式将任意字符插入其间，HHHH表示一个十六进制数，通过EscStr函数来完成这种替代。
这里需要说明的是，类中定义了一个mapObj变量，它是为了实现“特殊标识符之间的文字按照某种规律进行转换”而设计的。因为这种规律性现在我们并不知道，我们只能在这里为今后留下的一个接口，假设一个类实现了某种规律的映射，并通过下面这样的函数来提供这种映射：
Public Function Map(Byval ss as String) as String
我们规定，如果reStr的第一个字符是"@"的话，它所代表的就不是一直接替换为的字符串，而是的个映射类的标识名，我们将通过CreateObject函数来建立这个对象，在替换时调用它的Map函数。
2、替换函数
该类的Replice函数完成对字符串的替换任务，由于是对文件中的数据以一行为单位依次调用该函数的，所以要考虑到“起点”与“终点”不在同一行上的情况，所以首先定义一个标记变量：
Dim flag As Boolean
当flag为假时，表示不处在检索“终点”状态，为真时为检索“终点”状态。下面是Replice函数的代码：
Public Function Replice(ByVal S As String) As String
Dim tempS as String
If  Len(tailChr) > 0 Then ' 检索成对标记
Do While Len(S) > 0
If  Not flag Then ' 不处在检索“终点”状态
If  InStr(S, headChr) > 0 Then
Replice = Replice & StrHead(S, headChr)
flag = True
Else  ' 处在检索“终点”状态
Replice = Replice & S
Exit Do
End If
End If
If  InStr(S, tailChr) > 0 Then ' 检索“终点”
tempS=StrHead(S, tailChr)
If mapObj Is Nothing Then
Replice = Replice & reStr
Else
' 如果存在映射类的话，调用映射类的Map函数
Replice = Replice & mapObj.Map(tempS)
End If
flag = False
Else
Exit Do
End If
Loop
Else  ' 检索单字符串
Do While Len(S) > 0
If  InStr(S, headChr) > 0 Then
Replice = Replice & StrHead(S, headChr)
Replice = Replice & reStr
Else
Replice = Replice & S
Exit Do
End If
Loop
End If
End Function
三、完成文件替换
有了上面的基础后，就可以通过一个全局模块将具体到文件的的功能实现了：
1、替换单元集合
定义一个集合来保存各个替换单元，我们设想将替换条件保存于一个文件中，称之为“条件定义文件”，文件中每一行定义一个替换条件，定义格式如上文对替换单元类中对Init参数的描述。这样可以很方便在实现单元集合的初始化：
Public reUnits As Collection
' 全局的替换单元集合
Public Function InitUnits(ByVal fn As String) As Boolean
Dim F As New TextFile, S As String
Dim unit As reUnit
If  F.OpenRead(fn) Then
Set reUnits = New Collection
Do While F.GetLine(S)
If  Len(S) > 0 Then
Set unit = New reUnit
unit.Init S
reUnits.Add unit
End If
Loop
InitUnits = True
Else
InitUnits = False
End If
End Function
2、单个文件替换
当确定了所要替换的文件及替换后的文件，就可以分别调用替换单元集合中的单元替换函数来进行替换了：
Public Function ReplaceFile(ByVal sFn As String,ByVal dFn As String) As Boolean
Dim sFile As New TextFile, dFile As New TextFile
If  Not sFile.OpenRead(sFn) Then GoTo reErr
If  Not dFile.OpenWrit(dFn) Then GoTo reErr
Dim unit As reUnit
Dim buff As String
Do While sFile.GetLine(buff)
For Each unit In reUnits
'调用集合中的每一个单元进行替换
buff = unit.Replice(buff)
Next
If  Len(buff) > 0 Then dFile.PutLine buff
Loop
ReplaceFile = True
Exit Function
reErr:
ReplaceFile = False
End Function
3、替换过程
利用前两个函数，实现文件替换的全过程，该过程需要“源文件”、“目标文件”及“条件定义文件”三个参数，也是整个程序所需的参数：
Public Sub RepFile(ByVal sFn As String, ByVal dFn As String, ByVal defFn As String)
Dim info As String
If  InitUnits(defFn) Then
If ReplaceFile(sFn, dFn) Then
info = "替换成功！"
Else
info = "文件不能打开！"
End If
Else
info = "定义文件不能打开！"
End If
MsgBox info
End Sub
四、界面及完成整个程序
1、界面窗口
窗体（frmRep）可以让使用者输入上面要求的三个参数，然后调用RepFile实现替换。在这个窗体中，主要由三个文本编辑框（txtFn(0-2)）和两个按钮（cmOk、cmClose）组成，两个事件响应函数如下：
Private Sub cmOk_Click()
RepFile txtFn(0), txtFn(1), txtFn(2)
End Sub
Private Sub cmClose_Click()
Unload Me
End Sub
2、入口函数
可以把frmRep窗体定义为启动窗体，但这样使程序在应用过程中缺少灵活性，所以不妨定义一个入口函数，对命令行参数进行分析，当条件满足时，就可以不必激活frmRep窗体了：
Public Sub Main()
Dim cm As String
Dim sFn As String, dFn As String, defFn As String
cm = Command
If  Len(cm) > 0 Then sFn = StrHead(cm, " ")
If  Len(cm) > 0 Then dFn = StrHead(cm, " ")
If  Len(cm) > 0 Then defFn = StrHead(cm, " ")
If  Len(sFn) > 0 And Len(dFn) > 0 And Len(defFn) > 0 Then
RepFile sFn, dFn, defFn '条件满足，进行替换
Else
Dim frm As New frmRep '条件不足，建立窗体
frm.txtFn(0) = sFn '把已有条件预先填上
frm.txtFn(1) = dFn
frm.txtFn(2) = defFn
frm.Show
End If
End Sub