「WebBrowser」でソースコードを取得するには?
解決お世話になっております。「WebBrowser」についての質問です。
「WebBrowser」コントロールから、現在表示されているページのソースコードを取得するには、どのようにすればよいのですか?
(WebBrowserのContainerプロパティのinnerHTMLなどから一応ソースコードは取れそうなのですが、スペースや改行などが自動的に組みかえられていて、もとのソースコードとは配置が異なっていて、埒が明きませんでした。もとのソースコードそのものを取得したいのですが、お教え願います。)
ご教授よろしくお願いします。
IPersistFileインターフェイスのSaveメソッドを使う必要があります。
Dim oPF As IPersistFile
Set oPF = WebBrowser1.Document
oPF.Save "source.htm", False
なお、WebBrowserコントロールのファイルには、
IPersistFileインターフェイス用のタイプライブラリが
含まれていませんので、別途、参照設定が必要です。
IPersistFileは「参照設定」のどの項目に含まれているのですか?
> IPersistFileインターフェイスのSaveメソッドを使う必要があります。
一度テンポラリファイルに保存するという過程を踏まなければならないということですか?
> IPersistFileは「参照設定」のどの項目に含まれているのですか?
残念ながら、VB用の標準的なライブラリは用意されていません。
ですから MKTYPLIB.EXEなどを使って、*.TLBファイルを自作するか、
もしくは他の方が作られた物を探して、それを利用する事になるでしょう。
私の作った物でも良ければ、下記に含まれる SHELLLNK.TLB ファイルも利用できます。
http://www.ocv.ne.jp/~oratorio/windev/vb/CreateShortcut.CAB
> 一度テンポラリファイルに保存するという過程を踏まなければならないということですか?
という事になりますかね。IEの「ソースの表示」も、一時ファイルを吐いていますし。
ちなみに、タイプライブラリを使わず、COM APIを直接呼び出すのであれば、こんな感じになります。
Private Sub Command1_Click()
If TypeName(WebBrowser1.Document) = "HTMLDocument" Then
With New PersistFile
.SetObject Me.WebBrowser1.Document
.Save "C:\TEST.HTML", False
End With
End If
End Sub
'===== クラスモジュールを追加し、クラス名を PersistFile という名前にしてから、
'===== そこに下記のコードを記述してください。
Option Explicit
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private mudtIPersistFile As UUID 'IID_IPersistFileの格納用
Private Const autCCStdCall = 4
Private Declare Function DispCallFunc Lib "oleaut32" _
(ByVal pvInstance As Long, _
ByVal oVft As Long, _
ByVal CallConv As Integer, _
ByVal vtReturn As Integer, _
ByVal cActuals As Long, _
ByRef prgvt As Integer, _
ByRef prgpvarg As Long, _
ByRef pvargResult As Variant _
) As Long
Private mobjSource As Object
Private mlpPersistFile As Long
'メソッドの位置
Private Const comIUnknown_QueryInterface = 0
Private Const comIUnknown_Release = 8
Private Const comIPersistFile_Save = 24
Private Sub Class_Initialize()
'{0000010b-0000-0000-C000-000000000046}
With mudtIPersistFile
.Data1 = &H10B
.Data4(0) = &HC0
.Data4(7) = &H46
End With
End Sub
Public Sub SetObject(ByVal Source As Object)
Set mobjSource = Source
If Source Is Nothing Then
mlpPersistFile = 0
Else
Dim hResult As Long
If mlpPersistFile <> 0 Then
Call Invoke_(mlpPersistFile, comIUnknown_Release)
mlpPersistFile = 0
End If
hResult = Invoke_(ObjPtr(Source), comIUnknown_QueryInterface, _
VarPtr(mudtIPersistFile), VarPtr(mlpPersistFile))
If hResult < 0 Then
mlpPersistFile = 0
Err.Raise hResult
End If
End If
End Sub
Public Sub Save(ByVal pszFileName As String, ByVal fRemember As Boolean)
Dim bytFileName() As Byte
Dim hResult As Long
Dim lngBool As Long
If mlpPersistFile = 0 Then
'オブジェクト変数またはWithブロック変数が設定されていません。
Err.Raise 91
Exit Sub
End If
bytFileName = pszFileName & vbNullChar
lngBool = IIf(fRemember, 1&, 0&)
hResult = Invoke_(mlpPersistFile, comIPersistFile_Save, _
VarPtr(bytFileName(0)), lngBool)
If hResult <> 0 Then
Err.Raise hResult
End If
End Sub
Private Function Invoke_(ByVal lpObject As Long, ByVal VtblOffset As Long, _
ParamArray Args() As Variant) As Long
Dim lngPtArgs() As Long
Dim intVtArgs() As Integer
Dim varResult As Variant
Dim lngArgs As Long
Dim n As Long
If lpObject = 0 Then
Exit Function
End If
lngArgs = UBound(Args) - LBound(Args) + 1
If lngArgs = 0 Then
ReDim lngPtArgs(0), intVtArgs(0)
Else
ReDim lngPtArgs(lngArgs - 1), intVtArgs(lngArgs - 1)
For n = 0 To lngArgs - 1
intVtArgs(n) = VarType(Args(n))
lngPtArgs(n) = VarPtr(Args(n))
Next
End If
n = 0
n = DispCallFunc(lpObject, VtblOffset, autCCStdCall, _
vbLong, lngArgs, intVtArgs(0), lngPtArgs(0), varResult)
If n >= 0 Then
Invoke_ = CLng(varResult)
End If
End Function
Private Sub Class_Terminate()
Call Invoke_(mlpPersistFile, comIUnknown_Release)
mlpPersistFile = 0
Set mobjSource = Nothing
End Sub
直ぐのレスに非常に感謝しています。更に、お詳しいご説明をお付け加えしていただけて、感謝の限りです。
タイプライブラリの方も、COM APIの方も、やってみます。
遅くなってすみませんでした。
ありがとうございました。ばっちりソースを取得できるようになってました。自分ひとりでは絶対解決できませんでした。感謝の気持ちでいっぱいです。
| ツイート |  |