利用Webbrowser類實現超長網頁的截屏的實現（解決報錯不能截取的難題）－互聯網

之前寫過一篇文章，說是解決了超長網頁截圖的問題。但是實際上，現實是很殘酷的，試圖截取一個網頁的時候就出了問題

網址如下：

http://www.cnblogs.com/grenet/archive/2012/09/05/2664309.html

截這個網頁圖的時候，總是報錯，說是無效的參數

后來分析代碼發現，這個網頁的大小為1024px*81175px。當時，一激靈，立刻想到是不是太長了，超過系統的默認范圍。查了資料后，在MSDN上有一處說到GDI+的bitmap對象在保存為PNG格式的時候，單維不能超過65536，但是并沒有說其它格式也有類似的局限。于是，自已做了一個實驗，構造一個bitmap對象，大小1024px*80000px，保存為PNG格式，系統報錯；保存為JPG格式，系統報錯；保存為bmp格式，系統沒有報錯，但是在其他的軟件中不能打開。于是，筆者堅信一點

GDI+中的bitmap對象處理的單維不能超過65526

很顯然，上面的網址，用GDI+來截取的話，肯定是不能截取到一張圖片上了

有一點，在機器上用FF瀏覽器瀏覽網頁，發現右上角有一個“網頁截圖”的插件，于是嘗試用FF截取上面的網址，發現絲毫沒有反映。筆者嘗試截取其他的網址以證實不是筆者自己的誤操作問題，其他網頁截取正常。說明了一點

截取超長網頁（長度超過65536）是個難題

于是，反思自己截圖的意圖。

為何要截圖？截圖是為了保存網頁，以便日后再看，避免網址失效的尷尬。那有的人就會說，沒和不保存網頁（MHT格式或其他格式）。

保存網頁或多或少都有各種問題

用IE保存網頁的時候，Flash只是保存鏈接地址，而不是保存swf文件

有的網頁中的內容是通過JS用Ajax方式后臺讀取呈現，這部分在保存網頁的時候，僅僅保存了JS代碼，而沒有保存JS用Ajax方式后臺讀取的內容

有的網頁在JS中再動態調用CSS或其他的JS代碼，這部分在保存網頁的時候，也僅僅是保存了JS代碼，而動態調用的CSS和JS代碼什么的都沒有保存

上述這些情況，都是以保存鏈接地址的形式（swf地址或者是JS地址）出現的

在日后瀏覽的時候，如果是在一臺沒有聯網的機器上，會出現兩種情況。一是：由于保存了鏈接地址，于是會嘗試讀取這些地址，而這些地址又沒法讀取（沒聯網或者是鏈接地址失效），則會導致長時間的假死狀態（尤其以IE保存的網頁為甚）；二是：由于缺失部分的文件（swf文件、CSS文件、JS文件等），導致頁面的結構出現了變形（甚至是無法忍受的地步）。

這也就是為什么要截圖的原因，圖是靜止的，不會出現上述的情況

還是要截圖的，截超長網頁的圖的一種辦法就是分開截圖，截成若干個圖

于是把之前的代碼改寫一下，把原來多次截圖，后覆寫到一張圖片，改寫為多次截圖，把多個bitmap對象存入到一個對象

于是信心滿滿的嘗試文章開始的網址，天啊，還是報錯

在截超長網頁的時候，在截60000+這部分的時候，Webbrowser類的DrawToBitmap函數就會報錯，說是無效的參數。無效的參數？沒道理呀，若是參數無效，在截0+和20000+的時候就會報錯，怎么會到60000+的時候報錯呢？而且是每次到60000+都會報錯，排除了系統隨機性錯誤的問題（有時在截一些網頁的時候，也會報參數無效的錯誤，但是重啟軟件后，就不會報錯）

突然有一個想法，會不會是Webbrowser類的DrawToBitmap方法有資源沒有釋放，在同一個Webbrowser的實例中的DrawToBitmap方法執行完后，沒有釋放資源，所以當上面的代碼嘗試截取60000+的時候，超過了DrawToBitmap方法的資源限制，于是報了錯誤。如果能嘗試釋放DrawToBitmap方法所占的資源是不是就可以呢？在網上找了一圈后，沒有發現釋放DrawToBitmap方法所占的資源的問題。這真是一個超級難題了。

有一個笨辦法涌上心頭。一個Webbrowser實例不能解決超長網頁的截圖問題，多個Webbrowser實例能不能解決該問題呢？將一個網頁分成幾個部分，每個部分分給一個Webbrowser實例去截圖，最后將這些截圖再存入到一個對象。這樣做的優點是：如果成功，解決了超長網頁的截圖問題；缺點是：每個部分都分給一個Webbrowser類的實例去截圖，每個實例都需要訪問同一個網址，造成了重復訪問，形成了資源浪費。不過，目前最重要的是實現超長網頁的截圖。

