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

王朝html/css/js·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

网上时常有些评论说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, "&lt;", "<", , , vbTextCompare)

s = Replace$(s, "&gt;", ">", , , vbTextCompare)

s = Replace$(s, "&amp;", "&", , , vbTextCompare)

s = Replace$(s, "&nbsp;", " ", , , 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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航