VB6 禁止浏览器下载图片,脚本,视频,音乐及ActvieX等.

前端之家收集整理的这篇文章主要介绍了VB6 禁止浏览器下载图片,脚本,视频,音乐及ActvieX等.前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。

一直没有找到自定义浏览器的方法,经老马推荐,找到了L-E浏览器的源码,啃了一星期,终于提取出了一份可用的代码.源码改自L-E浏览器.感谢作者.实现原理参考了COM原理与应用.另外关于代码中的OnAmbientPropertyChange -5512相信很多人会有疑问.请参照此帖[http://topic.csdn.net/u/20101117/17/b465d207-cb59-4111-bcda-5bdf3ca7f710.html].感谢hpygzhx520.

源码下载:http://lib.ldong.net/webbrowser.rar

需要有olelb.tbl(必需)和olelib2.tbl(可选)

以下是cWebbrowser的代码

Option Explicit

Implements olelib.IOleClientSite

Implements olelib2.IOleInPlaceSite

Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long,ByVal hWndNewParent As Long) As Long

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long,ByVal nIndex As Long,ByVal dwNewLong As Long) As Long

'Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long,lpRect As RECT) As Long

Private Const GWL_USERDATA = (-21)

Private m_oWebBrowser As SHDocVw.Webbrowser ' WebBrowser control

Public Enum HostFlags

' MSHTML will not allow selection

' of the text in the form.

hfDialog = DOCHOSTUIFLAG_DIALOG

' MSHTML will not add the Help menu

' item to the container's menu.

hfDisableHelpMenu = DOCHOSTUIFLAG_DISABLE_HELP_MENU

' MSHTML does not use 3-D borders.

hfNo3DBorder = DOCHOSTUIFLAG_NO3DBORDER

' MSHTML does not have scroll bars.

hfNoScroll = DOCHOSTUIFLAG_SCROLL_NO

' MSHTML will not execute any

' script when loading pages.

hfDisableScripInactive = DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE

' MSHTML will open a site in

' a new window when a link is

' clicked rather than browse to

' the new site using the same

' browser window.

hfBrowseNew = DOCHOSTUIFLAG_OPENNEWUI

' Not implemented.

hfDisableOffScreen = DOCHOSTUIFLAG_DISABLE_OFFSCREEN

' MSHTML will use flat scroll bars

' for any UI it displays.

hfFlatScroll = DOCHOSTUIFLAG_FLAT_SCROLLBAR

' MSHTML will insert the <DIV> tag

' if a return is entered in edit mode.

' Without this flag,MSHTML will use

' the <P> tag.

hfDivBlock = DOCHOSTUIFLAG_DIV_BLOCKDEFAULT

' MSHTML will only become UI active

' if the mouse is clicked in the

' client area of the window. It will

' not become UI active if the mouse

' is clicked on a nonclient area,such

' as a scroll bar.

hfActiveClientHit = DOCHOSTUIFLAG_ACTIVATE_CLIENTHIT_ONLY

' MSHTML will consult the host

' before retrieving a behavior

' from the URL specified on the page.

hfOverrideBehaviorFactory = DOCHOSTUIFLAG_OVERRIDEBEHAVIORFACTORY

' This flag was added to Microsoft(r)

' Internet Explorer 5 to provide font

' selection compatibility for Microsoft(r)

' Outlook(r) Express. If the flag is enabled,

' the displayed characters are inspected

' to determine whether the current font

' supports the code page. If disabled,the

' current font is used,even if it does

' not contain a glyph for the character.

' Note This flag assumes that the user is

' using Internet Explorer 5 and Outlook

' Express 4.0.

hfCodePageLinkedFonts = DOCHOSTUIFLAG_CODEPAGELINKEDFONTS

' This flag was added to Internet Explorer

' 5 to control how nonnative URLs are

' transmitted over the Internet. Nonnative

' refers to characters outside the

' multibyte encoding of the URL. If this

' flag is set,the URL is not submitted

' to the server in UTF-8 encoding.

hfDisableUTF8 = DOCHOSTUIFLAG_URL_ENCODING_DISABLE_UTF8

' This flag was added to Internet Explorer

' 5 to control how nonnative URLs are

' transmitted over the Internet. Nonnative

' refers to characters outside the

' multibyte encoding of the URL. If this

' flag is set,the URL is submitted

