WebBrowser, полная загрузка pdf

Мне было интересно, знает ли кто-нибудь простой способ иметь.pdf файлы, запускающие readistate при загрузке. Я создаю программу для открытия URL-адреса и скриншотов, а затем помещаю их в excel.

Веб-браузер загрузит html-документы правильно, но застрянет в While Not pageready при загрузке файлов .pdf. Правило браузера корректно отображает .pdf.

Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
 Dim file As String
 Dim Obj As New Object
 Dim result As String
 Dim sheet As String = "sheet1"
 Dim xlApp As New Excel.Application

 If lblpath.Text <> "" Then
 file = lblpath.Text
 Dim xlWorkBook = xlApp.Workbooks.Open(file)
 Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
 Dim range = xlWorkSheet.UsedRange

 ProgressBar1.Value = 0

 For rCnt = 4 To range.Rows.Count
 'url cell
 Obj = CType(range.Cells(rCnt, 2), Excel.Range)
 ' Obj.value now contains the value in the cell.. 
 Try
 ' Creates an HttpWebRequest with the specified URL. 
 Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
 ' Sends the request and waits for a response. 
 Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
 If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
 result = myHttpWebResponse.StatusCode
 WebBrowser1.ScrollBarsEnabled = False
 WebBrowser1.Navigate(myHttpWebRequest.RequestUri)

 WaitForPageLoad()

 CaptureWebBrowser(WebBrowser1)
 End If
 ' Release the resources of the response.
 myHttpWebResponse.Close()

 Catch ex As WebException
 result = (ex.Message)
 Catch ex As Exception
 result = (ex.Message)
 End Try


 RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)

 If radpre.Checked = True Then
 range.Cells(rCnt, 3).value = result
 ElseIf radcob.Checked = True Then
 range.Cells(rCnt, 4).value = result
 ElseIf radpost.Checked = True Then
 range.Cells(rCnt, 5).value = result

 End If


 ProgressBar1.Value = rCnt / range.Rows.Count * 100
 Next

 With xlApp
 .DisplayAlerts = False
 xlWorkBook.SaveAs(lblpath.Text.ToString)
 .DisplayAlerts = True
 End With

 xlWorkBook.Close()
 xlApp.Quit()

 'reclaim memory
 Marshal.ReleaseComObject(xlApp)
 xlApp = Nothing
 End If
End Sub

Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image
 Try
 Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
 wb.DrawToBitmap(hBitmap, wb.Bounds)
 Dim img As Image = hBitmap
 Return img
 Catch ex As Exception
 MessageBox.Show(ex.Message)
 End Try
 Return Nothing
End Function


Private Sub WaitForPageLoad()
 AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
 While Not pageready
 Application.DoEvents()
 End While
 pageready = False
End Sub

Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
 If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
 pageready = True
 RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
 End If
End Sub

обновить до разрешенных

Я очень доволен обратной связью. Мне очень нравится, как ответ, предоставленный Носератио. Я не знал, используя код, как не в лучших практиках. При открытии.pdf или любого другого документа, не основанного на Интернете, readyState никогда не будет изменяться с 0. Видя, как эта программа просто способ для меня не работать на работе, я доволен только захватом .html и .htm.

Мои требования были

  1. открыть документ excel
  2. анализировать ссылки, расположенные в документе excel
  3. определить код ответа
  4. напишите код ответа и, если возможно, снимок экрана, чтобы преуспеть

Программа анализирует и получает обратную связь гораздо быстрее, чем я мог бы сделать вручную. Скриншоты из .html и .htm предоставляют нетехнические зрители файла excel, подтверждающие успешную миграцию из производства в COB и обратно в производственные среды.

Этот код, как указано Noseratio, не соответствует передовым методам и не является высоким качеством. Это быстрое и грязное выполнение.

Option Infer On
Imports Microsoft.Office.Interop
Imports System.Net
Imports System.Runtime.InteropServices

Public Class Form1


Public Property pageready As Boolean

Private Sub OpenToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles OpenToolStripMenuItem.Click
 OpenFileDialog1.ShowDialog()
End Sub