于是，修改代碼。

進行截圖實驗。嗯。這樣終于成功了。

下面是修改后代碼。由于功能上的需要，我對代碼進行了擴展

Public Class clsCaptureWebSettings
    Public Url As String
    Public TimeOut As Integer
    Public Width As Integer
    Public Delay As Integer
    Public HtmlElementID() As String = {}

    Public Sub New(Url As String, Optional Delay As Integer = 15, Optional TimeOut As Integer = 180, Optional Width As Integer = 1024)
        Me.Url = Url
        Me.TimeOut = TimeOut
        Me.Width = Width
        Me.Delay = Delay
        Me.HtmlElementID = {}
    End Sub

    Public Sub New(Url As String, ID As String, Optional Delay As Integer = 15, Optional TimeOut As Integer = 180, Optional Width As Integer = 1024)
        Dim tS(0) As String
        tS(0) = ID
        Me.Url = Url
        Me.TimeOut = TimeOut
        Me.Width = Width
        Me.Delay = Delay
        Me.HtmlElementID = tS
    End Sub

    Public Sub New(Url As String, ID() As String, Optional Delay As Integer = 15, Optional TimeOut As Integer = 180, Optional Width As Integer = 1024)
        Me.Url = Url
        Me.TimeOut = TimeOut
        Me.Width = Width
        Me.Delay = Delay
        Me.HtmlElementID = ID
    End Sub

End Class

clsCaptureWebSettings類，截取網頁的參數類，有如下的幾個參數：

URL

網頁截圖的網址。注：有些網頁要提供Cookies或者是Session才能訪問，這部分目前還沒有做到。

Delay

網頁截圖的延遲。由于有部分網頁會利用AJAX技術填充內容，而Webbrowser類又不能很好的判斷AJAX技術的結束時刻，故統一一個延遲時間，等延遲時間結束以后再截圖。默認是15秒。注：由于有的超長網頁會交給幾個Webbrowser類截圖，每個Webbrowser類的延遲時間都是由Delay決定的，故在截超長網頁的時候，會顯得比較漫長，但是用了Delay參數以后，截圖的效果好了很多。

TimeOut

網頁截圖的超時。在訪問某些網站的時候，由于種種原因，導致訪問失敗。設置這個參數避免在訪問失敗的時候，程序陷入假死情況。默認是180秒

Width

網頁截圖的寬度。由于網頁的布局都是豎式布局，故先指定寬度，再截圖。默認是1024，現今的網頁基本上都兼容1024的寬度

HtmlElementID

網頁截圖中的目標ID。我們在截網頁的時候，有時特別想只截其中的一部分（例如，不想截取包含廣告的部分），我們可以提供網頁上的元素的ID，返回該元素在網頁上的位置（Rectangle結構）。該參數是字符串的數組，數組中每個元素就是網頁上元素的ID。注意：程序中只返回能找到的元素的位置，如果沒有找到，則直接忽略掉

