webbrowserで別ドメインを制御する方法 (ID:103020)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文 > 似たような質問が過去にあったようなので張っておきます。 》一応 VB6 で書き直してみました。 》http://www.ocv.ne.jp/~oratorio/junk/Sample/40/ZoneTest.lzh 》なお実行前には、必ず、エラートラップモードを、 》『エラー処理対象外のエラーで中断』モードにしておいてください。 おおぅ、書いた本人も完全に忘れていました。 既にデッドリンクですけれどね。 過去 2 回のサーバー移転の際に、幾つかのコンテンツは失われていますが、 少なくとも上記のファイルは手元に残っていたので、現行サーバーに 再度アップロードしておきました。新しい URL はこちら。 http://www.vb-user.net/junk/Sample/40/ZoneTest.lzh ただし、当時使っていたサイトは、現在ではフレームが使われていない ようなので、中にあるサンプルは別の URL に差し替えてください。 一応、ソースコードも転記しておきます。 '--- Form1 --- Option Explicit '参照設定が必要： ' なお、olelibOrator というは自作のタイプライブラリ。 Implements olelibOrator.IServiceProvider Implements olelib.IInternetSecurityManager Private SID_SProfferService As UUID Private IID_IProfferService As UUID Private IID_IInternetSecurityManager As UUID Private ps As IProfferService Private cookie As Long Private sp As olelib.IServiceProvider Private Sub Check1_Click() If cookie <> 0 Then ps.RevokeService cookie cookie = 0 End If If Check1.Value = vbChecked Then cookie = ps.ProfferService(IID_IInternetSecurityManager, Me) End If WebBrowser1.Refresh End Sub Private Sub Form_Load() Check1.Caption = "GetSecurityId変更" Check1.Value = vbUnchecked Command1.Caption = "フレーム読み込み" CLSIDFromString SIDSTR_SProfferService, IID_IProfferService CLSIDFromString SIDSTR_SProfferService, SID_SProfferService CLSIDFromString IIDSTR_IInternetSecurityManager, IID_IInternetSecurityManager Set sp = WebBrowser1.object sp.QueryService SID_SProfferService, IID_IProfferService, ps '2005年12月当時のサンプルでは、下記に具体的な URL を記載していましたが、 'そのサイトは現在、フレームを使わない構成になっているようです。 '適当なサイトに差し替えてください。 WebBrowser1.Navigate URL End Sub Private Sub Form_Unload(Cancel As Integer) If cookie <> 0 Then ps.RevokeService cookie End If End Sub Private Sub Command1_Click() ' Text1.Text = WebBrowser1.Document.documentElement.outerHTML ' Text2.Text = WebBrowser1.Document.frames(0).Document.documentElement.outerHTML ' Text3.Text = WebBrowser1.Document.frames(1).Document.documentElement.outerHTML ' Text4.Text = WebBrowser1.Document.frames(0).Document.frames(0).Document.documentElement.outerHTML ' Text5.Text = WebBrowser1.Document.frames(0).Document.frames(1).Document.documentElement.outerHTML Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" On Error GoTo ErrExit Dim d As HTMLDocument Dim fs As IHTMLFramesCollection2 Dim f1 As IHTMLWindow2 Dim f2 As IHTMLWindow2 Dim d1 As HTMLDocument Dim d2 As HTMLDocument Set d = WebBrowser1.Document Text1.Text = d.documentElement.outerHTML Set fs = d.frames Set f1 = fs.Item(0) Set f2 = fs.Item(1) Set d1 = f1.Document Set d2 = f1.Document Text2.Text = d1.documentElement.outerHTML Text3.Text = d1.documentElement.outerHTML Set fs = d1.frames Set f1 = fs.Item(0) Set f2 = fs.Item(1) Set d1 = f1.Document Set d2 = f1.Document Text4.Text = d1.documentElement.outerHTML Text5.Text = d1.documentElement.outerHTML Exit Sub ErrExit: MsgBox Err.Description End Sub Private Sub IInternetSecurityManager_GetSecurityId(ByVal pwszUrl As Long, ByVal pbSecurityId As Long, pcbSecurityId As Long, ByVal dwReserved As Long) 'Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION Dim URL As String URL = lpwstrPtrToString(pwszUrl) Debug.Print URL pcbSecurityId = 0 End Sub Private Function IInternetSecurityManager_GetSecuritySite() As olelib.IInternetSecurityMgrSite Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Function Private Sub IInternetSecurityManager_GetZoneMappings(ByVal dwZone As Long, ppenumString As olelib.IEnumString, ByVal dwFlags As Long) Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Sub IInternetSecurityManager_MapUrlToZone(ByVal pwszUrl As Long, pdwZone As Long, ByVal dwFlags As Long) pdwZone = 0 Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Sub IInternetSecurityManager_ProcessUrlAction(ByVal pwszUrl As Long, ByVal dwAction As olelib.URLACTIONS, ByVal pPolicy As Long, ByVal cbPolicy As Long, pContext As Byte, ByVal cbContext As Long, ByVal dwFlags As olelib.PUAF, ByVal dwReserved As Long) Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Sub IInternetSecurityManager_QueryCustomPolicy(ByVal pwszUrl As Long, guidKey As olelib.UUID, ppPolicy As Long, pcbPolicy As Long, pContext As Byte, ByVal cbContext As Long, Optional ByVal dwReserved As Long = 0&) Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Sub IInternetSecurityManager_SetSecuritySite(ByVal pSite As olelib.IInternetSecurityMgrSite) Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Sub IInternetSecurityManager_SetZoneMapping(ByVal dwZone As Long, ByVal lpszPattern As Long, ByVal dwFlags As olelib.SZM_FLAGS) Err.Raise olelib.HRESULTS.INET_E_DEFAULT_ACTION End Sub Private Function IServiceProvider_QueryService(guidService As olelib.UUID, riid As olelib.UUID) As olelib.IInternetSecurityManager If GetStringFromGUID(guidService) = UCase(IIDSTR_IInternetSecurityManager) Then Set IServiceProvider_QueryService = Me Else Set IServiceProvider_QueryService = Nothing Err.Raise olelib.HRESULTS.E_NOINTERFACE End If End Function Public Function GetStringFromGUID(X As UUID) As String Dim s As String Dim L As Long s = String(100, 0) L = StringFromGUID2(X, s, Len(s)) GetStringFromGUID = UCase(Left(s, L - 1)) End Function Private Function lpwstrPtrToString(ByVal lpwstrPtr As Long) As String Dim lSize As Long If lpwstrPtr <> 0 Then lSize = lstrlenW(ByVal lpwstrPtr) If lSize > 0 Then ReDim b(0 To (lSize * 2) - 1) As Byte MoveMemory b(0), ByVal lpwstrPtr, lSize * 2 lpwstrPtrToString = b End If End If End Function