● IHTMLDocumentを作成＆使用してHTMLを操作する ●
サンプルソース：ダウンロード (24KB)

ブラウザを起動して、HTMLソースを丸々送信して表示する。HTMLファイルを作らなくて良いので時に有用。VB5.0は IHTMLDocument 専用のデータ型が用意されておらず、すべて Object となる。色々と不便ではあるが、それでも動いてくれるので、問題なし。

IHTMLDocument と言えばいいのか、HTMLDocumentと言えばいいのか、正確な表現は分からないが、以降は HTMLDocument とする。

主要なロジックは以下の通り。引数にIEのクライアント領域のウィンドウハンドルを渡すのであるが、このハンドルを取得するのが非常に大変である。そのあたりはソースを参照するべし。関数が成功すると HTMLDocument オブジェクトが返る。これに対してHTMLソースを設定することで、ブラウザに任意の表現を表示することが出来る。

'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'機  能：IEのクライアント領域のウィンドウハンドルからHTMLDocumentオブジェクトを取得する
'引  数：(i)hWnd … IEのクライアント領域のウィンドウハンドル
'返り値：〜 (略) 〜 からHTMLDocumentオブジェクト
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
Private Function GetHTMLObject(ByVal hWnd As Long) As Object
    Dim MsghWnd As Long
    Dim ResultValue As Long
    Dim FuncRet As Long
    Dim udtUUID As UUID

    'ウィンドウメッセージ登録
    MsghWnd = RegisterWindowMessage("WM_HTML_GETOBJECT")
    If MsghWnd = 0 Then Exit Function

    'メッセージ送信＆結果取得
    Call SendMessageTimeout(hWnd, MsghWnd, 0&, ByVal 0&, SMTO_ABORTIFHUNG, 1000, ResultValue)
    If ResultValue = 0 Then Exit Function

    'UUID変換
    FuncRet = IIDFromString(IHTMLDocumentUUID2, udtUUID)

    'HTMLDocumentオブジェクトを取得する
    Call ObjectFromLresult(ResultValue, VarPtr(udtUUID), 0, GetHTMLObject)
End Function

◆HTMLソースを直接送り込む場合

Dim HTMLObj As Object
'HTMLSource 変数に <html>から</html>までのHTMLを設定してWriteし、そしてClose(←重要)する
Call HTMLObj.Write(HTMLSource)
Call HTMLObj.Close 
Set HTMLObj = Nothing

◆bodyタグ内の値を書き換えたい場合

With HTMLObj
    'ドキュメントタイトル
    .Title = "IHTMlDocument をいじってみるテスト"

    'キャラセット
    .Charset = "Shift_JIS"

    '背景色
    .BGColor = "orange"

    '↓Javascript設定は駄目？
    '.Body.onload = "javascript:alert(""hello"")"

    '文字色
    .Body.Style.Color = "white"

    'HTMLソースを設定
    .Body.innerHTML = "<span style=""position:absolute;top:50px;""></span><p>" & _
                      "<input id=""txtSample"" type=""text"" value=""Hello"" size=""40""> " & _
                      "<input id=""btnSample"" type=""button"" value=""押してね!!"" onClick=""alert(hello)"">"

    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '(1)１つ目の<span>タグエレメントを取得し、文言を設定＆style属性を設定
    Dim SPANElement As Object
    Set SPANElement = .getElementsByTagName("span").Item(0)
    SPANElement.innerHTML = "このクライアント領域のウィンドウハンドルは 0x" & Hex$(hCliendWnd) & " です。"

    'style属性の値を取得＆border設定を追加
    Debug.Print SPANElement.Style.Top
    SPANElement.Style.border = "solid 1px red"
    'SPANElement.Style.borderBottom = "solid 1px magenta"
    SPANElement.Style.padding = "10px"
    SPANElement.Style.fontWeight = "bold"
    '破棄
    Set SPANElement = Nothing

    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '(2)テキストボックスのエレメントを取得して、値を設定
    Dim InputTextElement As Object
    Set InputTextElement = .GetElementById("txtSample")
    InputTextElement.setAttribute "value", InputTextElement.Value & " World"
    '破棄
    Set InputTextElement = Nothing


    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '(3)<head>タグにjavascriptを送り込む
    Dim HeadElement As Object
    Dim NewScriptElement As Object

    'ヘッダ要素を取得
    Set HeadElement = .getElementsByTagName("HEAD").Item(0)
    'script要素を作成
    Set NewScriptElement = .CreateElement("script")
    'Typeを設定
    NewScriptElement.Type = "text/javascript"
    'Javascriptソースを設定
    'NewScriptElement.Text = "var hello = function() { alert('Hello World!!'); } ()"
    NewScriptElement.Text = "var hello = function() { alert('Javascriptを動的に埋め込みました。\n" & _
                            "[押してね!!]ボタンを押すべし!!'); return ""こんにちわ世界!!"" } ()"
    'ヘッダ要素にscript要素を追加する
    Call HeadElement.appendChild(NewScriptElement)
    '破棄
    Set NewScriptElement = Nothing
    Set HeadElement = Nothing


    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '(4)<body>要素の先頭にタグを挿入
    Dim BodyChild As Object     '<body>要素の先頭要素
    Dim NewDivElement As Object '新たに作成する<div>要素

    '<body>要素の先頭要素を取得
    'Set BodyChild = .childNodes.Item(0).childNodes.Item(1)
    Set BodyChild = .firstChild.childNodes.Item(1)

    'div要素を作成
    Set NewDivElement = .CreateElement("div")
    NewDivElement.Style.Position = "absolute"
    NewDivElement.Style.Top = "70px"
    NewDivElement.Style.Left = "20px"
    NewDivElement.Style.Width = "300px"
    NewDivElement.Style.Height = "100px"
    NewDivElement.Style.backgroundColor = "lime"
    NewDivElement.Style.Color = "magenta"
    NewDivElement.Style.TextAlign = "center"
    NewDivElement.Style.Filter = "alpha(opacity=80)"
    NewDivElement.innerHTML = "<br><br><H2>こんにちわDIVタグ!!</H2>"

    '<body>要素の先頭に<div>タグを挿入
    Call BodyChild.insertBefore(NewDivElement)
    'Call .Body.insertBefore(NewDivElement)  ←BodyChildを使わないのであればこれだけで良い!!

    '破棄
    Set NewDivElement = Nothing
    Set BodyChild = Nothing

    '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
    '(5)さようなら〜
    .Close
End With


Set HTMLObj = Nothing
戻る