Public Class clsCaptureImages
    Private _Bmp As List(Of Bitmap)
    Private _Rect As Dictionary(Of String, Rectangle)
    Private _HeightPerImage As Integer

    Public Sub New()
        Me.New(20000)
    End Sub

    Public Sub New(HeightPerImage As Integer)
        _HeightPerImage = HeightPerImage
        _Bmp = New List(Of Bitmap)
        _Rect = New Dictionary(Of String, Rectangle)
    End Sub

    Public Sub AddBitmap(Bmp As Bitmap)
        _Bmp.Add(Bmp)
    End Sub

    Public Sub AddRect(ID As String, R As Rectangle)
        If _Rect.ContainsKey(ID) = True Then
            _Rect(ID) = R
        Else
            _Rect.Add(ID, R)
        End If
    End Sub

    Public Function ImageRect() As Rectangle
        If _Bmp.Count = 0 Then Return New Rectangle(0, 0, 0, 0)

        Dim Width As Integer = _Bmp(0).Width
        Dim Height As Integer = _HeightPerImage * (_Bmp.Count - 1) + _Bmp(_Bmp.Count - 1).Height

        Return New Rectangle(0, 0, Width, Height)
    End Function

    Private Function GetRectImage(R As Rectangle) As Bitmap
        Dim tB As New Bitmap(R.Width, R.Height)

        Using tG As Graphics = Graphics.FromImage(tB)
            Dim I As Integer = Int(R.Y / _Bmp(0).Height)
            Dim J As Integer = Int((R.Bottom - 1) / _Bmp(0).Height)
            Dim K As Integer
            If I = J Then
                R.Y = R.Y Mod _Bmp(0).Height
                tG.DrawImage(_Bmp(I), 0, 0, R, GraphicsUnit.Pixel)
            Else
                Dim tR As Rectangle = R
                tR.Y = tR.Y Mod _Bmp(0).Height
                tR.Height = _Bmp(0).Height - tR.Y

                tG.DrawImage(_Bmp(I), 0, 0, tR, GraphicsUnit.Pixel)

                Dim tTop As Integer = tR.Height

                For K = I + 1 To J - 1 Step 1
                    tR = R
                    tR.Y = 0
                    tR.Height = _Bmp(0).Height
                    tG.DrawImage(_Bmp(K), 0, tTop, tR, GraphicsUnit.Pixel)
                    tTop += tR.Height
                Next

                tR = R
                tR.Height = (tR.Bottom - 1) Mod _Bmp(0).Height + 1
                tR.Y = 0

                tG.DrawImage(_Bmp(J), 0, tTop, tR, GraphicsUnit.Pixel)
            End If
        End Using

        Return tB
    End Function

    Public Function RenderImage(R As Rectangle, HeightPerImage As Integer) As List(Of Bitmap)
        Dim tR As Rectangle = ImageRect()
        If _Bmp.Count = 0 OrElse R.IntersectsWith(tR) = False Then Return New List(Of Bitmap)
        R.Intersect(tR)

        If R.Equals(tR) = True AndAlso HeightPerImage = _HeightPerImage Then Return _Bmp

        Return RenderImageBase(R, HeightPerImage)
    End Function

    Public Function RenderImage(R As Rectangle) As List(Of Bitmap)
        Return RenderImage(R, _HeightPerImage)
    End Function

    Public Function RenderImage(HeightPerImage As Integer) As List(Of Bitmap)
        If _Bmp.Count = 0 Then Return New List(Of Bitmap)
        If HeightPerImage = _HeightPerImage Then Return _Bmp

        Return RenderImageBase(ImageRect, HeightPerImage)
    End Function

    Public Function RenderImage() As List(Of Bitmap)
        Return _Bmp
    End Function

    Private Function RenderImageBase(R As Rectangle, HeightPerImage As Integer) As List(Of Bitmap)
        Dim tR As Rectangle = R
        tR.Height = HeightPerImage

        Dim BmpList As New List(Of Bitmap)

        Do While R.IntersectsWith(tR) = True
            tR.Intersect(R)
            BmpList.Add(GetRectImage(tR))
            tR.Offset(0, HeightPerImage)
        Loop

        Return BmpList
    End Function

    Public Function RenderImage(HeightPerImage As Integer, ID1 As String) As List(Of Bitmap)
        If _Rect.ContainsKey(ID1) = False Then Return New List(Of Bitmap)
        Return RenderImage(_Rect(ID1), HeightPerImage)
    End Function

    Public Function RenderImage(ID1 As String) As List(Of Bitmap)
        If _Rect.ContainsKey(ID1) = False Then Return New List(Of Bitmap)
        Return RenderImage(_Rect(ID1), _HeightPerImage)
    End Function

    Public Function RenderImage(ID1 As String, ParamArray ID() As String) As List(Of Bitmap)
        Return RenderImage(_HeightPerImage, ID1, ID)
    End Function

    Public Function RenderImage(HeightPerImage As Integer, ID1 As String, ParamArray ID() As String) As List(Of Bitmap)
        Dim HasRect As Boolean = False
        Dim R As Rectangle

        If _Rect.ContainsKey(ID1) = True Then
            HasRect = True
            R = _Rect(ID1)
        End If

        Dim I As Integer
        For I = 0 To ID.Length - 1
            If _Rect.ContainsKey(ID(I)) = True Then
                If HasRect = True Then
                    R = Rectangle.Union(R, _Rect(ID(I)))
                Else
                    HasRect = True
                    R = _Rect(ID(I))
                End If
            End If
        Next

        If HasRect = False Then Return New List(Of Bitmap)

        Return RenderImage(R, HeightPerImage)
    End Function

End Class

clsCaptureImages類，保存截圖結果的類，由于超長網頁不能截在一張圖里，故用一個類保存截圖的結果。并提供一些擴展的功能

AddBitmap方法

Public Sub AddBitmap(Bmp As Bitmap)

把截好的圖片添加到類中

AddRect方法

Public Sub AddRect(ID As String, R As Rectangle)