' to the server in UTF-8 encoding.

hfEnableUTF8 = DOCHOSTUIFLAG_URL_ENCODING_ENABLE_UTF8

' This flag enables the AutoComplete

' feature for forms in the hosted

' browser. The Intelliforms feature will

' only be turned on if the user has

' prevIoUsly enabled it. If the user has

' turned the AutoComplete feature off

' for forms,it will be off whether

' this flag is specified or not.

hfEnableFormAutocomplete = DOCHOSTUIFLAG_ENABLE_FORMS_AUTOCOMPLETE

' This flag enables the host to specify

' that navigation should happen in place.

' This means that applications hosting

' MSHTML directly can specify that

' navigation happen in the application's

' window. For instance,if this flag is

' set,you can click a link in HTML mail

' and navigate in the mail instead of

' opening a new Internet Explorer window.

hfInPlaceNavigation = DOCHOSTUIFLAG_ENABLE_INPLACE_NAVIGATION

' During initialization,the host can set

' this flag to enable input method editor

' (IME) reconversion,allowing computer

' users to employ IME reconversion while

' browsing Web pages. An input method

' editor is a program that allows users to

' enter complex characters and symbols,

' such as Japanese Kanji characters,using

' a standard keyboard. For more information,

' see the International Features reference

' in the Base Services section of the

' Platform SDK.

hfEnableIME = DOCHOSTUIFLAG_IME_ENABLE_RECONVERSION

'Internet Explorer 6 or later.

'Specifies that the hosted browser should use themes for pages it displays.

'hfTheme= DOCHOSTUIFLAG_THEME = 0x00040000

hfTheme = &H40000

hfDefault = hfEnableFormAutocomplete Or hfEnableIME Or hfTheme

End Enum

Public Enum DownloadCtrlFlags

DLCTL_DLIMAGES = &H10&

DLCTL_VIDEOS = &H20&

DLCTL_BGSOUNDS = &H40&

DLCTL_NO_SCRIPTS = &H80&

DLCTL_NO_JAVA = &H100&

DLCTL_NO_RUNACTIVEXCTLS = &H200&

DLCTL_NO_DLACTIVEXCTLS = &H400&

DLCTL_DOWNLOADONLY = &H800&

DLCTL_NO_FRAMEDOWNLOAD = &H1000&

DLCTL_RESYNCHRONIZE = &H2000&

DLCTL_PRAGMA_NO_CACHE = &H4000&

DLCTL_NO_BEHAVIORS = &H8000&

DLCTL_NO_MetaCHARSET = &H10000

DLCTL_URL_ENCODING_DISABLE_UTF8 = &H20000

DLCTL_URL_ENCODING_ENABLE_UTF8 = &H40000

DLCTL_FORCEOFFLINE = &H10000000

DLCTL_NO_CLIENTPULL = &H20000000

DLCTL_SILENT = &H40000000

DLCTL_OFFLINE = &H80000000

DLCTL_Default = DLCTL_BGSOUNDS Or DLCTL_DLIMAGES Or DLCTL_VIDEOS ' Or DLCTL_SILENT

End Enum

'ÏÂÔØ¿ØÖƱ¾µØ±äÁ¿

Private mDownloadCtrl As Long 'DownloadCtrlFlags

Private mDL_Image As Boolean

Private mDL_BgSound As Boolean

Private mDL_Video As Boolean

Private mDL_Script As Boolean

Private mDL_ActiveX As Boolean

Private mDL_JavaApplet As Boolean

Private mDl_DlActiveX As Boolean

Private vFrmWeb As Object

Private Created As Boolean

'Webbrowser Hwnd

Private m_hOleWindow&

'

' DownloadCtrl

'

' Returns the download control flags. This property

' is called by the WB control to get the flags.

'

' Be sure that the property ID is set to -5512.

'

Public Property Get DownloadCtrlEX() As DownloadCtrlFlags

DownloadCtrlEX = mDownloadCtrl

End Property

Public Property Let DownloadCtrlEX(ByVal NewFlags As DownloadCtrlFlags)

Dim oOC As olelib.IOleControl

mDownloadCtrl = NewFlags

If Created Then

' Get the WB IOleControl

Set oOC = m_oWebBrowser

' Notify the WB control that

' the property was changed

oOC.OnAmbientPropertyChange -5512

End If

End Property

'

