從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, "<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