把ID對應的位置Rectangle添加到類中

RenderImage函數，返回圖像的集合。并可以根據某些參數定制圖像集合。例如：只想獲得某個Rectangle的范圍的圖像；只想獲得某個ID的元素的圖像；按照指定的高度劃分圖像集合等等。如果我把截圖放在Word里的話，最好每張的圖片的高度不超過1200

返回值：根據參數返回圖像的集合List(Of Bitmap)

它有如下的幾個重載方式：

Public Function RenderImage() As List(Of Bitmap)

不加修飾，直接把圖像集合返回。默認的圖像集合中的每張圖像的高度是20000

Public Function RenderImage(R As Rectangle) As List(Of Bitmap)

返回指定區域R的截圖圖像集合。程序會先計算整個圖像的范圍（利用ImageRect函數），然后返回的是R和ImageRect交集的圖像集合，按照默認的高度（20000）劃分每張圖片

Public Function RenderImage(HeightPerImage As Integer) As List(Of Bitmap)

返回圖像集合，每張圖片的高度由HeightPerImage參數決定。這個在將來要把圖像放在Word里特別有用。

Public Function RenderImage(R As Rectangle, HeightPerImage As Integer) As List(Of Bitmap)

返回指定區域R的截圖圖像集合。程序會先計算整個圖像的范圍（利用ImageRect函數），然后返回的是R和ImageRect交集的圖像集合，按照參數HeightPerImage指定的高度劃分每張圖片的高度

Public Function RenderImage(ID1 As String) As List(Of Bitmap)

返回指定ID1的元素所在位置的截圖圖像集合。ID1所在的位置在之前的AddRect方法中添加到類中。如果沒有找到ID1對應的位置，則返回空的集合。每張圖像的高度由默認值（20000）決定

Public Function RenderImage(HeightPerImage As Integer, ID1 As String) As List(Of Bitmap)

返回指定ID1的元素所在位置的截圖圖像集合，每張圖像的高度由HeightPerImage決定。

Public Function RenderImage(ID1 As String, ParamArray ID() As String) As List(Of Bitmap)

返回指定ID1和ID的元素所在位置的截圖圖像集合。如果所有的ID指定的位置都不存在，返回空集合，否則返回存在的ID所在位置的并集所在位置的圖像集合。每張圖像的高度由默認值（20000）決定

Public Function RenderImage(HeightPerImage As Integer, ID1 As String, ParamArray ID() As String) As List(Of Bitmap)

返回指定ID1和ID的元素所在位置的截圖圖像集合。如果所有的ID指定的位置都不存在，返回空集合，否則返回存在的ID所在位置的并集所在位置的圖像集合。每張圖像的高度由HeightPerImage決定

Public Class clsCaptureWebEx

    Public Shared Function CaptureWebEx(Settings As clsCaptureWebSettings) As clsCaptureImages
        Dim _Images As New clsCaptureImages
        Dim I As Integer, J As Integer
        Const WEB_HEIGHT As Integer = 20000

        J = 0
        J = CaptureWebEx(_Images, Settings, J)

        I = WEB_HEIGHT

        Do While I < J
            CaptureWebEx(_Images, Settings, I)
            I += WEB_HEIGHT
        Loop

        Return _Images
    End Function

    Private Shared Function CaptureWebEx(_Images As clsCaptureImages, _Settings As clsCaptureWebSettings, _CapTop As Integer) As Integer
        Dim _Bmp As Bitmap
        Dim _WebHeight As Integer

        Const WEB_HEIGHT As Integer = 20000
        Using _Web As New WebBrowser
            _Web.ScrollBarsEnabled = False
            _Web.Width = _Settings.Width
            _Web.Height = WEB_HEIGHT

            Dim _Time As Date = Now.AddSeconds(_Settings.Delay)
            _Web.Navigate(_Settings.Url)

            Do Until Now > _Time
                Application.DoEvents()
            Loop

            _Time = Now.AddSeconds(_Settings.TimeOut - _Settings.Delay)

            Do Until (_Web.ReadyState = WebBrowserReadyState.Complete) OrElse (Now > _Time)
                Application.DoEvents()
            Loop

            _Web.Stop()

            If _Web.Document.Body Is Nothing Then
                _WebHeight = 500
            Else
                _WebHeight = _Web.Document.Body.ScrollRectangle.Height
                If _WebHeight < 20000 Then _Web.Height = _WebHeight
            End If

            If _CapTop = 0 AndAlso _Settings.HtmlElementID.Length > 0 Then
                Dim tHtml As HtmlElement
                Dim tR As Rectangle

                For i = 0 To _Settings.HtmlElementID.Length - 1
                    If _Settings.HtmlElementID(i) <> "" Then
                        tHtml = _Web.Document.GetElementById(_Settings.HtmlElementID(i))
                        If Not tHtml Is Nothing Then
                            tR = tHtml.ScrollRectangle
                            Do While Not (tHtml = _Web.Document.Body)
                                tR.X += tHtml.OffsetRectangle.X
                                tR.Y += tHtml.OffsetRectangle.Y
                                tHtml = tHtml.Parent
                            Loop
                            _Images.AddRect(_Settings.HtmlElementID(i), tR)
                        End If
                    End If
                Next
            End If

            Dim R As Rectangle = New Rectangle(0, 0, _Web.Width, _Web.Height)

            _Web.Document.Window.Parent.ScrollTo(0, _CapTop)
            If _Web.Document.Body.Parent.ScrollTop = _CapTop Then
                _Bmp = New Bitmap(_Web.Width, _Web.Height)

                _Web.DrawToBitmap(_Bmp, R)
            Else
                _Web.Height = _Web.Height - (_CapTop - _Web.Document.Body.Parent.ScrollTop)
                _Web.Document.Window.Parent.ScrollTo(0, _CapTop)
                _Bmp = New Bitmap(_Web.Width, _Web.Height)
                R.Height = _Web.Height
                _Web.DrawToBitmap(_Bmp, R)
            End If

        End Using

        _Images.AddBitmap(_Bmp)
        Return _WebHeight
    End Function