Private Sub pvCreateWBControl(objWeb As SHDocVw.Webbrowser)

Dim oOleObj As olelib.IOleObject

Dim oUnk As olelib.IUnknown

'Dim oFrame As IOleInPlaceFrame

Dim oOC As olelib.IOleControl

'Dim tMSG As olelib.MSG

Dim tRect As olelib.RECT

Dim tOle As olelib.IOleWindow

' Create the WebBrowser control

'CoCreateInstance CLSID_WebBrowser,Nothing,CLSCTX_INPROC_SERVER,IID_IUnknown,oUnk

' Get the WebBrowser interface

Set m_oWebBrowser = objWeb ' oUnk

'Set oUnk = Nothing

' Get the IOleObject interface

Set oOleObj = m_oWebBrowser

' Set the client site

oOleObj.SetClientSite Me

Set tOle = m_oWebBrowser

m_hOleWindow = tOle.GetWindow()

' Call GetClientRect(m_hOleWindow,tRect)

' Debug.Print tRect.Left,tRect.Right

' Activate the document

'Debug.Print vFrmWeb.hwnd,frmBrowser.Picture1.hwnd,frmBrowser.hwnd,vFrmWeb.Picture1.hwnd

' SetParent m_hOleWindow,vFrmWeb.Picture1.hwnd

oOleObj.DoVerb OLEIVERB_INPLACEACTIVATE,Me,vFrmWeb.hWnd,tRect

Created = True

' Force the WB control to get the

' UA and download control properties

Set oOC = oOleObj

oOC.OnAmbientPropertyChange -5513

oOC.OnAmbientPropertyChange -5512

'save webbrowser obj ptr into the 32-bit value associated with the window

SetWindowLong m_hOleWindow,GWL_USERDATA,ObjPtr(m_oWebBrowser)

Set oOleObj = Nothing

Set oUnk = Nothing

Set oOC = Nothing

End Sub

Public Property Get hWnd() As Long

hWnd = m_hOleWindow

End Property

'---------------------------------------------------------------------------------------

' Procedure : pvUnloadWBControl

' DateTime : 2006-10-19 20:31

' Author : lingll

' email : lingll_xl@163.com

' Purpose : release the reference of WBControl and unload it

'---------------------------------------------------------------------------------------

Public Function pvReleaseWBControl() As Boolean

Dim oOleObj As olelib.IOleObject

If Created Then

Set oOleObj = m_oWebBrowser

Set m_oWebBrowser = Nothing

'oOleObj.SetClientSite Nothing

oOleObj.Close OLECLOSE_NOSAVE

oOleObj.SetClientSite Nothing

Set oOleObj = Nothing

End If

Set vFrmWeb = Nothing

End Function

Private Sub Class_Initialize()

Call IniVars

IniDownloadControl

End Sub

Private Function IOleClientSite_GetContainer() As olelib.IOleContainer

' Err.Raise E_NOTIMPL

Set IOleClientSite_GetContainer = vFrmWeb

End Function

Private Function IOleClientSite_GetMoniker(ByVal dwAssign As olelib.OLEGETMONIKER,ByVal dwWhichMoniker As olelib.OLEWHICHMK) As olelib.IMoniker

Err.Raise E_NOTIMPL

End Function

Private Sub IOleClientSite_OnShowWindow(ByVal fShow As olelib.BOOL)

Err.Raise E_NOTIMPL

End Sub

Private Sub IOleClientSite_RequestNewObjectLayout()

Err.Raise E_NOTIMPL

End Sub

Private Sub IOleClientSite_SaveObject()

End Sub

Private Sub IOleClientSite_ShowObject()

'Err.Raise E_NOTIMPL

End Sub

Private Sub IOleInPlaceSite_CanInPlaceActivate()

End Sub

Private Sub IOleInPlaceSite_ContextSensitiveHelp(ByVal fEnterMode As olelib.BOOL)

End Sub

Private Sub IOleInPlaceSite_DeactivateAndUndo()

'debug.Print "IOleInPlaceSite_DeactivateAndUndo"

End Sub

Private Sub IOleInPlaceSite_DiscardUndoState()

End Sub

Private Function IOleInPlaceSite_GetWindow() As Long

IOleInPlaceSite_GetWindow = vFrmWeb.hWnd

End Function

