利用Webbrowser类实现超长网页的截屏的实现（解决报错不能截取的难题）

之前写过一篇文章，说是解决了超长网页截图的问题。但是实际上，现实是很残酷的，试图截取一个网页的时候就出了问题

网址如下：

/content/3695261.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

虽然速度上还是有点慢，不过截图的效果还是不错的。文章开篇的网址也能顺利的截取下来。着文以记之。

作者：万仓一黍
出处：http://grenet.cnblogs.com/
本文版权归作者和博客园共有，欢迎转载，但未经作者同意必须保留此段声明，且在文章页面明显位置给出原文连接，否则保留追究法律责任的权利。