End Class

clsCaptureWebEx類，網頁截圖的核心類，根據clsCaptureWebSettings類指定的參數截圖，并把結果寫入到clsCaptureImages類

該類有兩個函數，公有函數

Public Shared Function CaptureWebEx(Settings As clsCaptureWebSettings) As clsCaptureImages

截圖的主函數，根據參數截圖，并把結果寫入到結果類中

由于每個Webbrowser類的實例不能截超過60000的截圖，故根據網頁的高度多次調用私有函數CaptureWebEx，每調用一次，就截一次圖

私有函數

Private Shared Function CaptureWebEx(_Images As clsCaptureImages, _Settings As clsCaptureWebSettings, _CapTop As Integer) As Integer

截圖的具體負責函數，在該函數類有一個Webbrowser類的實例，從_CapTop參數指定的位置開始截一張圖（每個Webbrowser類不能截太多的圖），并把結果添加到_Images中，返回的是網頁的高度

特別說明一下

            If _CapTop = 0 AndAlso _Settings.HtmlElementID.Length > 0 Then
                Dim tHtml As HtmlElement
                Dim tR As Rectangle

                For i = 0 To _Settings.HtmlElementID.Length - 1
                    If _Settings.HtmlElementID(i) <> "" Then
                        tHtml = _Web.Document.GetElementById(_Settings.HtmlElementID(i))
                        If Not tHtml Is Nothing Then
                            tR = tHtml.ScrollRectangle
                            Do While Not (tHtml = _Web.Document.Body)
                                tR.X += tHtml.OffsetRectangle.X
                                tR.Y += tHtml.OffsetRectangle.Y
                                tHtml = tHtml.Parent
                            Loop
                            _Images.AddRect(_Settings.HtmlElementID(i), tR)
                        End If
                    End If
                Next
            End If
這段代碼的作用是獲得網頁上指定ID的位置Rectangle，由于在VS中，沒辦法直接獲得ID元素的位置，ScrollRectangle屬性指的是和它父元素的相對位置。故采用遞推的方式獲得該元素對應的位置

下面是調用的代碼，ID為topics是我的博客的博客正文的元素。這樣截圖只會截我的博客的正文，而其他的廣告之類的就不會再截了。RenderImage函數的參數1125，是為了將來把圖片放入到Word方便。

     Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        Dim _WebImage As clsCaptureImages = clsCaptureWebEx.CaptureWebEx(New clsCaptureWebSettings(txtURL.Text, "topics"))

        Dim tB As Bitmap, I As Integer = 0, H As Integer = 0

        Dim tS As New System.Text.StringBuilder

        For Each tB In _WebImage.RenderImage(1125, "topics")
            tB.Save(String.Format("tBmp{0}.png", I), System.Drawing.Imaging.ImageFormat.Png)

            tS.AppendFormat("<div><img src='tBmp{0}.png' /></div>", I)

            I += 1
            H += tB.Height
        Next

        My.Computer.FileSystem.WriteAllText("tmp.html", tS.ToString, False)

        Me.WebBrowser1.Navigate(Application.StartupPath & "\tmp.html")

    End Sub