Private Sub IOleInPlaceSite_GetWindowContext(ppFrame As olelib.IOleInPlaceFrame,ppDoc As olelib.IOleInPlaceUIWindow,lprcPosRect As olelib.RECT,lprcClipRect As olelib.RECT,lpFrameInfo As olelib.OLEINPLACEFRAMEINFO)

'Set ppFrame = vFrmWeb

'if use "Set ppFrame = vFrmWeb",the webbrowser will get hold up

'all keyboard event,then we can find we cant use left or right key

'on address bar

'if no use "Set ppFrame = vFrmWeb",we should send keys to

'webbrowser manually,in mGetMessage.GetMsgProc

Set ppDoc = Me

lpFrameInfo.hwndFrame = vFrmWeb.hWnd

End Sub

Private Sub IOleInPlaceSite_OnInPlaceActivate()

'Debug.Print "IOleInPlaceSite_OnInPlaceActivate"

End Sub

Private Sub IOleInPlaceSite_OnInPlaceDeactivate()

'debug.Print "IOleInPlaceSite_OnInPlaceDeactivate"

End Sub

Private Sub IOleInPlaceSite_OnPosRectChange(lprcPosRect As olelib.RECT)

End Sub

Private Sub IOleInPlaceSite_OnUIActivate()

End Sub

Private Sub IOleInPlaceSite_OnUIDeactivate(ByVal fUndoable As olelib.BOOL)

'debug.Print "IOleInPlaceSite_OnUIDeactivate",fUndoable

End Sub

Private Sub IOleInPlaceSite_Scroll(ByVal scrollX As Long,ByVal scrollY As Long)

'Debug.Print "IOleInPlaceSite_Scroll"

End Sub

Public Sub ResizeWeb(X&,Y&,cx&,cy&,Optional useDefault As Boolean = False)

Dim oOO As IOleInPlaceObject

Dim tRect As olelib.RECT

' Get the IOleInPlaceObject interface

Set oOO = m_oWebBrowser

' Resize the control

If useDefault Then

tRect.Right = vFrmWeb.ScaleWidth

tRect.Bottom = vFrmWeb.ScaleHeight

Else

tRect.Left = X

tRect.Top = Y

tRect.Right = X + cx

tRect.Bottom = Y + cy

End If

'SetParent m_hOleWindow,vFrmWeb.hwnd

oOO.SetObjectRects tRect,tRect

End Sub

Public Sub INIAll(nfrm As Object,objWeb As SHDocVw.Webbrowser)

'nfrm.ScaleMode = vbPixels

Set vFrmWeb = nfrm

Debug.Print nfrm.Name

'If Not m_NewWinMan Is Nothing Then

'm_NewWinMan.InitObj vFrmWeb

'End If

Call pvCreateWBControl(objWeb)

' Call ResizeWeb(0,True)

End Sub

Public Property Get Webbrowser() As SHDocVw.Webbrowser

'frmBrowser.ScaleMode = vbPixels

'Set vFrmWeb = objWB.Parent

'Debug.Print vFrmWeb.Name

' Call pvCreateWBControl(objWB)

'Call ResizeWeb(objWB.Left,objWB.Top,objWB.Width,objWB.Height,False)

Set Webbrowser = m_oWebBrowser

End Property

Private Sub IniVars()

Created = False

' Initialize properties

mDownloadCtrl = DLCTL_Default

mDL_BgSound = False ' True

mDL_Image = False ' gDL_Image 'True

mDL_Script = True 'True

mDL_Video = False 'True

mDL_ActiveX = True ' True

mDL_JavaApplet = False 'True

mDl_DlActiveX = True

End Sub

'³õʼ»¯ÏÂÔØ¿ØÖÆ,»ñµÃmDownloadControl

Private Sub IniDownloadControl()

mDownloadCtrl = DLCTL_Default 'Or DLCTL_NO_DLACTIVEXCTLS 'Or DLCTL_SILENT

If mDl_DlActiveX Then

Else

mDownloadCtrl = mDownloadCtrl Or DLCTL_NO_DLACTIVEXCTLS

End If

If mDL_Image Then

Else

mDownloadCtrl = mDownloadCtrl Xor DLCTL_DLIMAGES

End If

If mDL_BgSound Then

Else

mDownloadCtrl = mDownloadCtrl Xor DLCTL_BGSOUNDS

End If

