-
Notifications
You must be signed in to change notification settings - Fork 5
/
WebBrowser2.fs
305 lines (280 loc) · 17.1 KB
/
WebBrowser2.fs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
namespace Sayuri.Windows.Forms
open System
open System.Reflection
open System.Runtime.InteropServices
open System.Windows.Forms
[<ComImport; Guid("6d5140c1-7436-11ce-8034-00aa006009fa"); InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>]
type private IServiceProvider =
abstract member QueryService : [<MarshalAs(UnmanagedType.LPStruct)>] guidService : Guid * [<MarshalAs(UnmanagedType.LPStruct)>] riid : Guid * [<Out; MarshalAs(UnmanagedType.IUnknown)>] ppvObject : obj byref -> unit
[<ComImport; Guid("0002DF05-0000-0000-C000-000000000046"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IWebBrowserApp =
interface
end
[<ComImport; Guid("D30C1661-CDAF-11d0-8A3E-00C04FC9E26E"); InterfaceType(ComInterfaceType.InterfaceIsDual)>]
type private IWebBrowser2 =
// IWebBrowser members
[<DispId( 100)>] abstract member GoBack : unit -> unit
[<DispId( 101)>] abstract member GoForward : unit -> unit
[<DispId( 102)>] abstract member GoHome : unit -> unit
[<DispId( 103)>] abstract member GoSearch : unit -> unit
[<DispId( 104)>] abstract member Navigate : [<In>] Url : string * [<In>] flags : obj byref * [<In>] targetFrameName : obj byref * [<In>] postData : obj byref * [<In>] headers : obj byref -> unit
[<DispId(-550)>] abstract member Refresh : unit -> unit
[<DispId( 105)>] abstract member Refresh2 : [<In>] level : obj byref -> unit
[<DispId( 106)>] abstract member Stop : unit -> unit
[<DispId( 200)>] abstract member Application : [<return: MarshalAs(UnmanagedType.IDispatch)>] obj
[<DispId( 201)>] abstract member Parent : [<return: MarshalAs(UnmanagedType.IDispatch)>] obj
[<DispId( 202)>] abstract member Container : [<return: MarshalAs(UnmanagedType.IDispatch)>] obj
[<DispId( 203)>] abstract member Document : [<return: MarshalAs(UnmanagedType.IDispatch)>] obj
[<DispId( 204)>] abstract member TopLevelContainer : bool
[<DispId( 205)>] abstract member Type : string
[<DispId( 206)>] abstract member Left : int with get, set
[<DispId( 207)>] abstract member Top : int with get, set
[<DispId( 208)>] abstract member Width : int with get, set
[<DispId( 209)>] abstract member Height : int with get, set
[<DispId( 210)>] abstract member LocationName : string
[<DispId( 211)>] abstract member LocationURL : string
[<DispId( 212)>] abstract member Busy : bool
// IWebBrowserApp members
[<DispId( 300)>] abstract member Quit : unit -> unit
[<DispId( 301)>] abstract member ClientToWindow : [<Out>] pcx : int byref * [<Out>] pcy : int byref -> unit
[<DispId( 302)>] abstract member PutProperty : [<In>] property : string * [<In>] vtValue : obj -> unit
[<DispId( 303)>] abstract member GetProperty : [<In>] property : string -> obj
[<DispId( 0)>] abstract member Name : string
[<DispId(-515)>] abstract member HWND : int
[<DispId( 400)>] abstract member FullName : string
[<DispId( 401)>] abstract member Path : string
[<DispId( 402)>] abstract member Visible : bool with get, set
[<DispId( 403)>] abstract member StatusBar : bool with get, set
[<DispId( 404)>] abstract member StatusText : string with get, set
[<DispId( 405)>] abstract member ToolBar : int with get, set
[<DispId( 406)>] abstract member MenuBar : bool with get, set
[<DispId( 407)>] abstract member FullScreen : bool with get, set
// IWebBrowser2 members
[<DispId( 500)>] abstract member Navigate2 : [<In>] URL : obj byref * [<In>] flags : obj byref * [<In>] targetFrameName : obj byref * [<In>] postData : obj byref * [<In>] headers : obj byref -> unit
[<DispId( 501)>] abstract member QueryStatusWB : [<In>] cmdID : (*OLECMDID*)int -> (*OLECMDF*)int
[<DispId( 502)>] abstract member ExecWB : [<In>] cmdID :(*OLECMDID*)int * [<In>] cmdexecopt : (*OLECMDEXECOPT*)int * pvaIn : obj byref * [<Out>] pvaOut : obj byref -> unit
[<DispId( 503)>] abstract member ShowBrowserBar : [<In>] pvaClsid : obj byref * [<In>] pvarShow : obj byref * [<In>] pvarSize : obj byref -> unit
[<DispId(-525)>] abstract member ReadyState : WebBrowserReadyState
[<DispId( 550)>] abstract member Offline : bool with get, set
[<DispId( 551)>] abstract member Silent : bool with get, set
[<DispId( 552)>] abstract member RegisterAsBrowser : bool with get, set
[<DispId( 553)>] abstract member RegisterAsDropTarget : bool with get, set
[<DispId( 554)>] abstract member TheaterMode : bool with get, set
[<DispId( 555)>] abstract member AddressBar : bool with get, set
[<DispId( 556)>] abstract member Resizable : bool with get, set
[<ComImport; Guid("3050f1ff-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLElement =
[<DispId((*DISPID_IHTMLELEMENT_OFFSETWIDTH*)0x800103F2)>]
abstract member offsetWidth : (*long*)int
[<DispId((*DISPID_IHTMLELEMENT_OFFSETHEIGHT*)0x800103F3)>]
abstract member offsetHeight : (*long*)int
[<ComImport; Guid("332c4427-26cb-11d0-b483-00c04fd90119"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLWindow2 =
[<DispId((*DISPID_IHTMLWINDOW2_SCROLLTO*)1168)>]
abstract member scrollTo : x : int * y : int -> unit
[<ComImport; Guid("3050f2e3-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLStyleSheet =
[<DispId((*DISPID_IHTMLSTYLESHEET_CSSTEXT*)1014)>]
abstract member cssText : string with get, set
[<ComImport; Guid("332c4425-26cb-11d0-b483-00c04fd90119"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLDocument2 =
[<DispId((*DISPID_IHTMLDOCUMENT2_BODY*)1004)>]
abstract member body : IHTMLElement
[<DispId((*DISPID_IHTMLDOCUMENT2_PARENTWINDOW*)1034)>]
abstract member parentWindow : IHTMLWindow2
[<DispId((*DISPID_IHTMLDOCUMENT2_CREATESTYLESHEET*)1071)>]
abstract member createStyleSheet : bstrHref : string * lIndex : int -> IHTMLStyleSheet
[<ComImport; Guid("3050f21f-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLElementCollection =
[<DispId((*DISPID_IHTMLELEMENTCOLLECTION_ITEM*)0)>]
abstract member item : name : obj * index : obj -> [<return: MarshalAs(UnmanagedType.IDispatch)>] obj
[<DispId((*DISPID_IHTMLELEMENTCOLLECTION_LENGTH*)1500)>]
abstract member length : int with get, set
[<ComImport; Guid("3050f485-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLDocument3 =
[<DispId((*DISPID_IHTMLDOCUMENT3_GETELEMENTSBYTAGNAME*)1087)>]
abstract member getElementsByTagName : v : string -> IHTMLElementCollection
[<DispId((*DISPID_IHTMLDOCUMENT3_GETELEMENTBYID*)1088)>]
abstract member getElementById : v : string -> obj
[<ComImport; Guid("3050f6db-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLFrameBase2 =
[<DispId((*DISPID_IHTMLFRAMEBASE2_CONTENTWINDOW*)0x80010BC1)>]
abstract member contentWindow : IHTMLWindow2
[<ComImport; Guid("305106e4-98b5-11cf-bb82-00aa00bdce0b"); InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private IHTMLCanvasElement =
[<DispId((*DISPID_IHTMLCANVASELEMENT_TODATAURL*)1002)>]
abstract member toDataURL : ``type`` : string * jpegquality : obj -> string
[<ComImport; Guid "34A715A0-6587-11D0-924A-0020AFC7AC4D"; InterfaceType(ComInterfaceType.InterfaceIsIDispatch)>]
type private DWebBrowserEvents2 =
[<DispId(273)>] abstract member NewWindow3 : [<In; Out; MarshalAs(UnmanagedType.IDispatch)>] ppDisp : obj byref * [<In; Out; MarshalAs(UnmanagedType.VariantBool)>] Cancel : bool byref * dwFlags : uint32 * bstrUrlContext : string * bstrUrl : string -> unit
[<StructLayout(LayoutKind.Sequential, Pack = 4); AllowNullLiteral>]
type RECT =
val left : int
val top : int
val width : int
val height : int
new (left, top, width, height) = { left = left; top = top; width = width; height = height }
[<StructLayout(LayoutKind.Sequential)>]
type private POINT =
val mutable x : int
val mutable y : int
[<StructLayout(LayoutKind.Sequential)>]
type private DOCHOSTUIINFO =
val cbSize : int
val mutable dwFlags : int
val mutable dwDoubleClick : int
val dwReserved1 : int
val dwReserved2 : int
new (dwFlags, dwDoubleClick) = { cbSize = Marshal.SizeOf typeof<DOCHOSTUIINFO>; dwFlags = dwFlags; dwDoubleClick = dwDoubleClick; dwReserved1 = 0; dwReserved2 = 0 }
[<Struct; StructLayout(LayoutKind.Sequential)>]
type private MSG =
val hwnd : nativeint
val message : int
val wParam : nativeint
val lParam : nativeint
val time : int
val pt_x : int
val pt_y : int
[<ComImport; Guid "BD3F23C0-D43E-11CF-893B-00AA00BDCE1A"; InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>]
type private IDocHostUIHandler =
[<PreserveSig>] abstract member ShowContextMenu : dwID : uint32 * pt : POINT * [<MarshalAs(UnmanagedType.Interface)>] pcmdtReserved : obj * [<MarshalAs(UnmanagedType.Interface)>] pdispReserved : obj -> int
[<PreserveSig>] abstract member GetHostInfo : [<In; Out>] info : DOCHOSTUIINFO -> int
[<PreserveSig>] abstract member ShowUI : dwID : int * [<MarshalAs(UnmanagedType.Interface)>] activeObject : obj * [<MarshalAs(UnmanagedType.Interface)>] commandTarget : obj * [<MarshalAs(UnmanagedType.Interface)>] frame : obj * [<MarshalAs(UnmanagedType.Interface)>] doc : obj -> int
[<PreserveSig>] abstract member HideUI : unit -> int
[<PreserveSig>] abstract member UpdateUI : unit -> int
[<PreserveSig>] abstract member EnableModeless : [<MarshalAs(UnmanagedType.Bool)>] fEnable : bool -> int
[<PreserveSig>] abstract member OnDocWindowActivate : [<MarshalAs(UnmanagedType.Bool)>] fActivate : bool -> int
[<PreserveSig>] abstract member OnFrameWindowActivate : [<MarshalAs(UnmanagedType.Bool)>] fActivate : bool -> int
[<PreserveSig>] abstract member ResizeBorder : rect : RECT * [<MarshalAs(UnmanagedType.Interface)>] doc : obj * fFrameWindow : bool -> int
[<PreserveSig>] abstract member TranslateAccelerator : [<In>] msg : MSG byref * [<MarshalAs(UnmanagedType.LPStruct)>] group : Guid * nCmdID : int -> int
[<PreserveSig>] abstract member GetOptionKeyPath : [<Out; MarshalAs(UnmanagedType.LPArray)>] pbstrKey : string[] * dw : uint32 -> int
[<PreserveSig>] abstract member GetDropTarget : [<MarshalAs(UnmanagedType.Interface)>] pDropTarget : obj * [<Out; MarshalAs(UnmanagedType.Interface)>] ppDropTarget : obj byref -> int
[<PreserveSig>] abstract member GetExternal : [<Out; MarshalAs(UnmanagedType.Interface)>] ppDispatch : obj byref -> int
[<PreserveSig>] abstract member TranslateUrl : dwTranslate : uint32 * [<MarshalAs(UnmanagedType.LPWStr)>] strURLIn : string * [<Out; MarshalAs(UnmanagedType.LPWStr)>] pstrURLOut : string byref -> int
[<PreserveSig>] abstract member FilterDataObject : pDO : ComTypes.IDataObject * [<Out>] ppDORet : ComTypes.IDataObject byref -> int
[<ComImport; Guid "3050F3F0-98B5-11CF-BB82-00AA00BDCE0B"; InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>]
type private ICustomDoc =
abstract member SetUIHandler : pUIHandler : IDocHostUIHandler -> unit
type private DocHostUIHandler (webBrowser : WebBrowser) =
[<Literal>]
static let S_OK = 0x00000000
[<Literal>]
static let S_FALSE = 0x00000001
[<Literal>]
static let E_NOTIMPL = 0x80004001
static let showContextMenu = lazy(typeof<WebBrowser>.GetMethod("ShowContextMenu", BindingFlags.NonPublic ||| BindingFlags.Instance))
interface IDocHostUIHandler with
override this.ShowContextMenu (dwID, pt, pcmdtReserved, pdispReserved) =
if webBrowser.IsWebBrowserContextMenuEnabled then S_FALSE else
if pt.x = 0 && pt.y = 0 then
pt.x <- -1
pt.y <- -1
// webBrowser.ShowContextMenu(pt.x, pt.y)
showContextMenu.Force().Invoke(webBrowser, [| pt.x; pt.y |]) |> ignore
S_OK
override this.GetHostInfo (info) =
info.dwDoubleClick <- (*DOCHOSTUIDBLCLK_DEFAULT*)0
info.dwFlags <- (*DOCHOSTUIFLAG_NO3DOUTERBORDER*)0x00200000 ||| (*DOCHOSTUIFLAG_DISABLE_SCRIPT_INACTIVE*)0x00000010 ||| (*DOCHOSTUIFLAG_DPI_AWARE*)0x40000000
||| (if webBrowser.ScrollBarsEnabled then (*DOCHOSTUIFLAG_FLAT_SCROLLBAR*)0x00000080 else (*DOCHOSTUIFLAG_SCROLL_NO*)0x00000008)
||| (if Application.RenderWithVisualStyles then (*DOCHOSTUIFLAG_THEME*)0x00040000 else (*DOCHOSTUIFLAG_NOTHEME*)0x00080000)
S_OK
override this.EnableModeless (fEnable) =
E_NOTIMPL
override this.ShowUI (dwID, activeObject, commandTarget, frame, doc) =
S_FALSE
override this.HideUI () =
E_NOTIMPL
override this.UpdateUI () =
E_NOTIMPL
override this.OnDocWindowActivate (fActivate) =
E_NOTIMPL
override this.OnFrameWindowActivate (fActivate) =
E_NOTIMPL
override this.ResizeBorder (rect, doc, fFrameWindow) =
E_NOTIMPL
override this.GetOptionKeyPath (pbstrKey, dw) =
E_NOTIMPL
override this.GetDropTarget (pDropTarget, ppDropTarget) =
ppDropTarget <- null
E_NOTIMPL
override this.GetExternal (ppDispatch) =
ppDispatch <- webBrowser.ObjectForScripting
S_OK
override this.TranslateAccelerator (msg, group, nCmdID) =
if webBrowser.WebBrowserShortcutsEnabled then S_FALSE else
let keyCode = int msg.wParam ||| int Control.ModifierKeys
if msg.message <> (*WM_CHAR*)0x0102 && Enum.IsDefined(typeof<Shortcut>, keyCode) then S_OK else S_FALSE
override this.TranslateUrl (dwTranslate, strUrlIn, pstrUrlOut) =
pstrUrlOut <- null
S_FALSE
override this.FilterDataObject (pDO, ppDORet) =
ppDORet <- null
S_FALSE
type NewWindow3EventArgs () =
inherit EventArgs ()
member val ppDisp = null with get, set
member val Cancel = false with get, set
type WebBrowser2 () as self =
inherit WebBrowser ()
let newWindow3 = Event<_>()
let closing = Event<_>()
let cookie = lazy(AxHost.ConnectionPointCookie(self.ActiveXInstance, EventHelper self, typeof<DWebBrowserEvents2>))
do
// use ICustomDoc.SetUIHandler()
// http://www.codeproject.com/Articles/2491/Using-MSHTML-Advanced-Hosting-Interfaces
// http://top.freespace.jp/ecosoft/tips_cs/src/009_cs.html
// another approach, .NET4's ICustomQueryInterface.GetInterface()
// http://stackoverflow.com/questions/15515581/why-my-implementation-of-idochostuihandler-is-ignored
self.Navigate "about:blank"
DocHostUIHandler self |> (self.DomDocument :?> ICustomDoc).SetUIHandler
member this.DomDocument : obj =
(this.ActiveXInstance :?> IWebBrowser2).Document
member this.AddStyleSheet(cssText) =
(this.DomDocument :?> IHTMLDocument2).createStyleSheet("", -1).cssText <- cssText
member this.GetApplication() =
let wb = this.ActiveXInstance :?> IWebBrowser2
wb.RegisterAsBrowser <- true
wb.Application
static member GetCapture(element : obj) =
let canvas = element :?> IHTMLCanvasElement
let dataUrl = canvas.toDataURL("image/png", 1)
if dataUrl.StartsWith "data:image/png;base64," |> not then failwith "invalid data url"
dataUrl.Substring 22 |> Convert.FromBase64String
static member GetElementById((document : obj), id) =
let element = (document :?> IHTMLDocument3).getElementById id
if element = null then None else Some element
static member GetElementsByTagName((document : obj), name) =
let elements = (document :?> IHTMLDocument3).getElementsByTagName name
[| for i in 0 .. elements.length -> elements.item(null, i) |]
static member GetFrameDocument(iframe : obj) =
(((iframe :?> IHTMLFrameBase2).contentWindow :?> IServiceProvider).QueryService(typeof<IWebBrowserApp>.GUID, typeof<IWebBrowser2>.GUID) :?> IWebBrowser2).Document
member this.Zoom(percent : int) =
let mutable old = null
(this.ActiveXInstance :?> IWebBrowser2).ExecWB((*OLECMDID_OPTICAL_ZOOM*)63, (*OLECMDEXECOPT_DODEFAULT*)0, percent :> obj |> ref, &old)
(this.DomDocument :?> IHTMLDocument2).parentWindow.scrollTo(0, 0)
old :?> int
[<CLIEvent>]
member this.NewWindow3 = newWindow3.Publish
[<CLIEvent>]
member this.Closing = closing.Publish
member internal this.OnNewWindow3 e =
newWindow3.Trigger e
override this.CreateSink() =
cookie.Force() |> ignore
base.CreateSink()
override this.DetachSink() =
base.DetachSink()
if cookie.IsValueCreated then
cookie.Value.Disconnect()
override this.WndProc(m) =
if m.Msg = 0x210(*WM_PARENTNOTIFY*) && int m.WParam = 2(*WM_DESTROY*) then
closing.Trigger(this, EventArgs.Empty)
base.WndProc(&m)
and private EventHelper (webBrowser : WebBrowser2) =
inherit StandardOleMarshalObject ()
interface DWebBrowserEvents2 with
member this.NewWindow3 (ppDisp, cancel, dwFlags, bstrUrlContext, bstrUrl) =
let e = NewWindow3EventArgs()
webBrowser.OnNewWindow3 e
ppDisp <- e.ppDisp
cancel <- e.Cancel