网上时常有些评论说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, "<br>", vbCrLf, , , vbTextCompare)
s = Replace$(s, "<p>", vbCrLf & vbCrLf, , , vbTextCompare)
'picOD.Print "Replace use time:" & Timer - tmr & " " & Len(s)
tmr = Timer
ReDim aBufIn(0 To Len(s) - 1) '分配输入缓冲区的空间,与字符串s,等长
CopyMemory ByVal VarPtr(aBufIn(0)), ByVal StrPtr(s), Len(s) * 2 '复制s
s = "" '释放空间,尽量的保证持续占用空间最小
'分配输出缓冲区的空间
ReDim aBufOut(LBound(aBufIn) To UBound(aBufIn)) 's已释放,不能再用len(s)规定范围
lBufOutPtr = 0: lLTSDepth = 0
'picOD.Print "allocate memory use time:" & Timer - tmr
tmr = Timer
For i = LBound(aBufIn) To UBound(aBufIn) '遍例输入缓冲区的unicode码
If aBufIn(i) = ASCW_LTS Then '如果当前为<
lLTSDepth = lLTSDepth + 1 '那么深度加1
ElseIf aBufIn(i) = ASCW_GTS Then '如果当前为>
lLTSDepth = lLTSDepth - 1 '那么深度减1
Else '其它字符
If lLTSDepth = 0 Then '如果深度为0,表示不在<>中
aBufOut(lBufOutPtr) = aBufIn(i) '投入输出缓冲区.
'输出缓冲区指针指向当前要投放数据的位置,同时指示了缓冲区中有多少有效数据
lBufOutPtr = lBufOutPtr + 1
End If
End If
Next i
'完成了纯文本抽取,输入缓冲区已经没有用了
Erase aBufIn '擦除输入缓冲区,以保证瞬时内存占用最小
If lBufOutPtr > 0 Then '如果输出缓冲区的有效元素个数不是0
s = Space$(lBufOutPtr) '分配字符串,其大小为lBufOutPtr个字符(Unicode)
'把数组缓冲拷贝到字符串的字符数组空间里
CopyMemory ByVal StrPtr(s), ByVal VarPtr(aBufOut(0)), lBufOutPtr * 2
End If
tmr = Timer
'后期处理
s = Replace$(s, "<", "<", , , vbTextCompare)
s = Replace$(s, ">", ">", , , vbTextCompare)
s = Replace$(s, "&", "&", , , vbTextCompare)
s = Replace$(s, " ", " ", , , vbTextCompare)
'picOD.Print "replace after trim use time:" & Timer - tmr & " " & Len(s)
GetHTMLText = s
'}
GoTo finally
catch:
'{
GetHTMLText = ""
'}
finally:
'{
Close #fn
Erase aBufIn
Erase aBufOut
'}
End Function