If mDL_Video Then

Else

mDownloadCtrl = mDownloadCtrl Xor DLCTL_VIDEOS

End If

If Not mDL_Script Then

mDownloadCtrl = mDownloadCtrl Or DLCTL_NO_SCRIPTS

Else

End If

'====== ¸ÄÓÉ vCWebMe_ProcessAction ¿ØÖÆ =======

If Not mDL_ActiveX Then

mDownloadCtrl = mDownloadCtrl Or DLCTL_NO_RUNACTIVEXCTLS

Else

End If

'===============================================

If Not mDL_JavaApplet Then

mDownloadCtrl = mDownloadCtrl Or DLCTL_NO_JAVA

Else

End If

Debug.Print mDownloadCtrl

End Sub

'==================================================

'======== ÏÂÔØ¿ØÖÆ,ÔÊÐíÏÂÔصÄÊôÐÔ,ÈçͼƬ ===========

'ͼƬ

Public Property Get DL_Image() As Boolean

DL_Image = mDL_Image

End Property

Public Property Let DL_Image(ByVal vNewValue As Boolean)

mDL_Image = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'±³¾°ÒôÀÖ

Public Property Get DL_BgSound() As Boolean

DL_BgSound = mDL_BgSound

End Property

Public Property Let DL_BgSound(ByVal vNewValue As Boolean)

mDL_BgSound = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'ÊÓƵ

Public Property Get DL_Video() As Boolean

DL_Video = mDL_Video

End Property

Public Property Let DL_Video(ByVal vNewValue As Boolean)

mDL_Video = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'½Å±¾

Public Property Get DL_Script() As Boolean

DL_Script = mDL_Script

End Property

Public Property Let DL_Script(ByVal vNewValue As Boolean)

mDL_Script = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'ÔËÐÐActiveX Control

Public Property Get DL_ActiveX() As Boolean

DL_ActiveX = mDL_ActiveX

End Property

Public Property Let DL_ActiveX(ByVal vNewValue As Boolean)

mDL_ActiveX = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'ÔËÐÐJava Applet

Public Property Get DL_JavaApplet() As Boolean

DL_JavaApplet = mDL_JavaApplet

End Property

Public Property Let DL_JavaApplet(ByVal vNewValue As Boolean)

mDL_JavaApplet = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'ÏÂÔØActiveX

Public Property Get Dl_DlActiveX() As Boolean

Dl_DlActiveX = mDl_DlActiveX

End Property

Public Property Let Dl_DlActiveX(ByVal vNewValue As Boolean)

mDl_DlActiveX = vNewValue

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Property

'ͳһÉèÖÃ

Public Sub Dl_EnableAll(nAll As Boolean)

mDL_BgSound = nAll

mDL_Image = nAll

mDL_Script = nAll

mDL_Video = nAll

mDL_ActiveX = nAll

mDL_JavaApplet = nAll

mDl_DlActiveX = nAll

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Sub

'ÅúÁ¿ÉèÖÃ

Public Sub Dl_BatchSet(Optional blnImage As Boolean = True,_

Optional blnScript As Boolean = True,Optional blnBgSound As Boolean = True,_

Optional blnVideo As Boolean = True,Optional blnActiveX As Boolean = True,_

Optional blnJavaApplet As Boolean = True,Optional blnDlActiveX As Boolean = True)

mDL_BgSound = blnBgSound

mDL_Image = blnImage

mDL_Script = blnScript

mDL_Video = blnVideo

mDL_ActiveX = blnActiveX

mDL_JavaApplet = blnJavaApplet

mDl_DlActiveX = blnDlActiveX

Call IniDownloadControl

DownloadCtrlEX = mDownloadCtrl

m_oWebBrowser.Refresh2 1

End Sub

调用方法:在VB工程中添加此类,拉一个Webbrowser控件,用cWebbrowser的IniAll方法初始化一下,然后就可以自由控制了.

Iniall方法的第一个参数是Webbrowser的容器,用于给Webbrowser定位的.第二个参数就是Webbrowser控件了.

olelib2.IOleInPlaceSite是用来定位浏览器的,可以不引用.

类中包含一个hWnd属性,这是浏览器的句柄,因为尽管Webbrowser控件有hwnd属性,但似乎根本无效.

原文链接:https://www.f2er.com/vb/261608.html

猜你在找的VB相关文章