分享
 
 
 

从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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有