Private Sub OpenFileDialog1_FileOk(ByVal sender As System.Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles OpenFileDialog1.FileOk
 lblpath.Text = OpenFileDialog1.FileName.ToString
End Sub

Private Sub btngo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btngo.Click
 Dim file As String
 Dim Obj As New Object
 Dim result As String
 Dim sheet As String = "sheet1"
 Dim xlApp As New Excel.Application
 Dim img As Bitmap
 Dim path As String = "C:\Documents and Settings\user\My Documents\Visual Studio 2010\Projects\COB-HTML-Tool\COB-HTML-Tool\bin\Debug\tmp.bmp"
 If lblpath.Text <> "" Then
 file = lblpath.Text
 Dim xlWorkBook = xlApp.Workbooks.Open(file)
 Dim xlWorkSheet = xlWorkBook.Worksheets(sheet)
 Dim range = xlWorkSheet.UsedRange

 ProgressBar1.Value = 0

 For rCnt = 4 To range.Rows.Count
 'url cell
 Obj = CType(range.Cells(rCnt, 2), Excel.Range)
 ' Obj.value now contains the value in the cell.. 
 Try
 ' Creates an HttpWebRequest with the specified URL. 
 Dim myHttpWebRequest As HttpWebRequest = CType(WebRequest.Create(Obj.value), HttpWebRequest)
 ' Sends the request and waits for a response. 
 Dim myHttpWebResponse As HttpWebResponse = CType(myHttpWebRequest.GetResponse(), HttpWebResponse)
 If myHttpWebResponse.StatusCode = HttpStatusCode.OK Then
 result = myHttpWebResponse.StatusCode


 Dim len As Integer = myHttpWebRequest.RequestUri.ToString.Length - 4
 If myHttpWebRequest.RequestUri.ToString.Substring(len) = ".htm" Or
 myHttpWebRequest.RequestUri.ToString.Substring(len - 1) = ".html" Or
 myHttpWebRequest.RequestUri.ToString.Substring(len) = ".asp" Then
 WebBrowser1.Navigate(myHttpWebRequest.RequestUri)
 WaitForPageLoad()

 img = CaptureWebBrowser(WebBrowser1)
 img.Save(path)
 End If

 End If
 ' Release the resources of the response.
 myHttpWebResponse.Close()

 Catch ex As WebException
 result = (ex.Message)
 Catch ex As Exception
 result = (ex.Message)
 End Try


 RichTextBox1.AppendText(result & " " & Obj.value & vbNewLine)

 If radpre.Checked = True Then
 range.Cells(rCnt, 3).value = result

 If img Is Nothing Then
 Else
 If Dir(path) <> "" Then
 range.Cells(rCnt, 4).Select()
 Dim opicture As Object
 opicture = xlApp.ActiveSheet.Pictures.Insert(path)
 opicture.ShapeRange.LockAspectRatio = True
 opicture.ShapeRange.width = 170
 opicture.ShapeRange.height = 170
 My.Computer.FileSystem.DeleteFile(path)

 End If
 End If
 ElseIf radcob.Checked = True Then
 range.Cells(rCnt, 5).value = result
 If img Is Nothing Then
 Else
 If Dir(path) <> "" Then
 range.Cells(rCnt, 6).Select()
 Dim opicture As Object
 opicture = xlApp.ActiveSheet.Pictures.Insert(path)
 opicture.ShapeRange.LockAspectRatio = True
 opicture.ShapeRange.width = 170
 opicture.ShapeRange.height = 170
 My.Computer.FileSystem.DeleteFile(path)
 End If
 End If
 ElseIf radpost.Checked = True Then
 range.Cells(rCnt, 7).value = result
 If img Is Nothing Then
 Else
 If Dir(path) <> "" Then
 range.Cells(rCnt, 8).Select()
 Dim opicture As Object
 opicture = xlApp.ActiveSheet.Pictures.Insert(path)
 opicture.ShapeRange.LockAspectRatio = True
 opicture.ShapeRange.width = 170
 opicture.ShapeRange.height = 170
 My.Computer.FileSystem.DeleteFile(path)
 End If
 End If
 End If


 ProgressBar1.Value = rCnt / range.Rows.Count * 100
 Next

 With xlApp
 .DisplayAlerts = False
 xlWorkBook.SaveAs(lblpath.Text.ToString)
 .DisplayAlerts = True
 End With

 xlWorkBook.Close()
 xlApp.Quit()

 'reclaim memory
 Marshal.ReleaseComObject(xlApp)
 xlApp = Nothing
 End If
End Sub
Private Function CaptureWebBrowser(ByVal wb As WebBrowser) As Image

 Try
 wb.ScrollBarsEnabled = False
 Dim hBitmap As Bitmap = New Bitmap(wb.Width, wb.Height)
 wb.DrawToBitmap(hBitmap, wb.Bounds)
 Dim img As Image = hBitmap
 Return img
 Catch ex As Exception
 MessageBox.Show(ex.Message)
 End Try
 Return Nothing
End Function


Private Sub WaitForPageLoad()
 AddHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
 While Not pageready
 Application.DoEvents()
 System.Threading.Thread.Sleep(200)
 End While
 pageready = False
End Sub

Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
 If WebBrowser1.ReadyState = WebBrowserReadyState.Complete Then
 pageready = True
 RemoveHandler WebBrowser1.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
 End If
End Sub


End Class
1 ответ

К сожалению, вы не сможете использовать webBrowser.DrawToBitmap для получения моментального снимка в формате PDF. На момент написания этого документа элемент управления Adobe Acrobat Reader ActiveX не поддерживает рендеринг в пользовательском контексте устройства, поэтому этот метод не будет работать, а также отправка WM_PRINT или вызов IViewObject::Draw либо непосредственно на объект Reader ActiveX через WebBrowser (я пробовал это, и я не одинок). Правильным решением будет использование стороннего компонента рендеринга PDF.

На стороне примечания, вы должны избегать использования шаблона кода следующим образом:

While Not pageready
 Application.DoEvents()
End While

Это напряженный цикл ожидания, потребляющий циклы процессора напрасно. По крайней мере, поставьте часть Thread.Sleep(200) внутри цикла, но в целом вы также должны избегать использования Application.DoEvents.

licensed under cc by-sa 3.0 with attribution.