从HTML网页文件中提取纯文本的代码

网上时常有些评论说VB写的程序运行速度慢，特别是字符串操作更是慢的无法与其他开发工具相提并论。我对此一向持反对意见，VB很多时候是为了照顾到代码的简洁、方便、安全，而相应牺牲了一些执行速度。这正是有得必有失的道理。在真正需要速度的场合，VB也是可以快起来的，方法就是进入到API中，直接拷贝内存来操作字符串，你会看到，VB的速度毫不逊色于其他任何工具，当然相应的，要牺牲掉简洁、安全这些优势，你必须像编写C代码一样小心翼翼，因为直接操作内存是很危险的，它脱离了VB的安全保护，一个疏忽就会导致严重的后果。

下面这段提取网页纯文本的代码用了字符串操作的优化技巧，可供参考，同时欢迎批评指正。
需要注意的是，这段代码优化的宗旨是够用就好，没有达到最大的优化，如果要完全发挥出VB的潜能，达到骨灰级优化，还可以从以下两方面入手来做进一步的优化：
1.不要使用双缓冲，可以用动态数组变量直接借用字符串s的内存，这样可以减少瞬时内存占用。缺点是代码变得复杂，可读性下降。
2.replace空格的那一段是最慢的，可把它整合到下方的For循环的算法中，可以提高速度。缺点是代码变得复杂，可读性下降。

Option Explicit

'*************************************************************************
'这个模块从网页文件中提取纯文本(只保留基本的格式，不是严格的原样，比如表格等不被支持)
'*************************************************************************

Private Declare Sub CopyMemory Lib "kernel32" Alias _
"RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function GetHTMLText(ByVal sFQFilename As String) As String
'从网页文件中提取纯文本
'INPUT------------------------------------------------------------
'sFQFilename 网页文件的全路径名
'OUTPUT-----------------------------------------------------------
'Return Value 提取的纯文本
'-----------------------------------------------------------------

Const ASCW_LTS As Integer = 60 'ASCW("<"),LTS means Little Than Sign
Const ASCW_GTS As Integer = 62 'ASCW(">")

Dim fn As Integer, s As String 'file number , string buffer
Dim aBufIn() As Integer, aBufOut() As Integer 'input buffer,output buffer
Dim lBufOutPtr As Long 'output buffer pointer
Dim i As Long, lLTSDepth As Long '进入 less than sign 的深度

Dim tmr As Single '计时器

try: On Error GoTo catch
'{
fn = FreeFile
Open sFQFilename For Input Access Read As #fn

tmr = Timer
s = StrConv(InputB$(LOF(fn), fn), vbUnicode)
'picOD.Print "Read From file,use time:" & Timer - tmr

tmr = Timer
'将传统字符去处,在HTML格式中都是无效的字符
s = Replace$(s, vbCrLf, "")

'picOD.Print Timer - tmr

tmr = Timer
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")
s = Replace$(s, " ", "")

'picOD.Print Timer - tmr

tmr = Timer
'将HTML特殊字符替换为传统字符
s = Replace$(s, "

1<br/>

", vbCrLf, , , vbTextCompare)
s = Replace$(s, "

 1<p>", vbCrLf &amp; vbCrLf, , , vbTextCompare)   
 2  
 3'picOD.Print "Replace use time:" &amp; Timer - tmr &amp; " " &amp; Len(s)   
 4  
 5tmr = Timer   
 6  
 7ReDim aBufIn(0 To Len(s) - 1) '分配输入缓冲区的空间，与字符串s,等长   
 8CopyMemory ByVal VarPtr(aBufIn(0)), ByVal StrPtr(s), Len(s) * 2 '复制s   
 9s = "" '释放空间，尽量的保证持续占用空间最小   
10  
11'分配输出缓冲区的空间   
12ReDim aBufOut(LBound(aBufIn) To UBound(aBufIn)) 's已释放，不能再用len(s)规定范围   
13lBufOutPtr = 0: lLTSDepth = 0   
14  
15'picOD.Print "allocate memory use time:" &amp; Timer - tmr   
16  
17tmr = Timer   
18  
19For i = LBound(aBufIn) To UBound(aBufIn) '遍例输入缓冲区的unicode码   
20If aBufIn(i) = ASCW_LTS Then '如果当前为&lt;   
21lLTSDepth = lLTSDepth + 1 '那么深度加1   
22ElseIf aBufIn(i) = ASCW_GTS Then '如果当前为&gt;   
23lLTSDepth = lLTSDepth - 1 '那么深度减1   
24Else '其它字符   
25If lLTSDepth = 0 Then '如果深度为0，表示不在&lt;&gt;中   
26aBufOut(lBufOutPtr) = aBufIn(i) '投入输出缓冲区.   
27'输出缓冲区指针指向当前要投放数据的位置，同时指示了缓冲区中有多少有效数据   
28lBufOutPtr = lBufOutPtr + 1   
29End If   
30End If 
31
32Next i   
33  
34'完成了纯文本抽取，输入缓冲区已经没有用了   
35Erase aBufIn '擦除输入缓冲区，以保证瞬时内存占用最小   
36  
37If lBufOutPtr &gt; 0 Then '如果输出缓冲区的有效元素个数不是0   
38s = Space$(lBufOutPtr) '分配字符串，其大小为lBufOutPtr个字符(Unicode)   
39'把数组缓冲拷贝到字符串的字符数组空间里   
40CopyMemory ByVal StrPtr(s), ByVal VarPtr(aBufOut(0)), lBufOutPtr * 2   
41End If   
42  
43tmr = Timer   
44'后期处理   
45s = Replace$(s, "&lt;", "&lt;", , , vbTextCompare)   
46s = Replace$(s, "&gt;", "&gt;", , , vbTextCompare)   
47s = Replace$(s, "&amp;", "&amp;", , , vbTextCompare)   
48s = Replace$(s, " ", " ", , , vbTextCompare)   
49  
50'picOD.Print "replace after trim use time:" &amp; Timer - tmr &amp; " " &amp; Len(s)   
51  
52GetHTMLText = s   
53'}   
54GoTo finally   
55catch:   
56'{   
57GetHTMLText = ""   
58'}   
59finally:   
60'{   
61Close #fn   
62Erase aBufIn   
63Erase aBufOut   
64'} 
65
66End Function</p>