├── ExcelWebView2.xlsm ├── README.md ├── WebView2Loader.dll ├── WebView2_edit.tlb ├── idl ├── EventToken_edit.idl ├── ObjIdl.Idl ├── ObjIdlbase.Idl ├── TLB_ConversionNotes.txt ├── WebView2.idl ├── WebView2.tlb └── WebView2_edit.idl └── src ├── APIFunctions.bas ├── AppConstants.bas ├── AppTypes.bas ├── Constants.bas ├── HostObjectClass.cls ├── IStreamHelper.bas ├── IUnknownFake.bas ├── JSON.bas ├── JSONextensions.bas ├── MemoryFunctions.bas ├── Types.bas ├── UserForm1.frm ├── UserForm1.frx ├── WV2Globals.bas ├── WV2Tools.bas ├── byteConversion.bas ├── clsWebResData.cls ├── clsWebResourceBuilder.cls ├── clsWebViewContentHandler.cls ├── clsWebViewEventHandlers.cls ├── clsWebViewScriptCompleteHandler.cls ├── factory.bas ├── frmTools.frm ├── frmTools.frx ├── pluginBase.cls ├── pluginContainer.cls ├── pluginExample.bas ├── pluginExampleCls.cls ├── pluginInterface.cls ├── pluginLoader.bas ├── pluginManagerSingleton.cls ├── wv2.cls ├── wv2Environment.cls └── z_VB_IDE_Helpers.bas /ExcelWebView2.xlsm: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/ExcelWebView2.xlsm -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # ExcelWebView2 2 | An embedded WebView2 browser project for Microsoft Excel. 3 | 4 | ![examples](https://github.com/lucasplumb/ExcelWebView2/assets/8316592/cac706d0-8d15-4139-9f7d-d294cc3f6138) 5 | 6 | # What is this? 7 | 8 | ExcelWebView2 is intended to be a framework for creating embedded browser projects using Edge/WebView2 within Microsoft Excel. 9 | 10 | The goal is to support automated browser tasks using VBA, which may have previously used the embedded Internet Explorer control, but for modern websites that no longer support IE. 11 | 12 | This is a task which has not seen any real support from Microsoft - so until now the only real option has been Selenium - unfortunately, Selenium uses CDP which may not be enabled for all users, and only provides interaction with an external browser, rather than an embedded browser object. 13 | 14 | This project was created using 32-bit Office 2016, and WebView2Loader.dll version 1.0.1072.54. I have included the .dll in the project files for convenience, but you can also download it via the official Microsoft WebView2 Runtime, or scan your computer for an existing version (you probably have one already, though I make no guarantees this project will work with any other version than 1.0.1072.54) 15 | 16 | 17 | 18 | # How do I use it? 19 | 20 | The first thing you that should be noted, is that this project is in the very early stages of development. Not all features of WebView2 have been implemented. If you receive any sort of "Automation error", most likely it means that the Type Library has not been modified to support that method/property. 21 | 22 | That being said, working with this project should mostly be left to more advanced VBA developers with an understanding of COM. I also provide no guarantee that the code is bug free or thoroughly tested, so please browse the project and create PR's for any issues you see. 23 | 24 | ## Plugins 25 | 26 | I advise developers first explore the provided "plugin" functionality of the project. 27 | 28 | New plugins should be based on the "pluginBase" class. Copy and paste the code into a NEW class module. 29 | 30 | ![creating_plugin](https://github.com/lucasplumb/ExcelWebView2/assets/8316592/dbd53d60-4b6e-4980-85dd-c9512fe956f1) 31 | 32 | I've created an example plugin that demonstrates a few functions to get you started working with the project, called "pluginExampleCls". 33 | 34 | Note that I've copied the code from "pluginBase" into a new class module, and changed the "pluginInterface_newInstance()" property as such: 35 | 36 | ![creating_plugin1](https://github.com/lucasplumb/ExcelWebView2/assets/8316592/07ef8649-88c8-4e6f-8373-fcf7ba620cca) 37 | 38 | In order to load my plugin to work with the rest of the code in the project, I need to create an entry for it in the "pluginLoader" module. 39 | 40 | Note the following image where I've added my example plugin class to the LoadPlugins() method of the pluginLoader module. 41 | 42 | ![loading_plugin](https://github.com/lucasplumb/ExcelWebView2/assets/8316592/3d3a3aaf-a832-4700-91d8-41cc2d51cde1) 43 | 44 | This new plugin provides extended functionality for handling the events that WebView2 raises. However, it is unadvisable to write new functions or keep track of any sort of "state" in the plugin class itself without modifications to other code in the project. 45 | 46 | For now, we should create a new standard module to perform our automation tasks which is provided information by our plugin class module. See the pluginExample standard module: 47 | 48 | ![creating_plugin_example](https://github.com/lucasplumb/ExcelWebView2/assets/8316592/e6eadd13-3550-483d-8c9e-3e4b38b14c23) 49 | 50 | ## More to come 51 | 52 | I hope to provide more detailed explanations and tutorials for the code in the future. For now, I would just like to get this released and see some feedback. Thanks and happy coding! 53 | -------------------------------------------------------------------------------- /WebView2Loader.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/WebView2Loader.dll -------------------------------------------------------------------------------- /WebView2_edit.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/WebView2_edit.tlb -------------------------------------------------------------------------------- /idl/EventToken_edit.idl: -------------------------------------------------------------------------------- 1 | // Microsoft Windows 2 | // Copyright (c) Microsoft Corporation. All rights reserved. 3 | 4 | cpp_quote("// Microsoft Windows") 5 | cpp_quote("// Copyright (c) Microsoft Corporation. All rights reserved.") 6 | cpp_quote("#pragma once") 7 | 8 | // RIDL: version[NTDDI_WIN8] 9 | typedef struct EventRegistrationToken 10 | { 11 | __int32 value; 12 | } EventRegistrationToken; -------------------------------------------------------------------------------- /idl/ObjIdlbase.Idl: -------------------------------------------------------------------------------- 1 | cpp_quote("#include ") 2 | 3 | //+------------------------------------------------------------------------- 4 | // 5 | // Microsoft Windows 6 | // Copyright (c) Microsoft Corporation. All rights reserved. 7 | // 8 | // File: objidlbase.idl 9 | // 10 | //-------------------------------------------------------------------------- 11 | 12 | cpp_quote("//+-------------------------------------------------------------------------") 13 | cpp_quote("//+-------------------------------------------------------------------------") 14 | cpp_quote("//") 15 | cpp_quote("// Microsoft Windows") 16 | cpp_quote("// Copyright (c) Microsoft Corporation. All rights reserved.") 17 | cpp_quote("//") 18 | cpp_quote("//--------------------------------------------------------------------------") 19 | 20 | 21 | cpp_quote("#if(NTDDI_VERSION >= NTDDI_VISTA && !defined(_WIN32_WINNT))") 22 | cpp_quote("#define _WIN32_WINNT 0x0600") 23 | cpp_quote("#endif") 24 | 25 | cpp_quote("#if(NTDDI_VERSION >= NTDDI_WS03 && !defined(_WIN32_WINNT))") 26 | cpp_quote("#define _WIN32_WINNT 0x0502") 27 | cpp_quote("#endif") 28 | 29 | cpp_quote("#if(NTDDI_VERSION >= NTDDI_WINXP && !defined(_WIN32_WINNT))") 30 | cpp_quote("#define _WIN32_WINNT 0x0501") 31 | cpp_quote("#endif") 32 | 33 | cpp_quote("#if(NTDDI_VERSION >= NTDDI_WIN2K && !defined(_WIN32_WINNT))") 34 | cpp_quote("#define _WIN32_WINNT 0x0500") 35 | cpp_quote("#endif") 36 | 37 | #if OLE_OBJIDL_PROXY_STUB_BUILD 38 | #define DISABLE_CONSISTENCY_CHK ,disable_consistency_check 39 | #else 40 | #define DISABLE_CONSISTENCY_CHK 41 | #endif 42 | 43 | #if (__midl >= 501) 44 | midl_pragma warning( disable: 2007 ) // file already imported 45 | midl_pragma warning( disable: 2209 ) // ignored redundantly specified attributes 46 | midl_pragma warning( disable: 2298 ) // version ignored for object interfaces 47 | #endif 48 | 49 | cpp_quote("#if ( _MSC_VER >= 800 )") 50 | cpp_quote("#if _MSC_VER >= 1200") 51 | cpp_quote("#pragma warning(push)") 52 | cpp_quote("#ifndef _MSC_EXTENSIONS") 53 | cpp_quote("#pragma warning(disable:4309) /* truncation of constant value */") 54 | cpp_quote("#endif") 55 | cpp_quote("#pragma warning(disable:4820) /* padding added after data member */") 56 | cpp_quote("#endif") 57 | cpp_quote("#pragma warning(disable:4201)") 58 | cpp_quote("#endif") 59 | cpp_quote("#if ( _MSC_VER >= 1020 )") 60 | cpp_quote("#pragma once") 61 | cpp_quote("#endif") 62 | 63 | #ifndef DO_NO_IMPORTS 64 | import "unknwnbase.idl"; 65 | import "wtypesbase.idl"; 66 | #endif 67 | 68 | cpp_quote("#include ") 69 | 70 | cpp_quote("#ifndef _OBJIDLBASE_") 71 | 72 | #pragma region Application Family or OneCore Family 73 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 74 | 75 | interface IStream2; 76 | interface IEnumString; 77 | 78 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 79 | #pragma endregion 80 | 81 | #pragma region Desktop Family or OneCore Family 82 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 83 | 84 | interface IAsyncManager; 85 | interface ICallFactory; 86 | interface ISynchronize; 87 | 88 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 89 | #pragma endregion 90 | 91 | #pragma region Application Family or OneCore Family 92 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 93 | 94 | midl_pragma warning (disable: 2480) 95 | typedef struct _COSERVERINFO 96 | { 97 | DWORD dwReserved1; 98 | LPWSTR pwszName; 99 | COAUTHINFO * pAuthInfo; 100 | DWORD dwReserved2; 101 | } COSERVERINFO; 102 | midl_pragma warning (default: 2480) 103 | 104 | /**************************************************************************** 105 | * Component Object Interfaces 106 | ****************************************************************************/ 107 | 108 | [ 109 | local, 110 | object, 111 | uuid(00000003-0000-0000-C000-000000000046) 112 | ] 113 | 114 | interface IMarshal : IUnknown 115 | { 116 | 117 | typedef [unique] IMarshal *LPMARSHAL; 118 | 119 | HRESULT GetUnmarshalClass 120 | ( 121 | [in, annotation("_In_")] REFIID riid, 122 | [in, unique, annotation("_In_opt_")] void *pv, 123 | [in, annotation("_In_")] DWORD dwDestContext, 124 | [in, unique, annotation("_Reserved_")] void *pvDestContext, 125 | [in, annotation("_In_")] DWORD mshlflags, 126 | [out, annotation("_Out_")] CLSID *pCid 127 | ); 128 | 129 | HRESULT GetMarshalSizeMax 130 | ( 131 | [in, annotation("_In_")] REFIID riid, 132 | [in, unique, annotation("_In_opt_")] void *pv, 133 | [in, annotation("_In_")] DWORD dwDestContext, 134 | [in, unique, annotation("_Reserved_")] void *pvDestContext, 135 | [in, annotation("_In_")] DWORD mshlflags, 136 | [out, annotation("_Out_")] DWORD *pSize 137 | ); 138 | 139 | HRESULT MarshalInterface 140 | ( 141 | [in, unique, annotation("_In_")] IStream2 *pStm, 142 | [in, annotation("_In_")] REFIID riid, 143 | [in, unique, annotation("_In_opt_")] void *pv, 144 | [in, annotation("_In_")] DWORD dwDestContext, 145 | [in, unique, annotation("_Reserved_")] void *pvDestContext, 146 | [in, annotation("_In_")] DWORD mshlflags 147 | ); 148 | 149 | HRESULT UnmarshalInterface 150 | ( 151 | [in, unique, annotation("_In_")] IStream2 *pStm, 152 | [in, annotation("_In_")] REFIID riid, 153 | [out, annotation("_Outptr_")] void **ppv 154 | ); 155 | 156 | HRESULT ReleaseMarshalData 157 | ( 158 | [in, unique, annotation("_In_")] IStream2 *pStm 159 | ); 160 | 161 | HRESULT DisconnectObject 162 | ( 163 | [in, annotation("_In_")] DWORD dwReserved 164 | ); 165 | } 166 | 167 | // INoMarshal - marks an object that does not support being marshaled 168 | // or stored in the global interface table 169 | [ 170 | local, 171 | object, 172 | uuid(ecc8691b-c1db-4dc0-855e-65f6c551af49) 173 | ] 174 | interface INoMarshal : IUnknown 175 | { 176 | } 177 | 178 | // IAgileObject - marks an interface as agile across apartments, e.g. if it 179 | // aggregates the Free Threaded Marshaler. 180 | [ 181 | local, 182 | object, 183 | uuid(94ea2b94-e9cc-49e0-c0ff-ee64ca8f5b90) 184 | ] 185 | interface IAgileObject : IUnknown 186 | { 187 | } 188 | 189 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 190 | #pragma endregion 191 | 192 | #pragma region Desktop Family or OneCore Family or OneCore Family 193 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 194 | 195 | [ 196 | local, 197 | object, 198 | uuid(00000017-0000-0000-C000-000000000046) 199 | ] 200 | 201 | interface IActivationFilter : IUnknown 202 | { 203 | 204 | // possible values for dwActivationType 205 | typedef enum tagACTIVATIONTYPE { 206 | ACTIVATIONTYPE_UNCATEGORIZED = 0x0, 207 | ACTIVATIONTYPE_FROM_MONIKER = 0x1, 208 | ACTIVATIONTYPE_FROM_DATA = 0x2, 209 | ACTIVATIONTYPE_FROM_STORAGE = 0x4, 210 | ACTIVATIONTYPE_FROM_STREAM = 0x8, 211 | ACTIVATIONTYPE_FROM_FILE = 0x10 212 | } ACTIVATIONTYPE; 213 | 214 | HRESULT HandleActivation 215 | ( 216 | [in] DWORD dwActivationType, 217 | [in] REFCLSID rclsid, 218 | [out] CLSID *pReplacementClsId 219 | ); 220 | } 221 | 222 | [ 223 | local, 224 | object, 225 | uuid(000001cf-0000-0000-C000-000000000046) 226 | ] 227 | 228 | interface IMarshal2 : IMarshal 229 | { 230 | 231 | typedef [unique] IMarshal2 *LPMARSHAL2; 232 | } 233 | 234 | [ 235 | local, 236 | object, 237 | uuid(00000002-0000-0000-C000-000000000046) 238 | ] 239 | 240 | interface IMalloc : IUnknown 241 | { 242 | 243 | typedef [unique] IMalloc *LPMALLOC; 244 | 245 | void *Alloc([in, annotation("_In_")] SIZE_T cb); 246 | 247 | void *Realloc ([in, annotation("_In_opt_")] void *pv, 248 | [in, annotation("_In_")] SIZE_T cb); 249 | 250 | void Free([in, annotation("_In_opt_")] void *pv); 251 | 252 | //[annotation("_Success_(return != SIZE_MAX)")] #pragma prefast(disable:28285 28309, "MSENG:186222") 253 | SIZE_T GetSize([in, annotation("_In_opt_ _Post_writable_byte_size_(return)")] void *pv); 254 | 255 | int DidAlloc([in, annotation("_In_opt_")] void *pv); 256 | 257 | void HeapMinimize(void); 258 | } 259 | 260 | [ 261 | local, 262 | object, 263 | uuid(00000018-0000-0000-C000-000000000046) 264 | ] 265 | 266 | interface IStdMarshalInfo : IUnknown 267 | { 268 | 269 | typedef [unique] IStdMarshalInfo * LPSTDMARSHALINFO; 270 | 271 | HRESULT GetClassForHandler 272 | ( 273 | [in, annotation("_In_")] DWORD dwDestContext, 274 | [in, unique, annotation("_Reserved_")] void *pvDestContext, 275 | [out, annotation("_Out_")] CLSID *pClsid 276 | ); 277 | } 278 | 279 | [ 280 | object, 281 | local, 282 | uuid(00000019-0000-0000-C000-000000000046) 283 | ] 284 | 285 | interface IExternalConnection : IUnknown 286 | { 287 | 288 | typedef [unique] IExternalConnection* LPEXTERNALCONNECTION; 289 | 290 | 291 | // bit flags for IExternalConnection 292 | typedef enum tagEXTCONN 293 | { 294 | EXTCONN_STRONG = 0x0001, // strong connection 295 | EXTCONN_WEAK = 0x0002, // weak connection (table, container) 296 | EXTCONN_CALLABLE = 0x0004, // table .vs. callable 297 | } EXTCONN; 298 | 299 | // *** IExternalConnection methods *** 300 | DWORD AddConnection 301 | ( 302 | [in, annotation("_In_")] DWORD extconn, 303 | [in, annotation("_In_")] DWORD reserved 304 | ); 305 | 306 | DWORD ReleaseConnection 307 | ( 308 | [in, annotation("_In_")] DWORD extconn, 309 | [in, annotation("_In_")] DWORD reserved, 310 | [in, annotation("_In_")] BOOL fLastReleaseCloses 311 | ); 312 | } 313 | 314 | 315 | typedef [unique] IMultiQI* LPMULTIQI; 316 | 317 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 318 | #pragma endregion 319 | 320 | #pragma region Application Family or OneCore Family 321 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 322 | 323 | typedef struct tagMULTI_QI 324 | { 325 | const IID *pIID; // pass this one in 326 | IUnknown *pItf; // get these out (you must set to NULL before calling) 327 | HRESULT hr; 328 | } MULTI_QI; 329 | 330 | [ 331 | object, 332 | local, 333 | uuid(00000020-0000-0000-C000-000000000046), 334 | #if (__midl >= 500) 335 | async_uuid(000e0020-0000-0000-C000-000000000046) 336 | #endif 337 | 338 | ] 339 | 340 | interface IMultiQI : IUnknown 341 | { 342 | 343 | HRESULT QueryMultipleInterfaces 344 | ( 345 | [in, annotation("_In_")] ULONG cMQIs, 346 | [in, out, annotation("_Inout_updates_(cMQIs)")] MULTI_QI *pMQIs 347 | ); 348 | } 349 | 350 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 351 | #pragma endregion 352 | 353 | #pragma region Desktop Family or OneCore Family 354 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 355 | 356 | [ 357 | object, 358 | local, 359 | uuid(00000021-0000-0000-C000-000000000046) 360 | ] 361 | interface IInternalUnknown : IUnknown 362 | { 363 | HRESULT QueryInternalInterface( 364 | [in, annotation("_In_")] REFIID riid, 365 | [out, annotation("_Outptr_")] void **ppv); 366 | } 367 | 368 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 369 | #pragma endregion 370 | 371 | #pragma region Application Family or OneCore Family or OneCore Family 372 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 373 | 374 | [ 375 | object, 376 | uuid(00000100-0000-0000-C000-000000000046), 377 | pointer_default(unique) 378 | ] 379 | 380 | interface IEnumUnknown : IUnknown 381 | { 382 | 383 | typedef [unique] IEnumUnknown *LPENUMUNKNOWN; 384 | 385 | [local] 386 | HRESULT Next( 387 | [in, annotation("_In_")] ULONG celt, 388 | [out, annotation("_Out_writes_to_(celt,*pceltFetched)")] IUnknown **rgelt, 389 | [out, annotation("_Out_opt_")] ULONG *pceltFetched); 390 | 391 | [call_as(Next)] 392 | HRESULT RemoteNext( 393 | [in] ULONG celt, 394 | [out, size_is(celt), length_is(*pceltFetched)] IUnknown **rgelt, 395 | [out] ULONG *pceltFetched); 396 | 397 | HRESULT Skip( 398 | [in] ULONG celt); 399 | 400 | HRESULT Reset(); 401 | 402 | HRESULT Clone( 403 | [out] IEnumUnknown **ppenum); 404 | } 405 | 406 | [ 407 | object, 408 | uuid(00000101-0000-0000-C000-000000000046), 409 | pointer_default(unique) 410 | ] 411 | 412 | interface IEnumString : IUnknown 413 | { 414 | 415 | typedef [unique] IEnumString *LPENUMSTRING; 416 | 417 | [local] 418 | HRESULT Next( 419 | [in] ULONG celt, 420 | [annotation("_Out_writes_to_(celt,*pceltFetched)")] 421 | LPOLESTR *rgelt, 422 | [annotation("_Out_opt_")] ULONG *pceltFetched); 423 | 424 | [call_as(Next)] 425 | HRESULT RemoteNext( 426 | [in] ULONG celt, 427 | [out, size_is(celt), length_is(*pceltFetched)] 428 | LPOLESTR *rgelt, 429 | [out] ULONG *pceltFetched); 430 | 431 | 432 | HRESULT Skip( 433 | [in] ULONG celt); 434 | 435 | HRESULT Reset(); 436 | 437 | HRESULT Clone( 438 | [out] IEnumString **ppenum); 439 | } 440 | 441 | [ 442 | object, 443 | uuid(0c733a30-2a1c-11ce-ade5-00aa0044773d), 444 | pointer_default(unique) 445 | ] 446 | interface ISequentialStream : IUnknown 447 | { 448 | [local] 449 | HRESULT Read( 450 | [annotation("_Out_writes_bytes_to_(cb, *pcbRead)")] 451 | void *pv, 452 | [in, annotation("_In_")] ULONG cb, 453 | [annotation("_Out_opt_")] ULONG *pcbRead); 454 | 455 | [call_as(Read)] 456 | HRESULT RemoteRead( 457 | [out, size_is(cb), length_is(*pcbRead)] 458 | byte *pv, 459 | [in] ULONG cb, 460 | [out] ULONG *pcbRead); 461 | 462 | [local] 463 | HRESULT Write( 464 | [annotation("_In_reads_bytes_(cb)")] void const *pv, 465 | [in, annotation("_In_")] ULONG cb, 466 | [annotation("_Out_opt_")] ULONG *pcbWritten); 467 | 468 | [call_as(Write)] 469 | HRESULT RemoteWrite( 470 | [in, size_is(cb)] byte const *pv, 471 | [in] ULONG cb, 472 | [out] ULONG *pcbWritten); 473 | } 474 | 475 | //0000000c-0000-0000-C000-000000000046 476 | 477 | [ 478 | object, 479 | uuid(e39b7bc8-5859-46be-a112-aa5eb320b300), 480 | pointer_default(unique) 481 | ] 482 | //[ 483 | // object, 484 | // uuid(0000000c-0000-0000-C000-000000000046), 485 | // pointer_default(unique) 486 | //] 487 | interface IStream2 : ISequentialStream 488 | { 489 | 490 | typedef [unique] IStream2 *LPSTREAM; 491 | 492 | /* Storage stat buffer */ 493 | 494 | /* typedef struct tagSTATSTG 495 | { 496 | LPOLESTR pwcsName; 497 | DWORD type; 498 | ULARGE_INTEGER cbSize; 499 | FILETIME mtime; 500 | FILETIME ctime; 501 | FILETIME atime; 502 | DWORD grfMode; 503 | DWORD grfLocksSupported; 504 | CLSID clsid; 505 | DWORD grfStateBits; 506 | DWORD reserved; 507 | } STATSTG; */ 508 | 509 | 510 | 511 | 512 | /* Storage element types */ 513 | typedef enum tagSTGTY 514 | { 515 | STGTY_STORAGE = 1, 516 | STGTY_STREAM = 2, 517 | STGTY_LOCKBYTES = 3, 518 | STGTY_PROPERTY = 4 519 | } STGTY; 520 | 521 | typedef enum tagSTREAM_SEEK 522 | { 523 | STREAM_SEEK_SET = 0, 524 | STREAM_SEEK_CUR = 1, 525 | STREAM_SEEK_END = 2 526 | } STREAM_SEEK; 527 | 528 | typedef enum tagLOCKTYPE 529 | { 530 | LOCK_WRITE = 1, 531 | LOCK_EXCLUSIVE = 2, 532 | LOCK_ONLYONCE = 4 533 | } LOCKTYPE; 534 | 535 | typedef struct tagCY2 536 | { 537 | unsigned long Lo; 538 | long Hi; 539 | } CURRENCY; 540 | 541 | typedef struct UUID { 542 | LONG Data1; 543 | SHORT Data2; 544 | SHORT Data3; 545 | BYTE Data4[8]; 546 | } UUID; 547 | 548 | typedef enum STGM { 549 | STGM_DIRECT = 0x00000000, 550 | STGM_TRANSACTED = 0x00010000, 551 | STGM_SIMPLE = 0x08000000, 552 | 553 | STGM_READ = 0x00000000, 554 | STGM_WRITE = 0x00000001, 555 | STGM_READWRITE = 0x00000002, 556 | 557 | STGM_SHARE_DENY_NONE = 0x00000040, 558 | STGM_SHARE_DENY_READ = 0x00000030, 559 | STGM_SHARE_DENY_WRITE = 0x00000020, 560 | STGM_SHARE_EXCLUSIVE = 0x00000010, 561 | 562 | STGM_PRIORITY = 0x00040000, 563 | STGM_DELETEONRELEASE = 0x04000000, 564 | STGM_NOSCRATCH = 0x00100000, 565 | 566 | STGM_CREATE = 0x00001000, 567 | STGM_CONVERT = 0x00020000, 568 | STGM_FAILIFTHERE = 0x00000000, 569 | 570 | STGM_NOSNAPSHOT = 0x00200000, 571 | STGM_DIRECT_SWMR = 0x00400000, 572 | } STGM; 573 | 574 | typedef struct STATSTG { 575 | LONG pwcsName; 576 | STGTY type; 577 | CURRENCY cbSize; 578 | CURRENCY mtime; 579 | CURRENCY ctime; 580 | CURRENCY atime; 581 | STGM grfMode; 582 | LOCKTYPE grfLocksSupported; 583 | UUID clsid; 584 | LONG grfStateBits; 585 | LONG reserved; 586 | } STATSTG; 587 | 588 | [local] 589 | HRESULT Seek( 590 | [in] LARGE_INTEGER dlibMove, 591 | [in] DWORD dwOrigin, 592 | [annotation("_Out_opt_")] ULARGE_INTEGER *plibNewPosition); 593 | 594 | [call_as(Seek)] 595 | HRESULT RemoteSeek( 596 | [in] LARGE_INTEGER dlibMove, 597 | [in] DWORD dwOrigin, 598 | [out] ULARGE_INTEGER *plibNewPosition); 599 | 600 | HRESULT SetSize( 601 | [in] ULARGE_INTEGER libNewSize); 602 | 603 | [local] 604 | HRESULT CopyTo( 605 | [in, unique, annotation("_In_")] IStream2 *pstm, 606 | [in] ULARGE_INTEGER cb, 607 | [annotation("_Out_opt_")] ULARGE_INTEGER *pcbRead, 608 | [annotation("_Out_opt_")] ULARGE_INTEGER *pcbWritten); 609 | 610 | [call_as(CopyTo)] 611 | HRESULT RemoteCopyTo( 612 | [in, unique] IStream2 *pstm, 613 | [in] ULARGE_INTEGER cb, 614 | [out] ULARGE_INTEGER *pcbRead, 615 | [out] ULARGE_INTEGER *pcbWritten); 616 | 617 | HRESULT Commit( 618 | [in] DWORD grfCommitFlags); 619 | 620 | HRESULT Revert(); 621 | 622 | HRESULT LockRegion( 623 | [in] ULARGE_INTEGER libOffset, 624 | [in] ULARGE_INTEGER cb, 625 | [in] DWORD dwLockType); 626 | 627 | HRESULT UnlockRegion( 628 | [in] ULARGE_INTEGER libOffset, 629 | [in] ULARGE_INTEGER cb, 630 | [in] DWORD dwLockType); 631 | 632 | HRESULT Stat( 633 | [out] STATSTG *pstatstg, 634 | [in] DWORD grfStatFlag); 635 | 636 | HRESULT Clone( 637 | [out] IStream2 **ppstm); 638 | 639 | } 640 | 641 | 642 | /**************************************************************************** 643 | * Object Remoting Interfaces 644 | ****************************************************************************/ 645 | 646 | [ 647 | local, 648 | object, 649 | uuid(D5F56B60-593B-101A-B569-08002B2DBF7A) 650 | ] 651 | interface IRpcChannelBuffer : IUnknown 652 | { 653 | 654 | typedef ULONG RPCOLEDATAREP; 655 | 656 | typedef struct tagRPCOLEMESSAGE 657 | { 658 | void *reserved1; 659 | RPCOLEDATAREP dataRepresentation; 660 | void *Buffer; 661 | ULONG cbBuffer; 662 | ULONG iMethod; 663 | void *reserved2[5]; 664 | ULONG rpcFlags; 665 | } RPCOLEMESSAGE; 666 | 667 | typedef RPCOLEMESSAGE *PRPCOLEMESSAGE; 668 | 669 | HRESULT GetBuffer 670 | ( 671 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMessage, 672 | [in, annotation("_In_")] REFIID riid 673 | ); 674 | 675 | HRESULT SendReceive 676 | ( 677 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMessage, 678 | [out, annotation("_Out_opt_")] ULONG *pStatus 679 | ); 680 | 681 | HRESULT FreeBuffer 682 | ( 683 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMessage 684 | ); 685 | 686 | HRESULT GetDestCtx 687 | ( 688 | [out, annotation("_Out_")] DWORD *pdwDestContext, 689 | [out, annotation("_Outptr_result_maybenull_")] void **ppvDestContext 690 | ); 691 | 692 | HRESULT IsConnected 693 | ( 694 | void 695 | ); 696 | 697 | } 698 | 699 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 700 | #pragma endregion 701 | 702 | #pragma region Desktop Family or OneCore Family 703 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 704 | 705 | [ 706 | local, 707 | object, 708 | uuid(594f31d0-7f19-11d0-b194-00a0c90dc8bf) 709 | ] 710 | interface IRpcChannelBuffer2 : IRpcChannelBuffer 711 | { 712 | 713 | HRESULT GetProtocolVersion 714 | ( 715 | [out, annotation("_Out_")] DWORD *pdwVersion 716 | ); 717 | } 718 | 719 | [ 720 | local, 721 | object, 722 | uuid(a5029fb6-3c34-11d1-9c99-00c04fb998aa), 723 | pointer_default(unique) 724 | ] 725 | interface IAsyncRpcChannelBuffer : IRpcChannelBuffer2 726 | { 727 | 728 | HRESULT Send( 729 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 730 | [in, annotation("_In_")] ISynchronize *pSync, 731 | [out, annotation("_Out_")] ULONG *pulStatus 732 | ); 733 | 734 | HRESULT Receive( 735 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 736 | [out, annotation("_Out_")] ULONG *pulStatus); 737 | 738 | HRESULT GetDestCtxEx 739 | ( 740 | [in, annotation("_In_")] RPCOLEMESSAGE *pMsg, 741 | [out, annotation("_Out_")] DWORD *pdwDestContext, 742 | [out, annotation("_Outptr_opt_result_maybenull_")] void **ppvDestContext 743 | ); 744 | 745 | }; 746 | 747 | [ 748 | local, 749 | object, 750 | uuid(25B15600-0115-11d0-BF0D-00AA00B8DFD2) 751 | ] 752 | interface IRpcChannelBuffer3 : IRpcChannelBuffer2 753 | { 754 | 755 | HRESULT Send 756 | ( 757 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 758 | [out, annotation("_Out_")] ULONG *pulStatus 759 | ); 760 | 761 | HRESULT Receive 762 | ( 763 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 764 | [in, annotation("_In_")] ULONG ulSize, 765 | [out, annotation("_Out_")] ULONG *pulStatus 766 | ); 767 | 768 | HRESULT Cancel 769 | ( 770 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg 771 | ); 772 | 773 | HRESULT GetCallContext 774 | ( 775 | [in, annotation("_In_")] RPCOLEMESSAGE *pMsg, 776 | [in, annotation("_In_")] REFIID riid, 777 | [out, annotation("_Outptr_")] void **pInterface 778 | ); 779 | 780 | HRESULT GetDestCtxEx 781 | ( 782 | [in, annotation("_In_")] RPCOLEMESSAGE *pMsg, 783 | [out, annotation("_Out_")] DWORD *pdwDestContext, 784 | [out, annotation("_Outptr_opt_result_maybenull_")] void **ppvDestContext 785 | ); 786 | 787 | HRESULT GetState 788 | ( 789 | [in, annotation("_In_")] RPCOLEMESSAGE *pMsg, 790 | [out, annotation("_Out_")] DWORD *pState 791 | ); 792 | 793 | HRESULT RegisterAsync 794 | ( 795 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 796 | [in, annotation("_In_")] IAsyncManager *pAsyncMgr 797 | ); 798 | 799 | } 800 | 801 | [ 802 | local, 803 | object, 804 | uuid(58a08519-24c8-4935-b482-3fd823333a4f) 805 | ] 806 | interface IRpcSyntaxNegotiate : IUnknown 807 | { 808 | HRESULT NegotiateSyntax ( [in,out, annotation("_Inout_")] RPCOLEMESSAGE * pMsg ); 809 | } 810 | 811 | 812 | [ 813 | local, 814 | object, 815 | uuid(D5F56A34-593B-101A-B569-08002B2DBF7A) 816 | ] 817 | interface IRpcProxyBuffer : IUnknown 818 | { 819 | 820 | HRESULT Connect 821 | ( 822 | [in, unique, annotation("_In_")] IRpcChannelBuffer *pRpcChannelBuffer 823 | ); 824 | 825 | void Disconnect 826 | ( 827 | void 828 | ); 829 | 830 | } 831 | 832 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 833 | #pragma endregion 834 | 835 | #pragma region Application Family or OneCore Family or OneCore Family 836 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 837 | 838 | [ 839 | local, 840 | object, 841 | uuid(D5F56AFC-593B-101A-B569-08002B2DBF7A) 842 | ] 843 | interface IRpcStubBuffer : IUnknown 844 | { 845 | 846 | HRESULT Connect 847 | ( 848 | [in, annotation("_In_")] IUnknown *pUnkServer 849 | ); 850 | 851 | void Disconnect(); 852 | 853 | HRESULT Invoke 854 | ( 855 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *_prpcmsg, 856 | [in, annotation("_In_")] IRpcChannelBuffer *_pRpcChannelBuffer 857 | ); 858 | 859 | IRpcStubBuffer *IsIIDSupported 860 | ( 861 | [in, annotation("_In_")] REFIID riid 862 | ); 863 | 864 | ULONG CountRefs 865 | ( 866 | void 867 | ); 868 | 869 | HRESULT DebugServerQueryInterface 870 | ( 871 | [out, annotation("_Outptr_")] void **ppv 872 | ); 873 | 874 | void DebugServerRelease 875 | ( 876 | [in, annotation("_In_")] void *pv 877 | ); 878 | 879 | } 880 | 881 | 882 | 883 | [ 884 | local, 885 | object, 886 | uuid(D5F569D0-593B-101A-B569-08002B2DBF7A) 887 | ] 888 | interface IPSFactoryBuffer : IUnknown 889 | { 890 | 891 | HRESULT CreateProxy 892 | ( 893 | [in, annotation("_In_")] IUnknown *pUnkOuter, 894 | [in, annotation("_In_")] REFIID riid, 895 | [out, annotation("_Outptr_")] IRpcProxyBuffer **ppProxy, 896 | [out, annotation("_Outptr_")] void **ppv 897 | ); 898 | 899 | HRESULT CreateStub 900 | ( 901 | [in, annotation("_In_")] REFIID riid, 902 | [in, unique, annotation("_In_opt_")] IUnknown *pUnkServer, 903 | [out, annotation("_Outptr_")] IRpcStubBuffer **ppStub 904 | ); 905 | } 906 | 907 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 908 | #pragma endregion 909 | 910 | #pragma region Desktop Family or OneCore Family 911 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 912 | 913 | cpp_quote( "#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) // DCOM" ) 914 | cpp_quote( "// This interface is only valid on Windows NT 4.0" ) 915 | 916 | // This structure contains additional data for hooks. As a backward 917 | // compatability hack, the entire structure is passed in place of the 918 | // RIID parameter on all hook methods. Thus the IID must be the first 919 | // parameter. As a forward compatability hack the second field is the 920 | // current size of the structure. 921 | typedef struct SChannelHookCallInfo 922 | { 923 | IID iid; 924 | DWORD cbSize; 925 | GUID uCausality; 926 | DWORD dwServerPid; 927 | DWORD iMethod; 928 | void *pObject; 929 | } SChannelHookCallInfo; 930 | 931 | [ 932 | local, 933 | object, 934 | uuid(1008c4a0-7613-11cf-9af1-0020af6e72f4) 935 | ] 936 | interface IChannelHook : IUnknown 937 | { 938 | void ClientGetSize( 939 | [in, annotation("_In_")] REFGUID uExtent, 940 | [in, annotation("_In_")] REFIID riid, 941 | [out, annotation("_Out_")] ULONG *pDataSize ); 942 | 943 | void ClientFillBuffer( 944 | [in, annotation("_In_")] REFGUID uExtent, 945 | [in, annotation("_In_")] REFIID riid, 946 | [in, out, annotation("_Inout_")] ULONG *pDataSize, 947 | [in, annotation("_In_")] void *pDataBuffer ); 948 | 949 | void ClientNotify( 950 | [in, annotation("_In_")] REFGUID uExtent, 951 | [in, annotation("_In_")] REFIID riid, 952 | [in, annotation("_In_")] ULONG cbDataSize, 953 | [in, annotation("_In_")] void *pDataBuffer, 954 | [in, annotation("_In_")] DWORD lDataRep, 955 | [in, annotation("_In_")] HRESULT hrFault ); 956 | 957 | void ServerNotify( 958 | [in, annotation("_In_")] REFGUID uExtent, 959 | [in, annotation("_In_")] REFIID riid, 960 | [in, annotation("_In_")] ULONG cbDataSize, 961 | [in, annotation("_In_")] void *pDataBuffer, 962 | [in, annotation("_In_")] DWORD lDataRep ); 963 | 964 | void ServerGetSize( 965 | [in, annotation("_In_")] REFGUID uExtent, 966 | [in, annotation("_In_")] REFIID riid, 967 | [in, annotation("_In_")] HRESULT hrFault, 968 | [out, annotation("_Out_")] ULONG *pDataSize ); 969 | 970 | void ServerFillBuffer( 971 | [in, annotation("_In_")] REFGUID uExtent, 972 | [in, annotation("_In_")] REFIID riid, 973 | [in, out, annotation("_Inout_")] ULONG *pDataSize, 974 | [in, annotation("_In_")] void *pDataBuffer, 975 | [in, annotation("_In_")] HRESULT hrFault ); 976 | }; 977 | 978 | cpp_quote( "#endif //DCOM" ) 979 | 980 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 981 | #pragma endregion 982 | 983 | cpp_quote( "#if (_WIN32_WINNT >= 0x0400 ) || defined(_WIN32_DCOM) // DCOM" ) 984 | cpp_quote( "// This interface is only valid on Windows NT 4.0" ) 985 | 986 | #pragma region Application Family or OneCore Family 987 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 988 | 989 | [ 990 | local, 991 | object, 992 | uuid(0000013D-0000-0000-C000-000000000046) 993 | ] 994 | interface IClientSecurity : IUnknown 995 | { 996 | 997 | typedef struct tagSOLE_AUTHENTICATION_SERVICE 998 | { 999 | DWORD dwAuthnSvc; 1000 | DWORD dwAuthzSvc; 1001 | OLECHAR *pPrincipalName; 1002 | HRESULT hr; 1003 | } SOLE_AUTHENTICATION_SERVICE; 1004 | 1005 | typedef SOLE_AUTHENTICATION_SERVICE *PSOLE_AUTHENTICATION_SERVICE; 1006 | 1007 | typedef enum tagEOLE_AUTHENTICATION_CAPABILITIES 1008 | { 1009 | EOAC_NONE = 0x0, 1010 | EOAC_MUTUAL_AUTH = 0x1, 1011 | EOAC_STATIC_CLOAKING = 0x20, 1012 | EOAC_DYNAMIC_CLOAKING = 0x40, 1013 | EOAC_ANY_AUTHORITY = 0x80, 1014 | EOAC_MAKE_FULLSIC = 0x100, 1015 | EOAC_DEFAULT = 0x800, 1016 | 1017 | // These are only valid for CoInitializeSecurity 1018 | EOAC_SECURE_REFS = 0x2, 1019 | EOAC_ACCESS_CONTROL = 0x4, 1020 | EOAC_APPID = 0x8, 1021 | EOAC_DYNAMIC = 0x10, 1022 | EOAC_REQUIRE_FULLSIC = 0x200, 1023 | EOAC_AUTO_IMPERSONATE = 0x400, 1024 | EOAC_DISABLE_AAA = 0x1000, 1025 | EOAC_NO_CUSTOM_MARSHAL = 0x2000, 1026 | EOAC_RESERVED1 = 0x4000, 1027 | } EOLE_AUTHENTICATION_CAPABILITIES; 1028 | 1029 | const OLECHAR *COLE_DEFAULT_PRINCIPAL = (OLECHAR *)((INT_PTR) -1); 1030 | const void *COLE_DEFAULT_AUTHINFO = (void *)((INT_PTR) -1); 1031 | 1032 | typedef struct tagSOLE_AUTHENTICATION_INFO 1033 | { 1034 | DWORD dwAuthnSvc; 1035 | DWORD dwAuthzSvc; 1036 | void *pAuthInfo; 1037 | } SOLE_AUTHENTICATION_INFO, *PSOLE_AUTHENTICATION_INFO; 1038 | 1039 | typedef struct tagSOLE_AUTHENTICATION_LIST 1040 | { 1041 | DWORD cAuthInfo; 1042 | SOLE_AUTHENTICATION_INFO *aAuthInfo; 1043 | } SOLE_AUTHENTICATION_LIST, *PSOLE_AUTHENTICATION_LIST; 1044 | 1045 | HRESULT QueryBlanket 1046 | ( 1047 | [in, annotation("_In_")] IUnknown *pProxy, 1048 | [out, annotation("_Out_")] DWORD *pAuthnSvc, 1049 | [out, annotation("_Out_opt_")] DWORD *pAuthzSvc, 1050 | [out, annotation("__RPC__deref_out_opt")] 1051 | OLECHAR **pServerPrincName, 1052 | [out, annotation("_Out_opt_")] DWORD *pAuthnLevel, 1053 | [out, annotation("_Out_opt_")] DWORD *pImpLevel, 1054 | [out, annotation("_Outptr_result_maybenull_")] void **pAuthInfo, 1055 | [out, annotation("_Out_opt_")] DWORD *pCapabilites 1056 | ); 1057 | 1058 | HRESULT SetBlanket 1059 | ( 1060 | [in, annotation("_In_")] IUnknown *pProxy, 1061 | [in, annotation("_In_")] DWORD dwAuthnSvc, 1062 | [in, annotation("_In_")] DWORD dwAuthzSvc, 1063 | [in, annotation("__RPC__in_opt")] 1064 | OLECHAR *pServerPrincName, 1065 | [in, annotation("_In_")] DWORD dwAuthnLevel, 1066 | [in, annotation("_In_")] DWORD dwImpLevel, 1067 | [in, annotation("_In_opt_")] void *pAuthInfo, 1068 | [in, annotation("_In_")] DWORD dwCapabilities 1069 | ); 1070 | 1071 | HRESULT CopyProxy 1072 | ( 1073 | [in, annotation("_In_")] IUnknown *pProxy, 1074 | [out, annotation("_Outptr_")] IUnknown **ppCopy 1075 | ); 1076 | } 1077 | 1078 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1079 | #pragma endregion 1080 | 1081 | #pragma region Desktop Family or OneCore Family 1082 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1083 | 1084 | [ 1085 | local, 1086 | object, 1087 | uuid(0000013E-0000-0000-C000-000000000046) 1088 | ] 1089 | interface IServerSecurity : IUnknown 1090 | { 1091 | HRESULT QueryBlanket 1092 | ( 1093 | [out, annotation("_Out_opt_")] DWORD *pAuthnSvc, 1094 | [out, annotation("_Out_opt_")] DWORD *pAuthzSvc, 1095 | [out, annotation("__RPC__deref_out_opt")] 1096 | OLECHAR **pServerPrincName, 1097 | [out, annotation("_Out_opt_")] DWORD *pAuthnLevel, 1098 | [out, annotation("_Out_opt_")] DWORD *pImpLevel, 1099 | [out, annotation("_Outptr_result_maybenull_")] void **pPrivs, 1100 | [in,out, annotation("_Inout_opt_")] DWORD *pCapabilities 1101 | ); 1102 | 1103 | HRESULT ImpersonateClient(); 1104 | 1105 | HRESULT RevertToSelf(); 1106 | 1107 | BOOL IsImpersonating(); 1108 | } 1109 | 1110 | typedef enum tagRPCOPT_PROPERTIES 1111 | { 1112 | COMBND_RPCTIMEOUT = 0x01, // Rpc transport-specific timeout. 1113 | COMBND_SERVER_LOCALITY = 0x02, // server locality 1114 | COMBND_RESERVED1 = 0x04, // Reserved 1115 | COMBND_RESERVED2 = 0x05, // Reserved 1116 | COMBND_RESERVED3 = 0x08, // Reserved 1117 | COMBND_RESERVED4 = 0x10, // Reserved 1118 | } RPCOPT_PROPERTIES; 1119 | 1120 | typedef enum tagRPCOPT_SERVER_LOCALITY_VALUES 1121 | { 1122 | SERVER_LOCALITY_PROCESS_LOCAL=0, 1123 | SERVER_LOCALITY_MACHINE_LOCAL=1, 1124 | SERVER_LOCALITY_REMOTE=2 1125 | } RPCOPT_SERVER_LOCALITY_VALUES; 1126 | 1127 | 1128 | [ 1129 | object, 1130 | local, 1131 | uuid(00000144-0000-0000-C000-000000000046) 1132 | ] 1133 | interface IRpcOptions : IUnknown 1134 | { 1135 | HRESULT Set([in, annotation("_In_")] IUnknown * pPrx, 1136 | [in, annotation("_In_")] RPCOPT_PROPERTIES dwProperty, 1137 | [in, annotation("_In_")] ULONG_PTR dwValue); 1138 | 1139 | HRESULT Query([in, annotation("_In_")] IUnknown * pPrx, 1140 | [in, annotation("_In_")] RPCOPT_PROPERTIES dwProperty, 1141 | [out, annotation("_Out_")] ULONG_PTR * pdwValue); 1142 | } 1143 | 1144 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1145 | #pragma endregion 1146 | 1147 | #pragma region Application Family or OneCore Family 1148 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1149 | 1150 | //properties 1151 | typedef enum tagGLOBALOPT_PROPERTIES 1152 | { 1153 | COMGLB_EXCEPTION_HANDLING = 1, //defines COM exception handling behavior 1154 | COMGLB_APPID = 2, //sets the AppID for the process 1155 | COMGLB_RPC_THREADPOOL_SETTING = 3, // sets the ThreadPool behavior of RPC runtime in the process. 1156 | COMGLB_RO_SETTINGS = 4, // miscellaneous settings. 1157 | COMGLB_UNMARSHALING_POLICY = 5, // policy applied to CoUnmarshalInterface 1158 | COMGLB_PROPERTIES_RESERVED1 = 6, 1159 | COMGLB_PROPERTIES_RESERVED2 = 7, 1160 | COMGLB_PROPERTIES_RESERVED3 = 8, 1161 | } GLOBALOPT_PROPERTIES; 1162 | 1163 | //values 1164 | typedef enum tagGLOBALOPT_EH_VALUES 1165 | { 1166 | COMGLB_EXCEPTION_HANDLE=0, 1167 | COMGLB_EXCEPTION_DONOT_HANDLE_FATAL=1, 1168 | COMGLB_EXCEPTION_DONOT_HANDLE=COMGLB_EXCEPTION_DONOT_HANDLE_FATAL, // Alias for compatibility 1169 | COMGLB_EXCEPTION_DONOT_HANDLE_ANY=2 1170 | } GLOBALOPT_EH_VALUES; 1171 | 1172 | //values 1173 | typedef enum tagGLOBALOPT_RPCTP_VALUES 1174 | { 1175 | COMGLB_RPC_THREADPOOL_SETTING_DEFAULT_POOL = 0, // Not legal for Set. 1176 | COMGLB_RPC_THREADPOOL_SETTING_PRIVATE_POOL = 1, 1177 | } GLOBALOPT_RPCTP_VALUES; 1178 | 1179 | typedef enum tagGLOBALOPT_RO_FLAGS 1180 | { 1181 | // Remove touch messages from the message queue in the STA modal loop. 1182 | COMGLB_STA_MODALLOOP_REMOVE_TOUCH_MESSAGES = 0x1, 1183 | 1184 | // Flags that control the behavior of input message removal in 1185 | // the STA modal loop when the thread's message queue is attached. 1186 | COMGLB_STA_MODALLOOP_SHARED_QUEUE_REMOVE_INPUT_MESSAGES = 0x2, 1187 | COMGLB_STA_MODALLOOP_SHARED_QUEUE_DONOT_REMOVE_INPUT_MESSAGES = 0x4, 1188 | 1189 | // Flag to opt-in to the fast rundown option. 1190 | COMGLB_FAST_RUNDOWN = 0x8, 1191 | 1192 | // Reserved 1193 | COMGLB_RESERVED1 = 0x10, 1194 | COMGLB_RESERVED2 = 0x20, 1195 | COMGLB_RESERVED3 = 0x40, 1196 | 1197 | // Flag to opt-in to pointer message re-ordering when 1198 | // queues are attached. 1199 | COMGLB_STA_MODALLOOP_SHARED_QUEUE_REORDER_POINTER_MESSAGES = 0x80, 1200 | 1201 | COMGLB_RESERVED4 = 0x100, 1202 | COMGLB_RESERVED5 = 0x200, 1203 | COMGLB_RESERVED6 = 0x400, 1204 | 1205 | } GLOBALOPT_RO_FLAGS; 1206 | 1207 | typedef enum tagGLOBALOPT_UNMARSHALING_POLICY_VALUES 1208 | { 1209 | COMGLB_UNMARSHALING_POLICY_NORMAL = 0, 1210 | COMGLB_UNMARSHALING_POLICY_STRONG = 1, 1211 | COMGLB_UNMARSHALING_POLICY_HYBRID = 2 1212 | } GLOBALOPT_UNMARSHALING_POLICY_VALUES; 1213 | 1214 | [ 1215 | object, 1216 | local, 1217 | pointer_default(unique), 1218 | uuid(0000015B-0000-0000-C000-000000000046) 1219 | ] 1220 | interface IGlobalOptions : IUnknown 1221 | { 1222 | HRESULT Set([in, annotation("_In_")] GLOBALOPT_PROPERTIES dwProperty, 1223 | [in, annotation("_In_")] ULONG_PTR dwValue); 1224 | HRESULT Query([in, annotation("_In_")] GLOBALOPT_PROPERTIES dwProperty, 1225 | [out, annotation("_Out_")] ULONG_PTR * pdwValue); 1226 | } 1227 | 1228 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1229 | #pragma endregion 1230 | 1231 | cpp_quote( "#endif //DCOM" ) 1232 | 1233 | #pragma region Application Family or OneCore Family 1234 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1235 | 1236 | [ 1237 | uuid(00000022-0000-0000-C000-000000000046), 1238 | version(1.0), 1239 | pointer_default(unique) 1240 | , object 1241 | ] 1242 | 1243 | interface ISurrogate : IUnknown 1244 | { 1245 | typedef [unique] ISurrogate* LPSURROGATE; 1246 | 1247 | HRESULT LoadDllServer( 1248 | [in] REFCLSID Clsid); 1249 | HRESULT FreeSurrogate(); 1250 | } 1251 | 1252 | 1253 | [ 1254 | local, 1255 | object, 1256 | uuid(00000146-0000-0000-C000-000000000046) 1257 | ] 1258 | interface IGlobalInterfaceTable : IUnknown 1259 | { 1260 | typedef [unique] IGlobalInterfaceTable *LPGLOBALINTERFACETABLE; 1261 | 1262 | HRESULT RegisterInterfaceInGlobal 1263 | ( 1264 | [in, annotation("_In_")] IUnknown *pUnk, 1265 | [in, annotation("_In_")] REFIID riid, 1266 | [out, annotation("_Out_")] DWORD *pdwCookie 1267 | ); 1268 | 1269 | HRESULT RevokeInterfaceFromGlobal 1270 | ( 1271 | [in, annotation("_In_")] DWORD dwCookie 1272 | ); 1273 | 1274 | HRESULT GetInterfaceFromGlobal 1275 | ( 1276 | [in, annotation("_In_")] DWORD dwCookie, 1277 | [in, annotation("_In_")] REFIID riid, 1278 | [out, iid_is(riid), annotation("_Outptr_")] void **ppv 1279 | ); 1280 | }; 1281 | 1282 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1283 | #pragma endregion 1284 | 1285 | #pragma region Desktop Family or OneCore Family 1286 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1287 | 1288 | [ 1289 | object, 1290 | uuid(00000030-0000-0000-C000-000000000046) 1291 | ] 1292 | 1293 | interface ISynchronize : IUnknown 1294 | { 1295 | HRESULT Wait([in] DWORD dwFlags, [in] DWORD dwMilliseconds); 1296 | HRESULT Signal(); 1297 | HRESULT Reset(); 1298 | } 1299 | 1300 | 1301 | [ 1302 | local, 1303 | object, 1304 | uuid(00000031-0000-0000-C000-000000000046) 1305 | ] 1306 | interface ISynchronizeHandle : IUnknown 1307 | { 1308 | HRESULT GetHandle([out, annotation("_Out_")] HANDLE *ph ); 1309 | } 1310 | 1311 | 1312 | [ 1313 | local, 1314 | object, 1315 | uuid(00000032-0000-0000-C000-000000000046) 1316 | ] 1317 | interface ISynchronizeEvent : ISynchronizeHandle 1318 | { 1319 | HRESULT SetEventHandle([in, annotation("_In_")] HANDLE *ph ); 1320 | } 1321 | 1322 | 1323 | [ 1324 | local, 1325 | object, 1326 | uuid(00000033-0000-0000-C000-000000000046) 1327 | ] 1328 | interface ISynchronizeContainer : IUnknown 1329 | { 1330 | 1331 | HRESULT AddSynchronize([in, annotation("_In_")] ISynchronize *pSync); 1332 | 1333 | HRESULT WaitMultiple([in, annotation("_In_")] DWORD dwFlags, 1334 | [in, annotation("_In_")] DWORD dwTimeOut, 1335 | [out, annotation("_Outptr_")] ISynchronize **ppSync); 1336 | 1337 | 1338 | } 1339 | 1340 | [ 1341 | local, 1342 | object, 1343 | uuid(00000025-0000-0000-C000-000000000046) 1344 | ] 1345 | interface ISynchronizeMutex : ISynchronize 1346 | { 1347 | HRESULT ReleaseMutex(); 1348 | } 1349 | 1350 | 1351 | 1352 | [ 1353 | local, 1354 | object, 1355 | uuid(00000029-0000-0000-C000-000000000046) 1356 | ] 1357 | 1358 | interface ICancelMethodCalls : IUnknown 1359 | { 1360 | typedef [unique] ICancelMethodCalls *LPCANCELMETHODCALLS; 1361 | 1362 | HRESULT Cancel ([in, annotation("_In_")] ULONG ulSeconds); 1363 | HRESULT TestCancel (void); 1364 | } 1365 | 1366 | [ 1367 | local, 1368 | object, 1369 | uuid(0000002A-0000-0000-C000-000000000046) 1370 | ] 1371 | interface IAsyncManager : IUnknown 1372 | { 1373 | typedef enum tagDCOM_CALL_STATE 1374 | { 1375 | DCOM_NONE = 0x0, 1376 | DCOM_CALL_COMPLETE = 0x1, 1377 | DCOM_CALL_CANCELED = 0x2, 1378 | } DCOM_CALL_STATE; 1379 | 1380 | HRESULT CompleteCall ( [in, annotation("_In_")] HRESULT Result ); 1381 | HRESULT GetCallContext( 1382 | [in, annotation("_In_")] REFIID riid, 1383 | [out, annotation("_Outptr_")] void **pInterface ); 1384 | HRESULT GetState ( [out, annotation("_Out_")] ULONG *pulStateFlags); 1385 | } 1386 | 1387 | [ 1388 | local, 1389 | object, 1390 | uuid(1c733a30-2a1c-11ce-ade5-00aa0044773d), 1391 | pointer_default(unique) 1392 | ] 1393 | interface ICallFactory : IUnknown 1394 | { 1395 | HRESULT CreateCall( 1396 | [in, annotation("_In_")] REFIID riid, 1397 | [in, annotation("_In_opt_")] IUnknown *pCtrlUnk, 1398 | [in, annotation("_In_")] REFIID riid2, 1399 | [out, iid_is(riid2), annotation("_Outptr_")] IUnknown **ppv ); 1400 | } 1401 | 1402 | [ uuid(00000149-0000-0000-C000-000000000046), 1403 | version(0.0), 1404 | pointer_default(unique), 1405 | local, 1406 | object 1407 | ] 1408 | interface IRpcHelper : IUnknown 1409 | { 1410 | HRESULT GetDCOMProtocolVersion( 1411 | [out, annotation("_Out_")] DWORD *pComVersion); 1412 | 1413 | HRESULT GetIIDFromOBJREF( 1414 | [in, annotation("_In_")] void *pObjRef, 1415 | [out, annotation("_Outptr_")] IID **piid); 1416 | } 1417 | 1418 | [local, 1419 | object, 1420 | uuid(eb0cb9e8-7996-11d2-872e-0000f8080859), 1421 | ] 1422 | interface IReleaseMarshalBuffers : IUnknown 1423 | { 1424 | HRESULT ReleaseMarshalBuffer( 1425 | [in,out, annotation("_Inout_")] RPCOLEMESSAGE *pMsg, 1426 | [in, annotation("_In_")] DWORD dwFlags, 1427 | [in,unique, annotation("_In_opt_")] IUnknown *pChnl); 1428 | } 1429 | 1430 | [ 1431 | local, 1432 | object, 1433 | uuid(0000002B-0000-0000-C000-000000000046) 1434 | ] 1435 | interface IWaitMultiple : IUnknown 1436 | { 1437 | HRESULT WaitMultiple ( 1438 | [in, annotation("_In_")] DWORD timeout, 1439 | [out, annotation("_Outptr_")] ISynchronize **pSync ); 1440 | HRESULT AddSynchronize( [in, annotation("_In_")] ISynchronize *pSync ); 1441 | } 1442 | 1443 | 1444 | [ 1445 | local, 1446 | object, 1447 | uuid(00000147-0000-0000-C000-000000000046) 1448 | ] 1449 | interface IAddrTrackingControl : IUnknown 1450 | { 1451 | typedef [unique] IAddrTrackingControl* LPADDRTRACKINGCONTROL; 1452 | 1453 | HRESULT EnableCOMDynamicAddrTracking(); 1454 | HRESULT DisableCOMDynamicAddrTracking(); 1455 | }; 1456 | 1457 | [ 1458 | local, 1459 | object, 1460 | uuid(00000148-0000-0000-C000-000000000046) 1461 | ] 1462 | interface IAddrExclusionControl : IUnknown 1463 | { 1464 | typedef [unique] IAddrExclusionControl* LPADDREXCLUSIONCONTROL; 1465 | 1466 | HRESULT GetCurrentAddrExclusionList( 1467 | [in, annotation("_In_")]REFIID riid, 1468 | [out, iid_is(riid), annotation("_Outptr_")]void** ppEnumerator); 1469 | HRESULT UpdateAddrExclusionList([in, annotation("_In_")]IUnknown* pEnumerator); 1470 | }; 1471 | 1472 | /**************************************************************************** 1473 | * Pipe interfaces 1474 | ****************************************************************************/ 1475 | #if (__midl >= 500) 1476 | #define PIPE_ASYNC_UUID(async_iid) async_uuid(async_iid), 1477 | #else 1478 | #define PIPE_ASYNC_UUID(async_iid) 1479 | #endif 1480 | 1481 | #define NEW_PIPE_INTERFACE(iid, async_iid, name, type) \ 1482 | [ \ 1483 | object, \ 1484 | uuid(iid), \ 1485 | PIPE_ASYNC_UUID(async_iid) \ 1486 | pointer_default(unique) \ 1487 | ] \ 1488 | interface IPipe##name : IUnknown \ 1489 | { \ 1490 | HRESULT Pull \ 1491 | ( \ 1492 | [out, size_is(cRequest), length_is(*pcReturned)] type *buf, \ 1493 | [in] ULONG cRequest, \ 1494 | [out] ULONG *pcReturned \ 1495 | ); \ 1496 | \ 1497 | HRESULT Push \ 1498 | ( \ 1499 | [in, size_is(cSent)] type *buf, \ 1500 | [in] ULONG cSent \ 1501 | ); \ 1502 | } 1503 | 1504 | NEW_PIPE_INTERFACE( DB2F3ACA-2F86-11d1-8E04-00C04FB9989A, 1505 | DB2F3ACB-2F86-11d1-8E04-00C04FB9989A, 1506 | Byte, 1507 | BYTE) 1508 | NEW_PIPE_INTERFACE( DB2F3ACC-2F86-11d1-8E04-00C04FB9989A, 1509 | DB2F3ACD-2F86-11d1-8E04-00C04FB9989A, 1510 | Long, 1511 | LONG) 1512 | NEW_PIPE_INTERFACE( DB2F3ACE-2F86-11d1-8E04-00C04FB9989A, 1513 | DB2F3ACF-2F86-11d1-8E04-00C04FB9989A, 1514 | Double, 1515 | DOUBLE) 1516 | 1517 | 1518 | /**************************************************************************** 1519 | * Context related structures and interfaces 1520 | ****************************************************************************/ 1521 | cpp_quote("#if defined USE_COM_CONTEXT_DEF || defined BUILDTYPE_COMSVCS || defined _COMBASEAPI_ || defined _OLE32_") 1522 | 1523 | typedef DWORD CPFLAGS; 1524 | 1525 | typedef struct tagContextProperty { 1526 | GUID policyId; 1527 | CPFLAGS flags; 1528 | [unique] IUnknown *pUnk; 1529 | } ContextProperty; 1530 | 1531 | 1532 | [ 1533 | local, 1534 | object, 1535 | uuid(000001c1-0000-0000-C000-000000000046), 1536 | pointer_default(unique) 1537 | ] 1538 | interface IEnumContextProps : IUnknown 1539 | { 1540 | typedef [unique] IEnumContextProps *LPENUMCONTEXTPROPS; 1541 | 1542 | HRESULT Next([in, annotation("_In_")] ULONG celt, 1543 | [out, size_is(celt), length_is(*pceltFetched), annotation("_Out_writes_to_(celt, *pceltFetched)")] 1544 | ContextProperty *pContextProperties, 1545 | [out, annotation("_Out_")] ULONG *pceltFetched); 1546 | HRESULT Skip([in, annotation("_In_")] ULONG celt); 1547 | HRESULT Reset(); 1548 | HRESULT Clone([out, annotation("_Outptr_")] IEnumContextProps **ppEnumContextProps); 1549 | HRESULT Count([out, annotation("_Out_")] ULONG *pcelt); 1550 | } 1551 | 1552 | 1553 | [ 1554 | local, 1555 | object, 1556 | uuid(000001c0-0000-0000-C000-000000000046), 1557 | pointer_default(unique) 1558 | ] 1559 | interface IContext : IUnknown 1560 | { 1561 | //typedef [unique] IContext *LPCONTEXT; 1562 | 1563 | HRESULT SetProperty([in, annotation("_In_")] REFGUID rpolicyId, 1564 | [in, annotation("_In_")] CPFLAGS flags, 1565 | [in, annotation("_In_")] IUnknown *pUnk); 1566 | HRESULT RemoveProperty([in, annotation("_In_")] REFGUID rPolicyId); 1567 | HRESULT GetProperty([in, annotation("_In_")] REFGUID rGuid, 1568 | [out, annotation("_Out_")] CPFLAGS *pFlags, 1569 | [out, annotation("_Outptr_")] IUnknown **ppUnk); 1570 | HRESULT EnumContextProps([out, annotation("_Outptr_")] IEnumContextProps **ppEnumContextProps); 1571 | } 1572 | 1573 | 1574 | /////////////////////////////////////////////////////////////////////////////// 1575 | //NOTE: This is the section where we define OLE *PUBLIC ONLY* interfaces. If users need to 1576 | //use this definition of this interface they will need to define _OBJIDL_PUBLIC in their code. 1577 | /////////////////////////////////////////////////////////////////////////////// 1578 | #ifdef _OBJIDL_PUBLIC 1579 | 1580 | cpp_quote("#if !defined BUILDTYPE_COMSVCS && ! (defined _COMBASEAPI_ || defined _OLE32_)") 1581 | 1582 | // IObjContext interface 1583 | [ 1584 | local, 1585 | object, 1586 | uuid(000001c6-0000-0000-C000-000000000046), 1587 | pointer_default(unique) 1588 | ] 1589 | interface IObjContext : IContext 1590 | { 1591 | 1592 | void Reserved1(); 1593 | void Reserved2(); 1594 | void Reserved3(); 1595 | void Reserved4(); 1596 | void Reserved5(); 1597 | void Reserved6(); 1598 | void Reserved7(); 1599 | 1600 | } 1601 | 1602 | cpp_quote("#endif") 1603 | 1604 | #endif 1605 | 1606 | cpp_quote("#endif") 1607 | 1608 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1609 | #pragma endregion 1610 | 1611 | #pragma region Application Family or OneCore Family 1612 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1613 | 1614 | /**************************************************************************** 1615 | * GetApartmentType enums 1616 | ****************************************************************************/ 1617 | typedef enum _APTTYPEQUALIFIER 1618 | { 1619 | APTTYPEQUALIFIER_NONE = 0, 1620 | APTTYPEQUALIFIER_IMPLICIT_MTA = 1, 1621 | APTTYPEQUALIFIER_NA_ON_MTA = 2, 1622 | APTTYPEQUALIFIER_NA_ON_STA = 3, 1623 | APTTYPEQUALIFIER_NA_ON_IMPLICIT_MTA = 4, 1624 | APTTYPEQUALIFIER_NA_ON_MAINSTA = 5, 1625 | APTTYPEQUALIFIER_APPLICATION_STA = 6, 1626 | APTTYPEQUALIFIER_RESERVED_1 = 7, 1627 | } APTTYPEQUALIFIER; 1628 | 1629 | 1630 | /**************************************************************************** 1631 | * ICOMThreadingInfo and enums 1632 | ****************************************************************************/ 1633 | typedef enum _APTTYPE 1634 | { 1635 | APTTYPE_CURRENT = -1, 1636 | APTTYPE_STA = 0, 1637 | APTTYPE_MTA = 1, 1638 | APTTYPE_NA = 2, 1639 | APTTYPE_MAINSTA = 3 1640 | } APTTYPE; 1641 | 1642 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1643 | #pragma endregion 1644 | 1645 | #pragma region Desktop Family or OneCore Family 1646 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1647 | 1648 | typedef enum _THDTYPE 1649 | { 1650 | THDTYPE_BLOCKMESSAGES = 0, 1651 | THDTYPE_PROCESSMESSAGES = 1 1652 | } THDTYPE; 1653 | 1654 | typedef DWORD APARTMENTID; 1655 | 1656 | [ 1657 | local, 1658 | object, 1659 | uuid(000001ce-0000-0000-C000-000000000046), 1660 | pointer_default(unique) 1661 | ] 1662 | interface IComThreadingInfo : IUnknown 1663 | { 1664 | HRESULT GetCurrentApartmentType( [out, annotation("_Out_")] APTTYPE* pAptType ); 1665 | HRESULT GetCurrentThreadType( [out, annotation("_Out_")] THDTYPE* pThreadType ); 1666 | HRESULT GetCurrentLogicalThreadId( [out, annotation("_Out_")] GUID* pguidLogicalThreadId ); 1667 | HRESULT SetCurrentLogicalThreadId( [in, annotation("_In_")] REFGUID rguid ); 1668 | }; 1669 | 1670 | [ 1671 | object, 1672 | pointer_default(unique), 1673 | uuid(72380d55-8d2b-43a3-8513-2b6ef31434e9) 1674 | ] 1675 | interface IProcessInitControl : IUnknown 1676 | { 1677 | HRESULT ResetInitializerTimeout([in] DWORD dwSecondsRemaining); 1678 | }; 1679 | 1680 | // marker interface for objects that want to opt into the fast rundown feature. 1681 | [ 1682 | object, 1683 | local, 1684 | pointer_default(unique), 1685 | uuid(00000040-0000-0000-C000-000000000046) 1686 | ] 1687 | interface IFastRundown : IUnknown 1688 | { 1689 | }; 1690 | 1691 | 1692 | typedef enum CO_MARSHALING_CONTEXT_ATTRIBUTES 1693 | { 1694 | CO_MARSHALING_SOURCE_IS_APP_CONTAINER = 0, 1695 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_1 = 0x80000000, 1696 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_2 = 0x80000001, 1697 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_3 = 0x80000002, 1698 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_4 = 0x80000003, 1699 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_5 = 0x80000004, 1700 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_6 = 0x80000005, 1701 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_7 = 0x80000006, 1702 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_8 = 0x80000007, 1703 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_9 = 0x80000008, 1704 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_10 = 0x80000009, 1705 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_11 = 0x8000000a, 1706 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_12 = 0x8000000b, 1707 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_13 = 0x8000000c, 1708 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_14 = 0x8000000d, 1709 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_15 = 0x8000000e, 1710 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_16 = 0x8000000f, 1711 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_17 = 0x80000010, 1712 | CO_MARSHALING_CONTEXT_ATTRIBUTE_RESERVED_18 = 0x80000011, 1713 | } CO_MARSHALING_CONTEXT_ATTRIBUTES; 1714 | 1715 | [ 1716 | local, 1717 | object, 1718 | uuid(D8F2F5E6-6102-4863-9F26-389A4676EFDE), 1719 | pointer_default(unique) 1720 | ] 1721 | interface IMarshalingStream : IStream2 1722 | { 1723 | HRESULT GetMarshalingContextAttribute 1724 | ( 1725 | [in] CO_MARSHALING_CONTEXT_ATTRIBUTES attribute, 1726 | [out] ULONG_PTR *pAttributeValue 1727 | ); 1728 | }; 1729 | 1730 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_DESKTOP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1731 | #pragma endregion 1732 | 1733 | #pragma region Application Family or OneCore Family 1734 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1735 | 1736 | [ 1737 | local, 1738 | object, 1739 | uuid(C03F6A43-65A4-9818-987E-E0B810D2A6F2), 1740 | pointer_default(unique) 1741 | ] 1742 | interface IAgileReference : IUnknown 1743 | { 1744 | cpp_quote("#if defined(__cplusplus) && !defined(CINTERFACE)") 1745 | cpp_quote(" EXTERN_C const IID IID_IAgileReference;") 1746 | cpp_quote(" extern \"C++\"") 1747 | cpp_quote(" {") 1748 | cpp_quote(" MIDL_INTERFACE(\"C03F6A43-65A4-9818-987E-E0B810D2A6F2\")") 1749 | cpp_quote(" IAgileReference : public IUnknown") 1750 | cpp_quote(" {") 1751 | cpp_quote(" public:") 1752 | cpp_quote(" virtual HRESULT STDMETHODCALLTYPE Resolve( ") 1753 | cpp_quote(" /* [in] */ REFIID riid,") 1754 | cpp_quote(" /* [iid_is][retval][out] */ void **ppvObjectReference) = 0;") 1755 | cpp_quote("") 1756 | cpp_quote(" template") 1757 | cpp_quote(" HRESULT") 1758 | cpp_quote("#ifdef _M_CEE_PURE") 1759 | cpp_quote(" __clrcall") 1760 | cpp_quote("#else") 1761 | cpp_quote(" STDMETHODCALLTYPE") 1762 | cpp_quote("#endif") 1763 | cpp_quote(" Resolve(_COM_Outptr_ Q** pp)") 1764 | cpp_quote(" {") 1765 | cpp_quote(" return Resolve(__uuidof(Q), (void **)pp);") 1766 | cpp_quote(" }") 1767 | cpp_quote("") 1768 | cpp_quote(" };") 1769 | cpp_quote(" } // extern C++") 1770 | cpp_quote("#else") 1771 | HRESULT Resolve([in] REFIID riid, 1772 | [out, retval, iid_is(riid)] void **ppvObjectReference); 1773 | }; 1774 | cpp_quote("#endif") 1775 | 1776 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1777 | #pragma endregion 1778 | 1779 | #pragma region Application Family or OneCore Family 1780 | cpp_quote("#if WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES)") 1781 | 1782 | cpp_quote ("EXTERN_C const GUID IID_ICallbackWithNoReentrancyToApplicationSTA;") 1783 | 1784 | cpp_quote("#endif /* WINAPI_FAMILY_PARTITION(WINAPI_PARTITION_APP | WINAPI_PARTITION_SYSTEM | WINAPI_PARTITION_GAMES) */") 1785 | #pragma endregion 1786 | 1787 | cpp_quote("#define _OBJIDLBASE_") 1788 | cpp_quote("#endif") //_OBJIDLBASE_ 1789 | 1790 | cpp_quote("#if ( _MSC_VER >= 800 )") 1791 | cpp_quote("#if _MSC_VER >= 1200") 1792 | cpp_quote("#pragma warning(pop)") 1793 | cpp_quote("#else") 1794 | cpp_quote("#pragma warning(default:4201)") 1795 | cpp_quote("#endif") 1796 | cpp_quote("#endif") 1797 | -------------------------------------------------------------------------------- /idl/TLB_ConversionNotes.txt: -------------------------------------------------------------------------------- 1 | Types requiring changes: 2 | LPWSTR* = LONG*, then call StrFromPtr on result 3 | 4 | 5 | Types that are OK: 6 | BOOL* 7 | IStream* (with olelib reference) (have now added my own IStream definition in WebView2_edit, so should work ok) 8 | LPCWSTR 9 | 10 | 11 | VBA Type vs IDL Type: 12 | LPVOID = Any -------------------------------------------------------------------------------- /idl/WebView2.tlb: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/idl/WebView2.tlb -------------------------------------------------------------------------------- /src/APIFunctions.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "APIFunctions" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'APIFunctions 6 | '*** 7 | 8 | '---WEBVIEW2LOADER 9 | Public Declare Function CreateCoreWebView2EnvironmentWithOptions Lib "WebView2Loader.dll" (ByVal browserExecutableFolder As Long, ByVal userDataFolder As Long, ByVal environmentOptions As Long, ByVal createdEnvironmentCallback As ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler) As Long 10 | '--- 11 | 12 | '---USER32 API 13 | 'WINDOWS/FORMS/MENUS 14 | Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal uFlags As Long) As Long 15 | Public Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long 16 | Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 17 | Public Declare Function CreatePopupMenu Lib "user32" () As Long 18 | Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long 19 | Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long 20 | Public Declare Function CreateMenu Lib "user32" () As Long 21 | Public Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long 22 | Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long 23 | Public Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 24 | Public Declare Sub PostQuitMessage Lib "user32" (ByVal nExitCode As Long) 25 | '--- 26 | 27 | '---OLE32 API 28 | Public Declare Function CoInitialize Lib "ole32" (ByRef pvReserved As Any) As Long 29 | Public Declare Function CoInitializeEx Lib "ole32" (ByVal pvReserved As Long, ByVal dwCoInit As Long) As Long 30 | Public Declare Sub CoUninitialize Lib "ole32" () 31 | 'MEMORY 32 | Public Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long 33 | Public Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 34 | Public Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long 35 | Public Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long 36 | 'STREAMS 37 | Public Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long 38 | Public Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As Long, hGlobal As Long) As Long 39 | '--- 40 | 41 | '---OLEAUT32 API 42 | 'AUTOMATION/COM 43 | Public Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgvt As Any, prgpvarg As Any, pvargResult As Variant) As Long 44 | '--- 45 | 46 | '---KERNEL32 API 47 | 'STRINGS/BYTES 48 | Public Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long 49 | Public Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long 50 | 'MEMORY 51 | Public Declare Function GetAddrOf Lib "kernel32" Alias "MulDiv" (nNumber As Any, Optional ByVal nNumerator As Long = 1, Optional ByVal nDenominator As Long = 1) As Long 52 | Public Declare Function lstrlen Lib "kernel32" Alias "lstrlenW" (ByVal lpString As Long) As Long 53 | Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal length As Long) 54 | 'ERRORS 55 | Public Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long 56 | Public Declare Function GetLastError Lib "kernel32" () As Long 57 | '--- 58 | 59 | '---WINMM API 60 | 'TIME/TIMING 61 | Public Declare Function timeBeginPeriod Lib "winmm" (ByVal uPeriod As Long) As Long 62 | Public Declare Function timeEndPeriod Lib "winmm" (ByVal uPeriod As Long) As Long 63 | Public Declare Function timeGetTime Lib "winmm" () As Long 64 | '--- 65 | 66 | '---GDIPLUS 67 | 'DRAWING 68 | Public Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal Image As Long, ByVal Stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long 'note the parameter change to IUnknown 69 | Public Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, Image As Long) As Long 'note the parameter change to IUnknown 70 | '--- 71 | 72 | '---SHLWAPI 73 | 'EVENT SINKS 74 | Public Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long 75 | '--- 76 | -------------------------------------------------------------------------------- /src/AppConstants.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "AppConstants" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'AppConstants - custom constants used for the browser 6 | '*** 7 | 8 | Public Const userdata = "C:\ExcelWebView2\userdata\" 'set a profile/userdata folder to the browser to use 9 | 10 | Public Const homePageUrl = "https://google.com" 11 | 12 | 'per RFC9110, section 15 - https://www.rfc-editor.org/rfc/rfc9110.html#name-status-codes 13 | Public Enum HttpStatusCode 14 | Continue = 100 15 | SwitchingProtocols = 101 16 | Processing = 102 17 | EarlyHints = 103 18 | Ok = 200 19 | Created = 201 20 | Accepted = 202 21 | NonAuthoritativeInformation = 203 22 | NoContent = 204 23 | ResetContent = 205 24 | PartialContent = 206 25 | MultiStatus = 207 26 | AlreadyReported = 208 27 | ImUsed = 226 28 | MultipleChoices = 300 29 | MovedPermanently = 301 30 | Found = 302 31 | SeeOther = 303 32 | NotModified = 304 33 | UseProxy = 305 34 | Unused = 306 35 | TemporaryRedirect = 307 36 | PermanentRedirect = 308 37 | BadRequest = 400 38 | Unauthorized = 401 39 | PaymentRequired = 402 40 | Forbidden = 403 41 | NotFound = 404 42 | MethodNotAllowed = 405 43 | NotAcceptable = 406 44 | ProxyAuthenticationRequired = 407 45 | RequestTimeout = 408 46 | Conflict = 409 47 | Gone = 410 48 | LengthRequired = 411 49 | PreconditionFailed = 412 50 | PayloadTooLarge = 413 51 | UriTooLong = 414 52 | UnsupportedMediaType = 415 53 | RangeNotSatisfiable = 416 54 | ExpectationFailed = 417 55 | ImATeapot = 418 56 | MisdirectedRequest = 421 57 | UnprocessableEntity = 422 58 | Locked = 423 59 | FailedDependency = 424 60 | TooEarly = 425 61 | UpgradeRequired = 426 62 | PreconditionRequired = 428 63 | TooManyRequests = 429 64 | RequestHeaderFieldsTooLarge = 431 65 | UnavailableForLegalReasons = 451 66 | InternalServerError = 500 67 | NotImplemented = 501 68 | BadGateway = 502 69 | ServiceUnavailable = 503 70 | GatewayTimeout = 504 71 | HttpVersionNotSupported = 505 72 | VariantAlsoNegotiates = 506 73 | InsufficientStorage = 507 74 | LoopDetected = 508 75 | NotExtended = 510 76 | NetworkAuthenticationRequired = 511 77 | End Enum 78 | 79 | 80 | 81 | Public Enum HTTPMethod 82 | HTTP_GET 83 | HTTP_HEAD 84 | HTTP_POST 85 | HTTP_PUT 86 | HTTP_DELETE 87 | HTTP_CONNECT 88 | HTTP_OPTIONS 89 | HTTP_TRACE 90 | HTTP_PATCH 91 | End Enum 92 | 93 | 'EnumToStr generated by VBIDE_EnumToStrings for HttpStatusCode 94 | Public Function HttpStatusCodeToStr(enumVal As HttpStatusCode) As String 95 | Select Case enumVal 96 | Case HttpStatusCode.Continue 97 | HttpStatusCodeToStr = "Continue" 98 | Case HttpStatusCode.SwitchingProtocols 99 | HttpStatusCodeToStr = "SwitchingProtocols" 100 | Case HttpStatusCode.Processing 101 | HttpStatusCodeToStr = "Processing" 102 | Case HttpStatusCode.EarlyHints 103 | HttpStatusCodeToStr = "EarlyHints" 104 | Case HttpStatusCode.Ok 105 | HttpStatusCodeToStr = "Ok" 106 | Case HttpStatusCode.Created 107 | HttpStatusCodeToStr = "Created" 108 | Case HttpStatusCode.Accepted 109 | HttpStatusCodeToStr = "Accepted" 110 | Case HttpStatusCode.NonAuthoritativeInformation 111 | HttpStatusCodeToStr = "NonAuthoritativeInformation" 112 | Case HttpStatusCode.NoContent 113 | HttpStatusCodeToStr = "NoContent" 114 | Case HttpStatusCode.ResetContent 115 | HttpStatusCodeToStr = "ResetContent" 116 | Case HttpStatusCode.PartialContent 117 | HttpStatusCodeToStr = "PartialContent" 118 | Case HttpStatusCode.MultiStatus 119 | HttpStatusCodeToStr = "MultiStatus" 120 | Case HttpStatusCode.AlreadyReported 121 | HttpStatusCodeToStr = "AlreadyReported" 122 | Case HttpStatusCode.ImUsed 123 | HttpStatusCodeToStr = "ImUsed" 124 | Case HttpStatusCode.MultipleChoices 125 | HttpStatusCodeToStr = "MultipleChoices" 126 | Case HttpStatusCode.MovedPermanently 127 | HttpStatusCodeToStr = "MovedPermanently" 128 | Case HttpStatusCode.Found 129 | HttpStatusCodeToStr = "Found" 130 | Case HttpStatusCode.SeeOther 131 | HttpStatusCodeToStr = "SeeOther" 132 | Case HttpStatusCode.NotModified 133 | HttpStatusCodeToStr = "NotModified" 134 | Case HttpStatusCode.UseProxy 135 | HttpStatusCodeToStr = "UseProxy" 136 | Case HttpStatusCode.Unused 137 | HttpStatusCodeToStr = "Unused" 138 | Case HttpStatusCode.TemporaryRedirect 139 | HttpStatusCodeToStr = "TemporaryRedirect" 140 | Case HttpStatusCode.PermanentRedirect 141 | HttpStatusCodeToStr = "PermanentRedirect" 142 | Case HttpStatusCode.BadRequest 143 | HttpStatusCodeToStr = "BadRequest" 144 | Case HttpStatusCode.Unauthorized 145 | HttpStatusCodeToStr = "Unauthorized" 146 | Case HttpStatusCode.PaymentRequired 147 | HttpStatusCodeToStr = "PaymentRequired" 148 | Case HttpStatusCode.Forbidden 149 | HttpStatusCodeToStr = "Forbidden" 150 | Case HttpStatusCode.NotFound 151 | HttpStatusCodeToStr = "NotFound" 152 | Case HttpStatusCode.MethodNotAllowed 153 | HttpStatusCodeToStr = "MethodNotAllowed" 154 | Case HttpStatusCode.NotAcceptable 155 | HttpStatusCodeToStr = "NotAcceptable" 156 | Case HttpStatusCode.ProxyAuthenticationRequired 157 | HttpStatusCodeToStr = "ProxyAuthenticationRequired" 158 | Case HttpStatusCode.RequestTimeout 159 | HttpStatusCodeToStr = "RequestTimeout" 160 | Case HttpStatusCode.Conflict 161 | HttpStatusCodeToStr = "Conflict" 162 | Case HttpStatusCode.Gone 163 | HttpStatusCodeToStr = "Gone" 164 | Case HttpStatusCode.LengthRequired 165 | HttpStatusCodeToStr = "LengthRequired" 166 | Case HttpStatusCode.PreconditionFailed 167 | HttpStatusCodeToStr = "PreconditionFailed" 168 | Case HttpStatusCode.PayloadTooLarge 169 | HttpStatusCodeToStr = "PayloadTooLarge" 170 | Case HttpStatusCode.UriTooLong 171 | HttpStatusCodeToStr = "UriTooLong" 172 | Case HttpStatusCode.UnsupportedMediaType 173 | HttpStatusCodeToStr = "UnsupportedMediaType" 174 | Case HttpStatusCode.RangeNotSatisfiable 175 | HttpStatusCodeToStr = "RangeNotSatisfiable" 176 | Case HttpStatusCode.ExpectationFailed 177 | HttpStatusCodeToStr = "ExpectationFailed" 178 | Case HttpStatusCode.ImATeapot 179 | HttpStatusCodeToStr = "ImATeapot" 180 | Case HttpStatusCode.MisdirectedRequest 181 | HttpStatusCodeToStr = "MisdirectedRequest" 182 | Case HttpStatusCode.UnprocessableEntity 183 | HttpStatusCodeToStr = "UnprocessableEntity" 184 | Case HttpStatusCode.Locked 185 | HttpStatusCodeToStr = "Locked" 186 | Case HttpStatusCode.FailedDependency 187 | HttpStatusCodeToStr = "FailedDependency" 188 | Case HttpStatusCode.TooEarly 189 | HttpStatusCodeToStr = "TooEarly" 190 | Case HttpStatusCode.UpgradeRequired 191 | HttpStatusCodeToStr = "UpgradeRequired" 192 | Case HttpStatusCode.PreconditionRequired 193 | HttpStatusCodeToStr = "PreconditionRequired" 194 | Case HttpStatusCode.TooManyRequests 195 | HttpStatusCodeToStr = "TooManyRequests" 196 | Case HttpStatusCode.RequestHeaderFieldsTooLarge 197 | HttpStatusCodeToStr = "RequestHeaderFieldsTooLarge" 198 | Case HttpStatusCode.UnavailableForLegalReasons 199 | HttpStatusCodeToStr = "UnavailableForLegalReasons" 200 | Case HttpStatusCode.InternalServerError 201 | HttpStatusCodeToStr = "InternalServerError" 202 | Case HttpStatusCode.NotImplemented 203 | HttpStatusCodeToStr = "NotImplemented" 204 | Case HttpStatusCode.BadGateway 205 | HttpStatusCodeToStr = "BadGateway" 206 | Case HttpStatusCode.ServiceUnavailable 207 | HttpStatusCodeToStr = "ServiceUnavailable" 208 | Case HttpStatusCode.GatewayTimeout 209 | HttpStatusCodeToStr = "GatewayTimeout" 210 | Case HttpStatusCode.HttpVersionNotSupported 211 | HttpStatusCodeToStr = "HttpVersionNotSupported" 212 | Case HttpStatusCode.VariantAlsoNegotiates 213 | HttpStatusCodeToStr = "VariantAlsoNegotiates" 214 | Case HttpStatusCode.InsufficientStorage 215 | HttpStatusCodeToStr = "InsufficientStorage" 216 | Case HttpStatusCode.LoopDetected 217 | HttpStatusCodeToStr = "LoopDetected" 218 | Case HttpStatusCode.NotExtended 219 | HttpStatusCodeToStr = "NotExtended" 220 | Case HttpStatusCode.NetworkAuthenticationRequired 221 | HttpStatusCodeToStr = "NetworkAuthenticationRequired" 222 | End Select 223 | End Function 224 | Public Function StrToHTTPMethod(requestMethod As String) As HTTPMethod 225 | Select Case requestMethod 226 | Case "CONNECT" 227 | StrToHTTPMethod = HTTP_CONNECT 228 | Case "DELETE" 229 | StrToHTTPMethod = HTTP_DELETE 230 | Case "GET" 231 | StrToHTTPMethod = HTTP_GET 232 | Case "HEAD" 233 | StrToHTTPMethod = HTTP_HEAD 234 | Case "OPTIONS" 235 | StrToHTTPMethod = HTTP_OPTIONS 236 | Case "PATCH" 237 | StrToHTTPMethod = HTTP_PATCH 238 | Case "POST" 239 | StrToHTTPMethod = HTTP_POST 240 | Case "PUT" 241 | StrToHTTPMethod = HTTP_PUT 242 | Case "TRACE" 243 | StrToHTTPMethod = HTTP_TRACE 244 | Case Else 245 | err.Raise 0, "StrToHTTPMethod", "StrToHTTPMethod: String parameter does not match a valid HTTPMethod." 246 | End Select 247 | End Function 248 | Public Function HTTPMethodToStr(requestMethod As HTTPMethod) As String 249 | Select Case requestMethod 250 | Case HTTPMethod.HTTP_CONNECT 251 | HTTPMethodToStr = "CONNECT" 252 | Case HTTPMethod.HTTP_DELETE 253 | HTTPMethodToStr = "DELETE" 254 | Case HTTPMethod.HTTP_GET 255 | HTTPMethodToStr = "GET" 256 | Case HTTPMethod.HTTP_HEAD 257 | HTTPMethodToStr = "HEAD" 258 | Case HTTPMethod.HTTP_OPTIONS 259 | HTTPMethodToStr = "OPTIONS" 260 | Case HTTPMethod.HTTP_PATCH 261 | HTTPMethodToStr = "PATCH" 262 | Case HTTPMethod.HTTP_POST 263 | HTTPMethodToStr = "POST" 264 | Case HTTPMethod.HTTP_PUT 265 | HTTPMethodToStr = "PUT" 266 | Case HTTPMethod.HTTP_TRACE 267 | HTTPMethodToStr = "TRACE" 268 | Case Else 269 | HTTPMethodToStr = "INVALID" 270 | End Select 271 | 272 | End Function 273 | 274 | -------------------------------------------------------------------------------- /src/AppTypes.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "AppTypes" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'AppTypes - custom types used for the browser 6 | '*** 7 | 8 | 'my own version of 64bit number handling 9 | 'used with Currency data type and my functions 10 | 'LargeIntToCurrency, CurrencyToLargeInt, BytesToCurrency - in byteConversion module 11 | '(work in progress) 12 | Public Type LARGE_INTEGER 13 | LowPart As Long 14 | HighPart As Long 15 | End Type 16 | 17 | 18 | 'BROWSER/WEBVIEW2 19 | Public Type COREWEBVIEW2_CREATION_PROPERTIES 20 | browserExecutableFolder As Long 21 | userDataFolder As Long 22 | Language As Long 23 | End Type 24 | 25 | Public Type COREWEBVIEW2_ENVIRONMENT_OPTIONS 26 | AdditionalBrowserArguments As Long 27 | Language As Long 28 | ExperimentalFeaturesEnabled As Long 29 | End Type 30 | 31 | 'PLUGINS 32 | Public Type TPlugin 33 | plugin As pluginInterface 'parent 34 | container As pluginContainer 'container of "listeners" 35 | End Type 36 | -------------------------------------------------------------------------------- /src/Constants.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Constants" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'Constants 6 | '*** 7 | 8 | 'STATUS/RESULTS 9 | Public Const E_FAIL As Long = &H80004005 10 | Public Const S_OK As Long = &H0 11 | Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 12 | Public Const FORMAT_MESSAGE_IGNORE_InsertS = &H200 13 | 14 | 'SIZING/WINDOWS/SHAPES 15 | Public Const SWP_NOMOVE = &H2 16 | Public Const SWP_NOZORDER = &H4 17 | Public Const SWP_NOSIZE = &H1 18 | Public Const SW_SHOWMAXIMIZED = 3 19 | 20 | 'STRINGS/TEXT 21 | Public Const MF_STRING = &H0&: Const MF_POPUP = &H10& 22 | Public Const MF_SEPARATOR = &H800&: Const MF_GRAYED = &H1& 23 | Public Const CP_ACP = 0 ' default to ANSI code page 24 | Public Const CP_UTF8 = 65001 ' default to UTF-8 code page 25 | 26 | 'COM 27 | Public Const E_NOINTERFACE As Long = &H80004002 28 | 29 | 'MEMORY 30 | Public Const VT_BY_REF = &H4000& 31 | Public Const OFFSET_4 = 4294967296# 32 | Public Const MAXINT_4 = 2147483647 33 | -------------------------------------------------------------------------------- /src/HostObjectClass.cls: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/src/HostObjectClass.cls -------------------------------------------------------------------------------- /src/IStreamHelper.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "IStreamHelper" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'IStream helper functions - used mainly for receiving/sending WebResource request/response content 6 | '*** 7 | 8 | Public Function IStreamToString(ByVal istr As IStream) As String 9 | 'read bytes from an IStream into a unicode string 10 | On Error GoTo err 11 | Dim id As Long 12 | Dim stats As STATSTG, sb() As Byte, cSize As Currency, bRead As Currency 13 | Dim needSize As Currency 14 | Dim totalRead As Currency 15 | If Not istr Is Nothing Then 16 | istr.Stat stats, STATFLAG_DEFAULT 17 | cSize = stats.cbSize * 10000@ 18 | needSize = cSize 19 | If cSize > 0 Then 20 | If cSize > MAXINT_4 Then cSize = MAXINT_4 'prevent istream.read overflow, because it returns LONG - change IStream in .tlb to use Currency? 21 | ReDim sb(0 To needSize - 1) 'size our read buffer to match the stream size 22 | 'IStream.Read returns the number of bytes read, or 0 at end of stream 23 | 'since we can potentially receive a stream with cbSize > max 32bit Long value, 24 | 'we need to keep track separately of total bytes read as Currency 25 | 'this way we keep reading until we get the full stream even if IStream.Read reads 0 bytes but there is more in the stream to read 26 | Do While bRead < needSize Or (bRead = 0 And totalRead < needSize) 27 | bRead = bRead + istr.Read(sb(bRead), CLng(cSize)) 28 | totalRead = totalRead + bRead 29 | Loop 30 | IStreamToString = StrConv(sb, vbUnicode) 31 | Exit Function 32 | End If 33 | End If 34 | IStreamToString = "" 35 | Exit Function 36 | err: 37 | MsgBox "IStreamToString, ID=" & err.Number & ", ERR:" & err.Description 38 | End Function 39 | 40 | Public Function IStreamFromArray(ByVal arrayPtr As Long, ByVal length As Long) As stdole.IUnknown 41 | 'create an IUnknown interface with a byte array which can then be passed to anything expecting an IStream 42 | 'pass arrayPtr like VarPtr(myArray(0)) 43 | 'length = bytes to be read from ArrayPtr 44 | On Error GoTo err 45 | Dim o_hMem As Long 46 | Dim o_lpMem As Long 47 | 'allocate memory and create stream from passed byte array 48 | If arrayPtr = 0& Then 49 | CreateStreamOnHGlobal 0&, 1&, IStreamFromArray 50 | ElseIf length <> 0& Then 51 | o_hMem = GlobalAlloc(&H2&, length) 52 | If o_hMem <> 0 Then 53 | o_lpMem = GlobalLock(o_hMem) 54 | If o_lpMem <> 0 Then 55 | CopyMemory ByVal o_lpMem, ByVal arrayPtr, length 56 | Call GlobalUnlock(o_hMem) 57 | Call CreateStreamOnHGlobal(o_hMem, 1&, IStreamFromArray) 58 | End If 59 | End If 60 | End If 61 | Exit Function 62 | err: 63 | MsgBox "IStreamFromArray, ID=" & err.Number & ", ERR:" & err.Description 64 | End Function 65 | -------------------------------------------------------------------------------- /src/IUnknownFake.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "IUnknownFake" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'IUnknownFake - *NOTE* 6 | '-these functions were previously used with a factory class object to impersonate some generic IUnknown, 7 | 'especially the WebView2 event handler interfaces. creating instances of a class object and assigning/instantiating an IUnknown 8 | 'variable can allow you to perform some COM trickery and overwrite the Invoke function with your own version. 9 | 'this was a quick way to manage the events WebView2 fires but are unsupported by VBA in the early development phase. 10 | 'these functions are no longer used at the moment, but i am including them for legacy/experimental/development purposes. 11 | 'if you wish to use them, you will need to create a class module with its own internal m_This/m_VTable/m_pVTable variables, 12 | 'declare fake_IUnknown As Object, 13 | 'then call Set fake_IUnknown = InitializeVTable(m_This, m_VTable, m_pVTable) 14 | '*** 15 | 16 | Public Type IUnknownVtblObj 17 | pVTable As Long 18 | End Type 19 | Public Type IUnknownVtbl 20 | VTable(3) As Long 21 | End Type 22 | 'Private m_This as IUnknownVtblObj '<- this should be allocated in a class object to be used as some generic IUnknown, then passed into the InitializeVTable function 23 | 'Private m_VTable As IUnknownVtbl '<- this should be allocated in a class object to be used as some generic IUnknown, then passed into the InitializeVTable function 24 | 'Private m_pVTable As Long '<- this should be allocated in a class object to be used as some generic IUnknown, then passed into the InitializeVTable function 25 | 26 | Public Function InitializeVTable(ByRef this As IUnknownVtblObj, ByRef m_VTable As IUnknownVtbl, ByRef m_pVTable As Long) As IUnknown 27 | If m_pVTable = 0 Then 28 | With m_VTable 29 | .VTable(0) = GetAddress(AddressOf QueryInterface1) 30 | .VTable(1) = GetAddress(AddressOf AddRef1) 31 | .VTable(2) = GetAddress(AddressOf Release1) 32 | .VTable(3) = GetAddress(AddressOf Invoke1) 33 | 34 | m_pVTable = VarPtr(.VTable(0)) 35 | End With 36 | End If 37 | 38 | With this 39 | .pVTable = m_pVTable 40 | CopyMemory InitializeVTable, VarPtr(.pVTable), 4 41 | End With 42 | End Function 43 | Public Function QueryInterface1(this As IUnknownVtblObj, riid As Long, pvObj As Long) As Long 44 | 'not implemented 45 | pvObj = 0 46 | QueryInterface1 = E_NOINTERFACE 47 | End Function 48 | 49 | Public Function AddRef1(this As IUnknownVtblObj) As Long 50 | 'not implemented 51 | End Function 52 | 53 | Public Function Release1(this As IUnknownVtblObj) As Long 54 | 'not implemented 55 | End Function 56 | 57 | Public Function Invoke1(this As IUnknownVtblObj, Optional ByVal a1 As Long = 0, Optional ByVal a2 As Long = 0) As Long 58 | 'not implemented 59 | End Function 60 | 61 | 'feed some fake_IUnknown declared As Object in to get its IUnknown pointer back 62 | 'just a helper since ObjPtr won't work with a faked IUnknown 63 | Public Function IUnkObjPtr(ByVal pObj As IUnknown) As Long 64 | IUnkObjPtr = VarPtr(pObj) 65 | End Function 66 | -------------------------------------------------------------------------------- /src/JSON.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "JSon" 2 | 3 | ' VBA JSON parser, Backus-Naur form JSON parser based on RegEx v1.7.21 4 | ' Copyright (C) 2015-2020 omegastripes 5 | ' omegastripes@yandex.ru 6 | ' https://github.com/omegastripes/VBA-JSON-parser 7 | ' 8 | ' This program is free software: you can redistribute it and/or modify 9 | ' it under the terms of the GNU General Public License as published by 10 | ' the Free Software Foundation, either version 3 of the License, or 11 | ' (at your option) any later version. 12 | ' 13 | ' This program is distributed in the hope that it will be useful, 14 | ' but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ' GNU General Public License for more details. 17 | ' 18 | ' You should have received a copy of the GNU General Public License 19 | ' along with this program. If not, see . 20 | 21 | Option Explicit 22 | 23 | ' Need to include a reference to "Microsoft Scripting Runtime". 24 | 25 | Private sBuffer As String 26 | Private oTokens As Dictionary 27 | Private oRegEx As Object 28 | Private bMatch As Boolean 29 | Private oChunks As Dictionary 30 | Private oHeader As Dictionary 31 | Private adata() As Variant 32 | Private i As Long 33 | Private sDelim As String 34 | Private sTabChar As String 35 | Private sLfChar As String 36 | Private sSpcChar As String 37 | 38 | Sub Parse(ByVal sSample As String, vJSON As Variant, sState As String) 39 | 40 | ' Input: 41 | ' sSample - source JSON string 42 | ' Output: 43 | ' vJson - created object or array to be returned as result 44 | ' sState - string Object|Array|Error depending on result 45 | 46 | sBuffer = sSample 47 | Set oTokens = New Dictionary 48 | Set oRegEx = CreateObject("VBScript.RegExp") 49 | With oRegEx ' Patterns based on specification http://www.json.org/ 50 | .Global = True 51 | .MultiLine = True 52 | .IgnoreCase = True ' Unspecified True, False, Null accepted 53 | .Pattern = "(?:'[^']*'|""(?:\\""|[^""])*"")(?=\s*[,\:\]\}])" ' Double-quoted string, unspecified quoted string 54 | Tokenize "s" 55 | .Pattern = "[+-]?(?:\d+\.\d*|\.\d+|\d+)(?:e[+-]?\d+)?(?=\s*[,\]\}])" ' Number, E notation number 56 | Tokenize "d" 57 | .Pattern = "\b(?:true|false|null)(?=\s*[,\]\}])" ' Constants true, false, null 58 | Tokenize "c" 59 | .Pattern = "\b[A-Za-z_]\w*(?=\s*\:)" ' Unspecified non-double-quoted property name accepted 60 | Tokenize "n" 61 | .Pattern = "\s+" 62 | sBuffer = .Replace(sBuffer, "") ' Remove unnecessary spaces 63 | .MultiLine = False 64 | Do 65 | bMatch = False 66 | .Pattern = "<\d+(?:[sn])>\:<\d+[codas]>" ' Object property structure 67 | Tokenize "p" 68 | .Pattern = "\{(?:<\d+p>(?:,<\d+p>)*)?,?\}" ' Object structure 69 | Tokenize "o" 70 | .Pattern = "\[(?:<\d+[codas]>(?:,<\d+[codas]>)*)?,?\]" ' Array structure 71 | Tokenize "a" 72 | Loop While bMatch 73 | .Pattern = "^<\d+[oa]>$" ' Top level object structure, unspecified array accepted 74 | If .test(sBuffer) And oTokens.Exists(sBuffer) Then 75 | sDelim = Mid(1 / 2, 2, 1) 76 | Retrieve sBuffer, vJSON 77 | sState = IIf(IsObject(vJSON), "Object", "Array") 78 | Else 79 | vJSON = Null 80 | sState = "Error" 81 | End If 82 | End With 83 | Set oTokens = Nothing 84 | Set oRegEx = Nothing 85 | 86 | End Sub 87 | 88 | Private Sub Tokenize(sType) 89 | 90 | Dim aContent() As String 91 | Dim lCopyIndex As Long 92 | Dim i As Long 93 | Dim sKey As String 94 | 95 | With oRegEx.Execute(sBuffer) 96 | If .Count = 0 Then Exit Sub 97 | ReDim aContent(0 To .Count - 1) 98 | lCopyIndex = 1 99 | For i = 0 To .Count - 1 100 | With .Item(i) 101 | sKey = "<" & oTokens.Count & sType & ">" 102 | oTokens(sKey) = .value 103 | aContent(i) = Mid(sBuffer, lCopyIndex, .FirstIndex - lCopyIndex + 1) & sKey 104 | lCopyIndex = .FirstIndex + .length + 1 105 | End With 106 | Next 107 | End With 108 | sBuffer = Join(aContent, "") & Mid(sBuffer, lCopyIndex, Len(sBuffer) - lCopyIndex + 1) 109 | bMatch = True 110 | 111 | End Sub 112 | 113 | Private Sub Retrieve(sTokenKey, vTransfer) 114 | 115 | Dim sTokenValue As String 116 | Dim sName As Variant 117 | Dim vValue As Variant 118 | Dim aTokens() As String 119 | Dim i As Long 120 | 121 | sTokenValue = oTokens(sTokenKey) 122 | With oRegEx 123 | .Global = True 124 | Select Case Left(Right(sTokenKey, 2), 1) 125 | Case "o" 126 | Set vTransfer = New Dictionary 127 | aTokens = Split(sTokenValue, "<") 128 | For i = 1 To UBound(aTokens) 129 | Retrieve "<" & Split(aTokens(i), ">", 2)(0) & ">", vTransfer 130 | Next 131 | Case "p" 132 | aTokens = Split(sTokenValue, "<", 4) 133 | Retrieve "<" & Split(aTokens(1), ">", 2)(0) & ">", sName 134 | Retrieve "<" & Split(aTokens(2), ">", 2)(0) & ">", vValue 135 | If IsObject(vValue) Then 136 | Set vTransfer(sName) = vValue 137 | Else 138 | vTransfer(sName) = vValue 139 | End If 140 | Case "a" 141 | aTokens = Split(sTokenValue, "<") 142 | If UBound(aTokens) = 0 Then 143 | vTransfer = Array() 144 | Else 145 | ReDim vTransfer(0 To UBound(aTokens) - 1) 146 | For i = 1 To UBound(aTokens) 147 | Retrieve "<" & Split(aTokens(i), ">", 2)(0) & ">", vValue 148 | If IsObject(vValue) Then 149 | Set vTransfer(i - 1) = vValue 150 | Else 151 | vTransfer(i - 1) = vValue 152 | End If 153 | Next 154 | End If 155 | Case "n" 156 | vTransfer = sTokenValue 157 | Case "s" 158 | vTransfer = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _ 159 | Mid(sTokenValue, 2, Len(sTokenValue) - 2), _ 160 | "\""", """"), _ 161 | "\\", "\" & vbNullChar), _ 162 | "\/", "/"), _ 163 | "\b", Chr(8)), _ 164 | "\f", Chr(12)), _ 165 | "\n", vbLf), _ 166 | "\r", vbCr), _ 167 | "\t", vbTab) 168 | .Global = False 169 | .Pattern = "\\u[0-9a-fA-F]{4}" 170 | Do While .test(vTransfer) 171 | vTransfer = .Replace(vTransfer, ChrW(("&H" & Right(.Execute(vTransfer)(0).value, 4)) * 1)) 172 | Loop 173 | vTransfer = Replace(vTransfer, "\" & vbNullChar, "\") 174 | Case "d" 175 | vTransfer = CDbl(Replace(sTokenValue, ".", sDelim)) 176 | Case "c" 177 | Select Case LCase(sTokenValue) 178 | Case "true" 179 | vTransfer = True 180 | Case "false" 181 | vTransfer = False 182 | Case "null" 183 | vTransfer = Null 184 | End Select 185 | End Select 186 | End With 187 | 188 | End Sub 189 | 190 | Function Serialize(vJSON As Variant, Optional sTab As String = vbTab) As String 191 | 192 | If sTab = "" Then 193 | sTabChar = "" 194 | sLfChar = "" 195 | sSpcChar = "" 196 | Else 197 | sTabChar = sTab 198 | sLfChar = vbCrLf 199 | sSpcChar = " " 200 | End If 201 | Set oChunks = New Dictionary 202 | SerializeElement vJSON, "" 203 | Serialize = Join(oChunks.Items(), "") 204 | Set oChunks = Nothing 205 | 206 | End Function 207 | 208 | Private Sub SerializeElement(vElement As Variant, ByVal sIndent As String) 209 | 210 | Dim aKeys() As Variant 211 | Dim i As Long 212 | 213 | With oChunks 214 | Select Case VarType(vElement) 215 | Case vbObject 216 | If Not TypeOf vElement Is Dictionary Then 217 | .Item(.Count) = "{}" 218 | ElseIf vElement.Count = 0 Then 219 | .Item(.Count) = "{}" 220 | Else 221 | .Item(.Count) = "{" & sLfChar 222 | aKeys = vElement.Keys 223 | For i = 0 To UBound(aKeys) 224 | .Item(.Count) = sIndent & sTabChar & """" & EscapeJsonString(aKeys(i)) & """" & ":" & sSpcChar 225 | SerializeElement vElement(aKeys(i)), sIndent & sTabChar 226 | If Not (i = UBound(aKeys)) Then .Item(.Count) = "," 227 | .Item(.Count) = sLfChar 228 | Next 229 | .Item(.Count) = sIndent & "}" 230 | End If 231 | Case Is >= vbArray 232 | If UBound(vElement) = -1 Then 233 | .Item(.Count) = "[]" 234 | Else 235 | .Item(.Count) = "[" & sLfChar 236 | For i = 0 To UBound(vElement) 237 | .Item(.Count) = sIndent & sTabChar 238 | SerializeElement vElement(i), sIndent & sTabChar 239 | If Not (i = UBound(vElement)) Then .Item(.Count) = "," 'sResult = sResult & "," 240 | .Item(.Count) = sLfChar 241 | Next 242 | .Item(.Count) = sIndent & "]" 243 | End If 244 | Case vbInteger, vbLong 245 | .Item(.Count) = vElement 246 | Case vbSingle, vbDouble 247 | .Item(.Count) = Replace(vElement, ",", ".") 248 | Case vbNull, vbError 249 | 250 | .Item(.Count) = "null" 251 | Case vbBoolean 252 | .Item(.Count) = IIf(vElement, "true", "false") 253 | Case Else 254 | .Item(.Count) = """" & EscapeJsonString(vElement) & """" 255 | End Select 256 | End With 257 | 258 | End Sub 259 | 260 | Private Function EscapeJsonString(s) 261 | 262 | EscapeJsonString = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(s, _ 263 | "\", "\\"), _ 264 | """", "\"""), _ 265 | "/", "\/"), _ 266 | Chr(8), "\b"), _ 267 | Chr(12), "\f"), _ 268 | vbLf, "\n"), _ 269 | vbCr, "\r"), _ 270 | vbTab, "\t") 271 | 272 | End Function 273 | 274 | Function ToYaml(vJSON As Variant) As String 275 | 276 | Select Case VarType(vJSON) 277 | Case vbObject, Is >= vbArray 278 | Set oChunks = New Dictionary 279 | ToYamlElement vJSON, "" 280 | oChunks.Remove 0 281 | ToYaml = Join(oChunks.Items(), "") 282 | Set oChunks = Nothing 283 | Case vbNull, vbError 284 | ToYaml = "Null" 285 | Case vbBoolean 286 | ToYaml = IIf(vJSON, "True", "False") 287 | Case Else 288 | ToYaml = CStr(vJSON) 289 | End Select 290 | 291 | End Function 292 | 293 | Private Sub ToYamlElement(vElement As Variant, ByVal sIndent As String) 294 | 295 | Dim aKeys() As Variant 296 | Dim i As Long 297 | 298 | With oChunks 299 | Select Case VarType(vElement) 300 | Case vbObject 301 | If Not TypeOf vElement Is Dictionary Then 302 | .Item(.Count) = "''" 303 | ElseIf vElement.Count = 0 Then 304 | .Item(.Count) = "''" 305 | Else 306 | .Item(.Count) = vbCrLf 307 | aKeys = vElement.Keys 308 | For i = 0 To UBound(aKeys) 309 | .Item(.Count) = sIndent & aKeys(i) & ": " 310 | ToYamlElement vElement(aKeys(i)), sIndent & " " 311 | If Not (i = UBound(aKeys)) Then .Item(.Count) = vbCrLf 312 | Next 313 | End If 314 | Case Is >= vbArray 315 | If UBound(vElement) = -1 Then 316 | .Item(.Count) = "''" 317 | Else 318 | .Item(.Count) = vbCrLf 319 | For i = 0 To UBound(vElement) 320 | .Item(.Count) = sIndent & i & ": " 321 | ToYamlElement vElement(i), sIndent & " " 322 | If Not (i = UBound(vElement)) Then .Item(.Count) = vbCrLf 323 | Next 324 | End If 325 | Case vbNull, vbError 326 | 327 | .Item(.Count) = "Null" 328 | Case vbBoolean 329 | .Item(.Count) = IIf(vElement, "True", "False") 330 | Case Else 331 | .Item(.Count) = CStr(vElement) 332 | End Select 333 | End With 334 | 335 | End Sub 336 | 337 | Sub ToArray(vJSON As Variant, aRows() As Variant, aheader() As Variant) 338 | 339 | ' Input: 340 | ' vJSON - Array or Object which contains rows data 341 | ' Output: 342 | ' aRows - 2d array representing JSON data 343 | ' aHeader - 1d array of property names 344 | 345 | Dim sName As Variant 346 | 347 | Set oHeader = New Dictionary 348 | Select Case VarType(vJSON) 349 | Case vbObject 350 | If vJSON.Count > 0 Then 351 | ReDim adata(0 To vJSON.Count - 1, 0 To 0) 352 | oHeader("#") = 0 353 | i = 0 354 | For Each sName In vJSON.Keys 355 | adata(i, 0) = sName 356 | ToArrayElement vJSON(sName), "" 357 | i = i + 1 358 | Next 359 | Else 360 | ReDim adata(0 To 0, 0 To 0) 361 | End If 362 | Case Is >= vbArray 363 | If UBound(vJSON) >= 0 Then 364 | ReDim adata(0 To UBound(vJSON), 0 To 0) 365 | For i = 0 To UBound(vJSON) 366 | ToArrayElement vJSON(i), "" 367 | Next 368 | Else 369 | ReDim adata(0 To 0, 0 To 0) 370 | End If 371 | Case Else 372 | ReDim adata(0 To 0, 0 To 0) 373 | adata(0, 0) = vJSON 374 | End Select 375 | aheader = oHeader.Keys() 376 | Set oHeader = Nothing 377 | aRows = adata 378 | Erase adata 379 | 380 | End Sub 381 | 382 | Private Sub ToArrayElement(vElement As Variant, sFieldName As String) 383 | 384 | Dim sName As Variant 385 | Dim j As Long 386 | 387 | Select Case VarType(vElement) 388 | Case vbObject ' Collection of objects 389 | For Each sName In vElement.Keys 390 | ToArrayElement vElement(sName), sFieldName & IIf(sFieldName = "", "", ".") & sName 391 | Next 392 | Case Is >= vbArray ' Collection of arrays 393 | For j = 0 To UBound(vElement) 394 | ToArrayElement vElement(j), sFieldName & "[" & j & "]" 395 | Next 396 | Case Else 397 | If Not oHeader.Exists(sFieldName) Then 398 | oHeader(sFieldName) = oHeader.Count 399 | If UBound(adata, 2) < oHeader.Count - 1 Then ReDim Preserve adata(0 To UBound(adata, 1), 0 To oHeader.Count - 1) 400 | End If 401 | j = oHeader(sFieldName) 402 | adata(i, j) = vElement 403 | End Select 404 | 405 | End Sub 406 | 407 | Sub Flatten(vJSON As Variant, vResult As Variant) 408 | 409 | ' Input: 410 | ' vJSON - Array or Object which contains JSON data 411 | ' Output: 412 | ' oResult - Flatten JSON data object 413 | 414 | Set oChunks = New Dictionary 415 | FlattenElement vJSON, "" 416 | Set vResult = oChunks 417 | Set oChunks = Nothing 418 | 419 | End Sub 420 | 421 | Private Sub FlattenElement(vElement As Variant, sProperty As String) 422 | 423 | Dim vKey 424 | Dim i As Long 425 | 426 | Select Case True 427 | Case TypeOf vElement Is Dictionary 428 | If vElement.Count > 0 Then 429 | For Each vKey In vElement.Keys 430 | FlattenElement vElement(vKey), IIf(sProperty <> "", sProperty & "." & vKey, vKey) 431 | Next 432 | End If 433 | Case IsObject(vElement) 434 | Case IsArray(vElement) 435 | For i = 0 To UBound(vElement) 436 | FlattenElement vElement(i), sProperty & "[" & i & "]" 437 | Next 438 | Case Else 439 | oChunks(sProperty) = vElement 440 | End Select 441 | 442 | End Sub 443 | 444 | Sub Unflatten(oFlatten, vJSON, bSuccess) 445 | 446 | ' Input: 447 | ' oFlatten - source dictionary containing JSON data 448 | ' Output: 449 | ' vJSON - created object or array to be returned as result 450 | ' bSuccess - boolean indicating successful completion 451 | 452 | Dim sPath 453 | Dim vValue 454 | Dim aQualifiers 455 | Dim lNextLevel 456 | 457 | bSuccess = TypeOf oFlatten Is Dictionary 458 | If Not bSuccess Then Exit Sub 459 | For Each sPath In oFlatten.Keys 460 | If IsObject(oFlatten(sPath)) Then 461 | Set vValue = oFlatten(sPath) 462 | Else 463 | vValue = oFlatten(sPath) 464 | End If 465 | If Left(sPath, 1) <> "[" And Left(sPath, 1) <> "." Then 466 | sPath = "." & sPath 467 | End If 468 | aQualifiers = Split(Replace(Replace(sPath, ".", vbNullChar), "[", vbNullChar), vbNullChar) 469 | lNextLevel = 1 470 | UnflattenElement vJSON, lNextLevel, aQualifiers, vValue, bSuccess 471 | If Not bSuccess Then Exit Sub 472 | Next 473 | 474 | End Sub 475 | 476 | Private Sub UnflattenElement(vParent, lNextLevel, aQualifiers, vValue, bSuccess) 477 | 478 | Dim vNextQualifier 479 | Dim sNum 480 | Dim vChild 481 | 482 | bSuccess = False 483 | If lNextLevel > UBound(aQualifiers) Then 484 | If IsObject(vValue) Then 485 | Set vParent = vValue 486 | Else 487 | vParent = vValue 488 | End If 489 | bSuccess = True 490 | Exit Sub 491 | End If 492 | vNextQualifier = aQualifiers(lNextLevel) 493 | If Right(vNextQualifier, 1) = "]" Then 494 | sNum = Left(vNextQualifier, Len(vNextQualifier) - 1) 495 | If IsNumeric(sNum) Then 496 | vNextQualifier = CLng(sNum) 497 | End If 498 | End If 499 | If VarType(vNextQualifier) = vbLong Then 500 | If VarType(vParent) = vbEmpty Then 501 | vParent = Array() 502 | ElseIf Not IsArray(vParent) Then 503 | Exit Sub 504 | End If 505 | If UBound(vParent) < vNextQualifier Then 506 | ReDim Preserve vParent(vNextQualifier) 507 | End If 508 | Else 509 | If VarType(vParent) = vbEmpty Then 510 | Set vParent = New Dictionary 511 | ElseIf Not IsObject(vParent) Then 512 | Exit Sub 513 | ElseIf Not TypeOf vParent Is Dictionary Then 514 | Exit Sub 515 | End If 516 | End If 517 | If IsObject(vParent(vNextQualifier)) Then 518 | Set vChild = vParent(vNextQualifier) 519 | Else 520 | vChild = vParent(vNextQualifier) 521 | End If 522 | UnflattenElement vChild, lNextLevel + 1, aQualifiers, vValue, bSuccess 523 | If Not bSuccess Then 524 | Exit Sub 525 | End If 526 | If IsObject(vChild) Then 527 | Set vParent(vNextQualifier) = vChild 528 | Else 529 | vParent(vNextQualifier) = vChild 530 | End If 531 | bSuccess = True 532 | 533 | End Sub 534 | 535 | -------------------------------------------------------------------------------- /src/JSONextensions.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "JSONextensions" 2 | Option Explicit 3 | 'WIP 4 | 'Lucas Plumb @ 2023 5 | 'functions to help interpret JSON requests/responses into a more digestible, 6 | 'VBA friendly format for replication/manipulation 7 | Function beautifyJSON(ByVal sJSONString As String) As String 8 | Dim vJSON As Variant 9 | Dim vflat As Variant 10 | Dim sState As String 11 | Dim out As String, tmpStr As String, lines() As String 12 | Dim i As Integer, v As Variant, x As Variant 13 | Dim aheader() As Variant, adata() As Variant 14 | Dim linecounter As Integer 15 | 16 | JSon.Parse sJSONString, vJSON, sState 17 | 18 | Select Case True 19 | Case sState <> "Object" 20 | 'parseData = -1 21 | Debug.Print "data not an object" 22 | Exit Function 23 | Case Else 24 | Debug.Print "got object" 25 | 26 | JSon.Flatten vJSON, vflat 27 | ' For Each v In vFlat.Items 28 | ' Debug.Print v 29 | ' Next v 30 | out = out & "-----" & vbCrLf 31 | For Each v In vflat.Keys 32 | out = out & v & "-" & vflat(v) & "///" & vbCrLf 33 | 'JSon.ToArray vFlat(v), adata, aheader 34 | 'Debug.Print aheader(0) & "-" & adata(0) & vbCrLf 35 | Next v 36 | 37 | 'For i = 0 To UBound(adata) 38 | 'Debug.Print adata 39 | 'Next i 40 | out = out & "-----" & vbCrLf 41 | tmpStr = JSon.Serialize(vJSON) 42 | tmpStr = Replace(tmpStr, """", """""") 43 | lines = Split(tmpStr, vbCrLf) 44 | For i = 0 To UBound(lines) 45 | If linecounter >= 23 Then 46 | linecounter = 0 47 | If Right$(out, 6) = " & _" & vbCrLf Then 48 | out = Left$(out, Len(out) - 6) & vbCrLf 49 | End If 50 | out = out & "req = req & _ " & vbCrLf 51 | Else 52 | linecounter = linecounter + 1 53 | End If 54 | lines(i) = Replace(lines(i), """", """""", 1, 1) 55 | If i = 0 Then 56 | lines(0) = """" & lines(0) 57 | End If 58 | lines(i) = lines(i) & """" 59 | If i < UBound(lines) Then 60 | lines(i) = lines(i) & " & _" 61 | lines(i) = lines(i) & vbCrLf 62 | End If 63 | If Left$(Replace(lines(i), vbTab, ""), 1) <> """" Then 64 | lines(i) = Replace(lines(i), Left$(Replace(lines(i), vbTab, ""), 1), """" & Left$(Replace(lines(i), vbTab, ""), 1), 1, 1) 65 | End If 66 | If i = 0 Then 67 | lines(i) = "req = " & lines(i) 68 | End If 69 | out = out & lines(i) 70 | Next i 71 | 72 | 73 | End Select 74 | 75 | beautifyJSON = out 76 | End Function 77 | -------------------------------------------------------------------------------- /src/MemoryFunctions.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "MemoryFunctions" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'MemoryFunctions 6 | '*** 7 | 8 | 'a little hack similar to GetAddress and AddressOf 9 | Public Function GetBaseAddress(vb_array As Variant) As Long 10 | Dim vType As Integer 11 | 'First 2 bytes are the VARENUM. 12 | CopyMemory vType, vb_array, 2 13 | Dim lp As Long 14 | 'Get the data pointer. 15 | CopyMemory lp, ByVal VarPtr(vb_array) + 8, 4 16 | 'Make sure the VARENUM is a pointer. 17 | If (vType And VT_BY_REF) <> 0 Then 18 | 'Dereference it for the variant data address. 19 | CopyMemory lp, ByVal lp, 4 20 | 'Read the SAFEARRAY data pointer. 21 | Dim address As Long 22 | CopyMemory address, ByVal lp, 16 23 | GetBaseAddress = address 24 | End If 25 | End Function 26 | 27 | 'conversion for LPWSTR* frequently used in the WebView2.tlb, which we have converted to LONG* as VBA automation doesnt support LPWSTR* 28 | Public Function StrFromPtr(ByVal lpStr As Long) As String 29 | Dim bStr() As Byte 30 | Dim cChars As Long 31 | On Error Resume Next 32 | ' Get the number of characters in the buffer 33 | cChars = lstrlen(lpStr) * 2 34 | If cChars > 0 Then 35 | ' Resize the byte array 36 | ReDim bStr(0 To cChars - 1) As Byte 37 | ' Grab the ANSI buffer 38 | Call CopyMemory(bStr(0), ByVal lpStr, cChars) 39 | End If 40 | ' Now convert to a VB Unicode string 41 | StrFromPtr = bStr 42 | End Function 43 | 44 | 'unused at the moment 45 | Private Function GetStrFromPtrW(ByVal Ptr As Long) As String 46 | SysReAllocString VarPtr(GetStrFromPtrW), Ptr 47 | End Function 48 | 49 | 'bitwise shift right 50 | Public Function shr(ByVal value As Long, ByVal Shift As Byte) As Long 51 | Dim i As Byte 52 | shr = value 53 | If Shift > 0 Then 54 | shr = Int(shr / (2 ^ Shift)) 55 | End If 56 | End Function 57 | 'bitwise shift left 58 | Public Function shl(ByVal value As Long, ByVal Shift As Byte) As Long 59 | shl = value 60 | If Shift > 0 Then 61 | Dim i As Byte 62 | Dim m As Long 63 | For i = 1 To Shift 64 | m = shl And &H40000000 65 | shl = (shl And &H3FFFFFFF) * 2 66 | If m <> 0 Then 67 | shl = shl Or &H80000000 68 | End If 69 | Next i 70 | End If 71 | End Function 72 | 73 | '(WIP) - HRESULT to WIN32 error code 74 | '#define FACILITY_WIN32 0x0007 75 | '#define __HRESULT_FROM_WIN32(x) ((HRESULT)(x) <= 0 ? ((HRESULT)(x)) : ((HRESULT) (((x) & 0x0000FFFF) | (FACILITY_WIN32 << 16) | 0x80000000))) 76 | Function hresToWin32(e As Long) As Long 77 | If e <= 0 Then hresToWin32 = e: Exit Function 78 | Dim s1 As Long, s2 As Long, s3 As Long 79 | s1 = e And &HFFFF& 80 | s2 = shl(&H7&, 16) 81 | s3 = &H80000000 82 | hresToWin32 = s1 Or s2 Or s3 83 | End Function 84 | -------------------------------------------------------------------------------- /src/Types.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "Types" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'Types - generic win32 and other types 6 | '*** 7 | 8 | 'WINDOWS/DRAWING/SIZING 9 | Public Type RECT 10 | Left As Long 11 | Top As Long 12 | Right As Long 13 | Bottom As Long 14 | End Type 15 | 16 | Public Type POINTAPI 17 | x As Long 18 | Y As Long 19 | End Type 20 | 21 | Public Type GUID 22 | Data1 As Long 23 | Data2 As Integer 24 | Data3 As Integer 25 | Data4(0 To 7) As Byte 26 | End Type 27 | -------------------------------------------------------------------------------- /src/UserForm1.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} UserForm1 3 | Caption = "ExcelWebView2" 4 | ClientHeight = 15000 5 | ClientLeft = 120 6 | ClientTop = 465 7 | ClientWidth = 22080 8 | OleObjectBlob = "UserForm1.frx":0000 9 | ShowModal = 0 'False 10 | StartUpPosition = 2 'CenterScreen 11 | End 12 | Attribute VB_Name = "UserForm1" 13 | Attribute VB_GlobalNameSpace = False 14 | Attribute VB_Creatable = False 15 | Attribute VB_PredeclaredId = True 16 | Attribute VB_Exposed = False 17 | Option Explicit 18 | 19 | 'WIP 20 | 'Dim HostObj As New HostObjectClass 21 | ' 22 | 'Function AddHostObjectToScript_OleExp(ObjName As String, obj1 As Object) As Boolean 23 | 'On Error GoTo err 24 | ' Dim ICoreWebView2A As ICoreWebView2 25 | ' Dim NN As IUnknown 26 | ' Set NN = webviewWindow 27 | ' Set ICoreWebView2A = NN 28 | ' ICoreWebView2A.AddHostObjectToScript StrPtr(ObjName), obj1 29 | ' AddHostObjectToScript_OleExp = True 30 | 'Exit Function 31 | 'err: 32 | 'MsgBox "errhost:" & err.Number & "," & err.Description 33 | 'End Function 34 | ' 35 | 'Private Sub AddHostObject() 36 | ' If AddHostObjectToScript_NEW("HostClass", HostObj) Then 37 | ' ExecuteScript "const HostClassA=window.chrome.webview.hostObjects.HostClass;" 38 | ' ExecuteScript "const HostClassA2=window.chrome.webview.hostObjects.sync.HostClass;" 39 | ' 'ExecuteScript "alert(HostClassA2.ClassAdd(33,44));" 40 | ' 'DoAddHostObjectToScript.Enabled = False 41 | ' End If 42 | 'End Sub 43 | 44 | Private Sub browserTabs_Change() 45 | If (Not Not g_wv2) <> 0 Then 46 | g_wv2(browserTabs.SelectedItem.index).Focus 47 | g_selectedTabIndex = browserTabs.SelectedItem.index 48 | End If 49 | End Sub 50 | 51 | Private Sub cmdBack_Click() 52 | ActiveBrowserTab.GoBack 53 | End Sub 54 | 55 | Private Sub cmdForward_Click() 56 | ActiveBrowserTab.GoForward 57 | End Sub 58 | 59 | Private Sub cmdNewTab_Click() 60 | factory.NewTab 61 | End Sub 62 | 63 | Private Sub cmdStopReload_Click() 64 | Dim i As Long 65 | If cmdStopReload.Caption = "X" Then 66 | For i = 0 To UBound(g_wv2) 67 | g_wv2(i).StopLoading 68 | Next i 69 | Else 70 | ActiveBrowserTab.Reload 71 | End If 72 | End Sub 73 | 74 | Private Sub CommandButton10_Click() 75 | ActiveBrowserTab.ExecuteScript "eval(1+1);" 76 | pluginExample.Search1 77 | pluginExample.Search2 78 | pluginExample.Search3 79 | pluginExample.Search4 80 | End Sub 81 | 82 | Private Sub CommandButton7_Click() 83 | g_wv2(browserTabs.SelectedItem.index).OpenDevTools 84 | End Sub 85 | 86 | Private Sub txtUrl_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 87 | If KeyCode = vbKeyReturn Then 88 | ActiveBrowserTab.OpenUrl txtUrl.Text 89 | txtUrl.SelStart = 0 90 | txtUrl.SelLength = Len(txtUrl.Text) 91 | End If 92 | End Sub 93 | 94 | Private Sub UserForm_Initialize() 95 | factory.NewTab 96 | frmTools.Show 97 | End Sub 98 | 99 | Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 100 | WV2Globals.CleanUp 101 | frmTools.Hide 102 | Unload Me 103 | End Sub 104 | 105 | Private Sub UserForm_Error(ByVal Number As Integer, ByVal Description As MSForms.ReturnString, ByVal SCode As Long, ByVal source As String, ByVal HelpFile As String, ByVal HelpContext As Long, ByVal CancelDisplay As MSForms.ReturnBoolean) 106 | 107 | End Sub 108 | 109 | 110 | 111 | 112 | -------------------------------------------------------------------------------- /src/UserForm1.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/src/UserForm1.frx -------------------------------------------------------------------------------- /src/WV2Globals.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "WV2Globals" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'WV2Globals 6 | '-generally used to store state/collected data during browser operations 7 | 'make sure anything written to in here is cleaned up when the browser is closed, 8 | 'so the garbage collector can free up the memory used, and to prevent bugs between browsing sessions 9 | '*** 10 | 11 | 'store information as we browse 12 | Public dicData As New Dictionary 13 | Public dicRequests As New Dictionary 14 | Public dicResponses As New Dictionary 15 | Public dicContentHandlers As New Dictionary 16 | 17 | 'browser environment/control/display specific globals 18 | Public g_wv2Env As wv2Environment 19 | Public g_Env As ICoreWebView2Environment 20 | Public g_webFrame As Control 21 | Public g_webHostHwnd As Long 22 | Public g_wv2() As wv2 23 | Public g_selectedTabIndex As Long 24 | 25 | Public Sub CleanUp() 26 | 27 | Dim i As Integer 28 | 29 | Debug.Print "cleaning up" 30 | 31 | For i = 0 To UBound(g_wv2) 32 | Set g_wv2(i) = Nothing 33 | Next i 34 | 35 | Erase g_wv2 36 | Set g_wv2Env = Nothing 37 | Set g_Env = Nothing 38 | Set g_webFrame = Nothing 39 | 40 | 'Unload WebView 41 | 'Unload WebviewMethodDc 42 | 'Set WebviewMethodDc = Nothing 43 | 44 | If dicData.Count > 0 Then 45 | For i = 0 To dicData.Count - 1 46 | ' Unload dicData(i) 47 | Set dicData(i) = Nothing 48 | Next i 49 | End If 50 | If dicRequests.Count > 0 Then 51 | For i = 0 To dicRequests.Count - 1 52 | ' Unload dicRequests(i) 53 | Set dicRequests(i) = Nothing 54 | Next i 55 | End If 56 | If dicResponses.Count > 0 Then 57 | For i = 0 To dicResponses.Count - 1 58 | ' Unload dicResponses(i) 59 | Set dicResponses(i) = Nothing 60 | Next i 61 | End If 62 | If dicContentHandlers.Count > 0 Then 63 | For i = 0 To dicContentHandlers.Count - 1 64 | Unload dicContentHandlers(i) 65 | Set dicContentHandlers(i) = Nothing 66 | Next i 67 | End If 68 | 'Unload dicData 69 | 'Unload dicRequests 70 | 'Unload dicResponses 71 | 'Unload dicContentHandlers 72 | Set dicData = Nothing 73 | Set dicRequests = Nothing 74 | Set dicResponses = Nothing 75 | Set dicContentHandlers = Nothing 76 | 77 | PluginManager.Kill 78 | 79 | 80 | Debug.Print "cleaned up" 81 | End Sub 82 | 83 | 'return the wv2 object of the currently selected tab 84 | Public Property Get ActiveBrowserTab() As wv2 85 | Set ActiveBrowserTab = g_wv2(g_selectedTabIndex) 'g_selectedTabIndex is set by UserForm1.browserTabs_Change() 86 | End Property 87 | 88 | 89 | -------------------------------------------------------------------------------- /src/WV2Tools.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "WV2Tools" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'WV2Tools 6 | 'contains helper functions for the frmTools UserForm, and general WebView2 specific helpers 7 | '*** 8 | 9 | Public Sub logResource(ByRef res As clsWebResData, resDict As Dictionary) 10 | Dim strURIpart As String 11 | 12 | resDict.Add resDict.Count, res 13 | If Len(res.uri) > 25 Then 14 | strURIpart = Left$(res.uri, 22) & "..." 15 | Else 16 | strURIpart = res.uri 17 | End If 18 | 19 | If res.metaTitle = "RESPONSE" Then 20 | dicResponses.Add dicResponses.Count, res 21 | frmTools.lstDataResponses.AddItem strURIpart, 0 22 | frmTools.lstDataResponses.TopIndex = 0 23 | End If 24 | End Sub 25 | 26 | Public Function StringFromWebData(ByRef req As clsWebResData) As String 27 | Dim sdata As String 28 | sdata = req.metaTitle & vbCrLf & "{" & vbCrLf & vbTab & req.Method & "|" & req.uri & vbCrLf & vbTab & "Headers:" & vbCrLf & vbTab & req.Headers & vbCrLf 29 | If Len(req.reqContent) > 0 Then sdata = sdata & vbTab & "REQContent:" & vbCrLf & vbTab & req.reqContent & vbCrLf 30 | If Len(req.resContent) > 0 Then sdata = sdata & vbTab & "RESContent:" & vbCrLf & vbTab & req.resContent & vbCrLf 31 | sdata = sdata & "}" & vbCrLf & vbCrLf 32 | StringFromWebData = sdata 33 | End Function 34 | 35 | Public Function OutputRawData(ByRef req As clsWebResData, ByRef txtBox As MSForms.TextBox) 36 | ' Dim sdata As String 37 | ' sdata = req.metaTitle & vbCrLf & "{" & vbCrLf & vbTab & req.Method & "|" & req.URI & vbCrLf & vbTab & "Headers:" & vbCrLf & vbTab & req.Headers & vbCrLf 38 | ' If Len(req.resContent) > 0 Then sdata = sdata & vbTab & "Content:" & vbCrLf & vbTab & req.resContent & vbCrLf 39 | ' sdata = sdata & "}" & vbCrLf & vbCrLf 40 | 'StringFromWebData 41 | Dim strURIpart As String 42 | If Len(req.uri) > 25 Then 43 | strURIpart = Left$(req.uri, 22) & "..." 44 | Else 45 | strURIpart = req.uri 46 | End If 47 | 48 | dicData.Add dicData.Count, req 49 | frmTools.lstDataSingle.AddItem strURIpart, 0 50 | frmTools.lstDataSingle.TopIndex = 0 51 | If req.metaTitle = "REQUEST" Then 52 | dicRequests.Add dicRequests.Count, req 53 | frmTools.lstDataRequests.AddItem strURIpart, 0 54 | frmTools.lstDataRequests.TopIndex = 0 55 | End If 56 | If req.metaTitle = "RESPONSE" Then 57 | dicResponses.Add dicResponses.Count, req 58 | frmTools.lstDataResponses.AddItem strURIpart, 0 59 | frmTools.lstDataResponses.TopIndex = 0 60 | End If 61 | 62 | If Not txtBox Is Nothing Then 63 | txtBox.Text = StringFromWebData(req) & txtBox.Text 64 | End If 65 | 66 | End Function 67 | 68 | Public Function HttpHeadersToString(ByRef iterator As ICoreWebView2HttpHeadersCollectionIterator) As String 69 | Dim sHeader As String 70 | Dim hName As Long, hVal As Long, sName As String, sVal As String 71 | If Not iterator Is Nothing Then 72 | Do While iterator.HasCurrentHeader 73 | iterator.GetCurrentHeader hName, hVal 74 | If hName <> 0 Then sName = StrFromPtr(hName) 75 | If hVal <> 0 Then sVal = StrFromPtr(hVal) 76 | If sName <> "" Or sVal <> "" Then 77 | sHeader = sHeader & sName & ":" & sVal & vbCrLf 78 | End If 79 | iterator.MoveNext 80 | Loop 81 | HttpHeadersToString = sHeader 82 | Exit Function 83 | End If 84 | End Function 85 | -------------------------------------------------------------------------------- /src/byteConversion.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "byteConversion" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'byteConversion - helper functions for manipulating bytes/byte arrays 6 | '*** 7 | 8 | 9 | 'UTF8 string to byte array 10 | Public Function EncodeToBytes(ByVal sdata As String) As Byte() 'Note: Len(sData) > 0 11 | Dim aRetn() As Byte 12 | Dim nSize As Long 13 | nSize = WideCharToMultiByte(CP_UTF8, 0, StrPtr(sdata), -1, 0, 0, 0, 0) - 1 14 | If nSize > 0 Then 15 | ReDim aRetn(0 To nSize - 1) As Byte 16 | WideCharToMultiByte CP_UTF8, 0, StrPtr(sdata), -1, VarPtr(aRetn(0)), nSize, 0, 0 17 | EncodeToBytes = aRetn 18 | Erase aRetn 19 | Else 20 | ReDim EncodeToBytes(-1 To -1) 21 | End If 22 | End Function 23 | 24 | 'UTF8 byte array to string 25 | Public Function DecodeToBytes(byteArr() As Byte) As Byte() 'Note: Len(sData) > 0 26 | Dim aRetn() As Byte 27 | Dim nSize As Long 28 | nSize = MultiByteToWideChar(CP_UTF8, 0, VarPtr(byteArr(0)), -1, 0, 0) - 1 29 | If nSize > 0 Then 30 | ReDim aRetn(0 To 2 * nSize - 1) As Byte 31 | MultiByteToWideChar CP_UTF8, 0, VarPtr(byteArr(0)), -1, VarPtr(aRetn(0)), nSize 32 | DecodeToBytes = aRetn 33 | Erase aRetn 34 | Else 35 | ReDim DecodeToBytes(-1 To -1) 36 | End If 37 | End Function 38 | 39 | 'input number of bytes and output a more readable string describing the size 40 | Public Function BytesToXB(value As Currency) As String 41 | 'Dim Value As Currency 42 | 'Value = LargeIntToCurrency(RawValue) 43 | Select Case value 44 | Case Is > (2 ^ 30) 45 | BytesToXB = Round(value / (2 ^ 30), 2) & " GB" 46 | Case Is > (2 ^ 20) 47 | BytesToXB = Round(value / (2 ^ 20), 2) & " MB" 48 | Case Is > (2 ^ 10) 49 | BytesToXB = Round(value / (2 ^ 10), 2) & " KB" 50 | Case Else 51 | BytesToXB = value & " B" 52 | End Select 53 | End Function 54 | 55 | 'convert an array of bytes to hex, byte by byte (for readability, memory/stream debugging etc) 56 | Public Function ByteArrayToHex(ByRef ByteArray() As Byte) As String 57 | Dim l As Long, strRet As String 58 | 59 | For l = LBound(ByteArray) To UBound(ByteArray) 60 | strRet = strRet & Hex$(ByteArray(l)) & " " 61 | Next l 62 | 63 | 'remove last space at end. 64 | ByteArrayToHex = Left$(strRet, Len(strRet) - 1) 65 | End Function 66 | 67 | 'insert 0x00 separators between each character of a string to convert to a wstr or wide string 68 | Public Function StrToWStr(ByVal lpStr As String) As String 69 | Dim bStr() As Byte 70 | Dim abData() As Byte 71 | abData = StrConv(lpStr, vbFromUnicode) 72 | 73 | Dim i As Integer, x As Integer 74 | ReDim bStr(0 To (Len(lpStr) * 2) + 1) As Byte 75 | For i = 0 To (Len(lpStr) * 2) - 1 Step 2 76 | bStr(i) = abData(x) 77 | bStr(i + 1) = 0 78 | x = x + 1 79 | Next i 80 | bStr((Len(lpStr) * 2)) = 0 81 | 82 | StrToWStr = bStr 83 | End Function 84 | 85 | 'convert UTF8 string to UTF16 string 86 | Public Function UTF8to16(str As String) As String 87 | Dim position As Long, strConvert As String, codeReplace As Integer, strOut As String 88 | 89 | strOut = str 90 | position = InStr(strOut, Chr$(195)) 91 | 92 | If position > 0 Then 93 | Do Until position = 0 94 | strConvert = Mid$(strOut, position, 2) 95 | codeReplace = Asc(Right$(strConvert, 1)) 96 | If codeReplace < 255 Then 97 | strOut = Replace(strOut, strConvert, Chr$(codeReplace + 64)) 98 | Else 99 | strOut = Replace(strOut, strConvert, Chr$(34)) 100 | End If 101 | position = InStr(strOut, Chr$(195)) 102 | Loop 103 | End If 104 | 105 | UTF8to16 = strOut 106 | 107 | End Function 108 | 109 | 110 | 111 | 112 | 113 | '*** 114 | 'just experimenting with some "64bit" numbers using the Currency type - these functions are not currently used 115 | '*** 116 | 117 | 'copy LARGE_INTEGER struct into currency, then multiply by 10k - we lose some info in the HighPart, in turn getting a whole number instead of a decimal/"float" value 118 | Public Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency 119 | 'copy 8 bytes from the large integer to an empty currency 120 | CopyMemory LargeIntToCurrency, liInput, 8 121 | 'adjust it 122 | LargeIntToCurrency = LargeIntToCurrency * 10000 123 | 'Debug.Print "large " & LargeIntToCurrency 124 | End Function 125 | 'split a currency value into 2 longs to work with LARGE_INTEGER 126 | Public Function CurrencyToLargeInt(liInput As Currency) As LARGE_INTEGER 127 | 'copy 8 bytes from the large integer to an empty currency 128 | Dim largeint As LARGE_INTEGER, i1 As Currency 129 | i1 = liInput 130 | i1 = i1 / 10000 'divide input by 10k to drop the decimals off 131 | CopyMemory largeint.LowPart, i1, 4 132 | CopyMemory largeint.HighPart, ByVal VarPtr(i1) + 4, 4 133 | CurrencyToLargeInt = largeint 134 | End Function 135 | 'when a LARGE_INTEGER is fed in to this function as a byte array, 136 | 'we assign a currency value using power of notation for each numeral place in hexadecimal, 137 | Public Function BytesToCurrency(ByRef B() As Byte) As Currency 138 | 'currency max 922,337,203,685,477.5807 see if we can do something better to deal with these decimals? 139 | 'technically 922,337,203,685,477 140 | '256^6 is 281,474,976,710,656 141 | '256^6 * 3 = 844,424,930,131,968 142 | 'we can kinda support 64bit ULONGLONGs... just nowhere near the max value of a real one 143 | 144 | If B(6) > 3 Then 145 | MsgBox "BytesToCurrency error - overflow" 146 | BytesToCurrency = -1 147 | Exit Function 148 | End If 149 | 150 | Dim i As Currency, c As Currency 151 | For i = 0 To 6 152 | c = c + (B(i)) * (256@ ^ i) 153 | Next i 154 | BytesToCurrency = c 155 | End Function 156 | 157 | 158 | 159 | -------------------------------------------------------------------------------- /src/clsWebResData.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsWebResData" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'clsWebResData - a separate event handler class for WebResource content, 14 | 'created on initial WebResource request/response event, stores information about the event, 15 | 'spawns a clsWebViewContentHandler if one doesn't already exist for this resource, which 16 | 'then fires an event back to us here when content is available in the stream - 17 | 'this way the content can be linked back to the initial event when the data finally becomes available 18 | 'NOTE: this class is also used for historical data to view later, from frmTools or somewhere else - so instances of this class should not be destroyed, 19 | 'unless you don't care to keep track of past information 20 | '*** 21 | 22 | Public metaTitle As String 23 | Public reqContent As String 24 | Public resContent As String 25 | Public uri As String 26 | Public Method As String 27 | Public Headers As String 28 | Public Context As COREWEBVIEW2_WEB_RESOURCE_CONTEXT 29 | Public StatusCode As Long 30 | Public ReasonPhrase As Long 31 | Public sender As WebView2_edit.ICoreWebView2 32 | Private WithEvents c_Handler As clsWebViewContentHandler 33 | Attribute c_Handler.VB_VarHelpID = -1 34 | 35 | Public Property Get contentHandler() As clsWebViewContentHandler 36 | 'spawn a handler for when content is received - set this instance of clsWebResData as the parent via contentHandler.resource 37 | If c_Handler Is Nothing Then 38 | Set c_Handler = New clsWebViewContentHandler 39 | End If 40 | Set contentHandler = c_Handler 41 | Set contentHandler.Resource = Me 42 | PluginManager.AddBroadcaster contentHandler 43 | End Property 44 | 45 | Private Sub c_Handler_WebResourceResponseViewGetContentCompleted(ByRef res As clsWebResData, Content As IStream) 46 | Dim strStream As String 47 | If Not Content Is Nothing Then 48 | strStream = IStreamToString(Content) 'open and read the IStream data into a string 49 | Me.resContent = Me.resContent & strStream 'append received data in case more becomes available later 50 | End If 51 | End Sub 52 | 53 | Private Sub Class_Initialize() 54 | 55 | End Sub 56 | 57 | Private Sub Class_Terminate() 58 | PluginManager.RemoveBroadcaster c_Handler 59 | Set c_Handler = Nothing 60 | End Sub 61 | -------------------------------------------------------------------------------- /src/clsWebResourceBuilder.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsWebResourceBuilder" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'clsWebResourceBuilder - helper to create/read WebResourceRequest/WebResourceResponse 14 | '*** 15 | 16 | Private m_WV2Env_2 As ICoreWebView2Environment2 17 | 18 | Private m_uri As String 19 | Private m_method As String 20 | Private m_postData As String 21 | Private m_reqHeaders As ICoreWebView2HttpRequestHeaders 22 | Private m_resHeaders As ICoreWebView2HttpResponseHeaders 23 | Private m_content As String 24 | Private m_reasonPhrase As String 25 | Private m_statusCode As HttpStatusCode 26 | Private m_postDataStream As IStream 27 | 28 | Public Function Request() As ICoreWebView2WebResourceRequest 29 | Set Request = m_WV2Env_2.CreateWebResourceRequest( _ 30 | m_uri, _ 31 | m_method, _ 32 | POSTData, _ 33 | RequestHeaders) 34 | End Function 35 | Public Property Get Response() As ICoreWebView2WebResourceResponse 36 | Set Response = m_WV2Env_2.CreateWebResourceResponse( _ 37 | Content, _ 38 | StatusCode, _ 39 | ReasonPhrase, _ 40 | ResponseHeaders) 41 | End Property 42 | 43 | Public Property Get uri() As String 44 | uri = m_uri 45 | End Property 46 | Public Property Let uri(address As String) 47 | m_uri = address 48 | End Property 49 | Public Property Get ReasonPhrase() As String 50 | ReasonPhrase = m_reasonPhrase 51 | End Property 52 | Public Property Let ReasonPhrase(phrase As String) 53 | m_reasonPhrase = phrase 54 | End Property 55 | Public Property Get Method() As HTTPMethod 56 | Method = StrToHTTPMethod(m_method) 57 | End Property 58 | Public Property Let Method(requestMethod As HTTPMethod) 59 | m_method = HTTPMethodToStr(requestMethod) 60 | End Property 61 | Public Property Get POSTData() As IStream 62 | Attribute POSTData.VB_Description = "Set this property using a String, retrieving it will return an IStream" 63 | 'create an IStream from m_postData 64 | Dim postDataBytes() As Byte 65 | postDataBytes = EncodeToBytes(m_postData) 66 | If UBound(postDataBytes) > -1 Then 67 | Set m_postDataStream = IStreamFromArray(VarPtr(postDataBytes(0)), UBound(postDataBytes) + 1) 68 | Else 'need to handle an empty POST data... 69 | Set m_postDataStream = IStreamFromArray(0&, UBound(postDataBytes) + 1) 70 | End If 71 | Set POSTData = m_postDataStream 72 | End Property 73 | Public Property Let POSTData(str As Variant) 'using str as variant lets us assign the POSTData property as a string but get it as an IStream 74 | m_postData = str 75 | End Property 76 | Public Property Get Content() As IStream 77 | Attribute Content.VB_Description = "Set this property using a String, retrieving it will return an IStream" 78 | 'create an IStream from m_content 79 | Dim contentBytes() As Byte 80 | contentBytes = EncodeToBytes(m_content) 81 | Set Content = IStreamFromArray(VarPtr(contentBytes(0)), UBound(contentBytes) + 1) 82 | End Property 83 | Public Property Let Content(str As Variant) 'using str as variant lets us assign the Content property as a string but get it as an IStream 84 | m_content = str 85 | End Property 86 | Public Property Let StatusCode(responseStatusCode As HttpStatusCode) 87 | m_statusCode = responseStatusCode 88 | End Property 89 | Public Property Get StatusCode() As HttpStatusCode 90 | StatusCode = m_statusCode 91 | End Property 92 | Public Property Get RequestHeaders() As String 93 | If m_reqHeaders Is Nothing Then 94 | RequestHeaders = "" 95 | Else 96 | RequestHeaders = HttpHeadersToString(m_reqHeaders.GetIterator) 97 | End If 98 | End Property 99 | Public Function SetRequestHeader(Name As String, value As String) 100 | Set m_reqHeaders = Request.Headers 101 | m_reqHeaders.SetHeader Name, value 102 | End Function 103 | Public Function RemoveRequestHeader(Name As String) 104 | Set m_reqHeaders = Request.Headers 105 | m_reqHeaders.RemoveHeader Name 106 | End Function 107 | Public Property Get ResponseHeaders() As String 108 | If m_resHeaders Is Nothing Then 109 | ResponseHeaders = "" 110 | Else 111 | ResponseHeaders = HttpHeadersToString(m_resHeaders.GetIterator) 112 | End If 113 | End Property 114 | Public Function SetResponseHeader(Name As String, value As String) 115 | Set m_resHeaders = Response.Headers 116 | m_resHeaders.SetHeader Name, value 117 | End Function 118 | Public Function RemoveResponseHeader(Name As String) 119 | Set m_resHeaders = Response.Headers 120 | m_resHeaders.RemoveHeader Name 121 | End Function 122 | 123 | Private Sub Class_Initialize() 124 | Set m_WV2Env_2 = g_Env 125 | End Sub 126 | 127 | Public Sub PostRequest(wv2Object As wv2) 128 | wv2Object.NavigateWithResource Request 129 | End Sub 130 | 131 | -------------------------------------------------------------------------------- /src/clsWebViewContentHandler.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsWebViewContentHandler" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 'a simple event handler that fires an event back to the clsWebResData object who spawned it when data is received 12 | 13 | Implements ICoreWebView2WebResourceResponseViewGetContentCompletedHandler 14 | 15 | Public Event WebResourceResponseViewGetContentCompleted(ByRef res As clsWebResData, ByRef Content As IStream) 16 | 17 | Private m_resource As clsWebResData 'the parent clsWebResData who created this event handler 18 | 19 | Public Property Set Resource(ByRef res As clsWebResData) 20 | Set m_resource = res 'parent clsWebResData sets this to itself 21 | End Property 22 | 23 | Private Sub Class_Initialize() 24 | 'PluginManager.AddBroadcaster Me 25 | End Sub 26 | 27 | Private Sub Class_Terminate() 28 | 'unregister this class to all plugins? 29 | PluginManager.RemoveBroadcaster Me 30 | End Sub 31 | 32 | Private Sub ICoreWebView2WebResourceResponseViewGetContentCompletedHandler_Invoke(ByVal errorCode As Long, ByVal Content As IStream) 33 | RaiseEvent WebResourceResponseViewGetContentCompleted(m_resource, Content) 'fire an event back to my parent class with the content that was received 34 | PluginManager.RemoveBroadcaster Me 35 | End Sub 36 | -------------------------------------------------------------------------------- /src/clsWebViewEventHandlers.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsWebViewEventHandlers" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'clsWebViewEventHandlers 14 | 'this class is instantiated along with each wv2 instance and passes most common 15 | 'browser events to other classes for processing 16 | '*** 17 | 18 | Implements ICoreWebView2WebResourceRequestedEventHandler 19 | Implements ICoreWebView2WebResourceResponseReceivedEventHandler 20 | Implements ICoreWebView2CreateCoreWebView2ControllerCompletedHandler 21 | Implements ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler 22 | Implements ICoreWebView2DOMContentLoadedEventHandler 23 | Implements ICoreWebView2NavigationCompletedEventHandler 24 | Implements ICoreWebView2NavigationStartingEventHandler 25 | Implements ICoreWebView2DocumentTitleChangedEventHandler 26 | 27 | Public Event wv2EnvironmentReady(createdEnvironment As WebView2_edit.ICoreWebView2Environment) 28 | Public Event wv2ControllerReady(createdController As WebView2_edit.ICoreWebView2Controller) 29 | 30 | Public Event WebResourceResponseReceived(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceResponseReceivedEventArgs) 31 | Public Event WebResourceRequested(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceRequestedEventArgs) 32 | Public Event DOMContentLoaded(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2DOMContentLoadedEventArgs) 33 | Public Event NavigationCompleted(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationCompletedEventArgs) 34 | Public Event NavigationStarting(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationStartingEventArgs) 35 | Public Event DocumentTitleChanged(sender As WebView2_edit.ICoreWebView2, args As Long) 36 | 37 | 38 | 39 | Private Sub Class_Initialize() 40 | PluginManager.AddBroadcaster Me 41 | End Sub 42 | 43 | Private Sub Class_Terminate() 44 | 'unregister this class to all plugins? 45 | PluginManager.RemoveBroadcaster Me 46 | End Sub 47 | 48 | Public Sub ICoreWebView2CreateCoreWebView2ControllerCompletedHandler_Invoke(ByVal errorCode As Long, ByVal createdController As WebView2_edit.ICoreWebView2Controller) 49 | RaiseEvent wv2ControllerReady(createdController) 50 | End Sub 51 | 52 | Private Sub ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler_Invoke(ByVal errorCode As Long, ByVal createdEnvironment As WebView2_edit.ICoreWebView2Environment) 53 | RaiseEvent wv2EnvironmentReady(createdEnvironment) 54 | End Sub 55 | 56 | Private Sub ICoreWebView2DOMContentLoadedEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, ByVal args As WebView2_edit.ICoreWebView2DOMContentLoadedEventArgs) 57 | RaiseEvent DOMContentLoaded(sender, args) 58 | End Sub 59 | 60 | Private Sub ICoreWebView2NavigationCompletedEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, ByVal args As WebView2_edit.ICoreWebView2NavigationCompletedEventArgs) 61 | RaiseEvent NavigationCompleted(sender, args) 62 | End Sub 63 | 64 | Private Sub ICoreWebView2NavigationStartingEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, ByVal args As WebView2_edit.ICoreWebView2NavigationStartingEventArgs) 65 | RaiseEvent NavigationStarting(sender, args) 66 | End Sub 67 | 68 | Private Sub ICoreWebView2WebResourceRequestedEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, ByVal args As WebView2_edit.ICoreWebView2WebResourceRequestedEventArgs) 69 | RaiseEvent WebResourceRequested(sender, args) 70 | End Sub 71 | 72 | Private Sub ICoreWebView2WebResourceResponseReceivedEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, ByVal args As WebView2_edit.ICoreWebView2WebResourceResponseReceivedEventArgs) 73 | RaiseEvent WebResourceResponseReceived(sender, args) 74 | End Sub 75 | 76 | Private Sub ICoreWebView2DocumentTitleChangedEventHandler_Invoke(ByVal sender As WebView2_edit.ICoreWebView2, args As Long) 77 | 'args is null 78 | RaiseEvent DocumentTitleChanged(sender, args) 79 | End Sub 80 | -------------------------------------------------------------------------------- /src/clsWebViewScriptCompleteHandler.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "clsWebViewScriptCompleteHandler" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 'individual event handler to let us know the results of calling ExecuteScript 12 | 13 | Implements ICoreWebView2ExecuteScriptCompletedHandler 14 | Public Event wv2ScriptComplete(ByVal sender As wv2, ByRef resultObjectAsJson As String) 'used if we want to declare this object using WithEvents 15 | Public Parent As wv2 'used if we want to create new instances of this object from a local scope and call back to its parent 16 | Public PropLet As String 17 | 18 | Private selfRef As clsWebViewScriptCompleteHandler 19 | 20 | Private Sub Class_Initialize() 21 | Set selfRef = Me 'self reference so we dont get destroyed going out of scope, so we can "fire and forget" this handler until it completes, or times out 22 | PluginManager.AddBroadcaster Me 23 | End Sub 24 | 25 | Private Sub Class_Terminate() 26 | 'Set parent = Nothing 27 | 'Set selfRef = Nothing 28 | End Sub 29 | 30 | Private Sub ICoreWebView2ExecuteScriptCompletedHandler_Invoke(ByVal errorCode As Long, ByVal resultObjectAsJson As Long) 31 | Dim jsonResponse As String 32 | jsonResponse = StrFromPtr(resultObjectAsJson) 33 | RaiseEvent wv2ScriptComplete(Parent, jsonResponse) 34 | PluginManager.RemoveBroadcaster Me 35 | If PropLet <> vbNullString And Not Parent Is Nothing Then CallByName Parent, PropLet, VbLet, jsonResponse 36 | If Not Parent Is Nothing Then Parent.ExecuteScriptCompletedHandler errorCode, jsonResponse 37 | Set selfRef = Nothing 'now that script is complete, remove the self reference and this instance will automatically clean itself up 38 | End Sub 39 | -------------------------------------------------------------------------------- /src/factory.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "factory" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'factory 6 | 'this modules job is just to create objects 7 | '*** 8 | 9 | 10 | 11 | 'the wv2 class is the "core" browser object - it is "the browser" view 12 | 'simply create a new instance of it and the class will handle setting itself up 13 | Public Function NewTab() As wv2 14 | Set NewTab = New wv2 15 | End Function 16 | 17 | -------------------------------------------------------------------------------- /src/frmTools.frm: -------------------------------------------------------------------------------- 1 | VERSION 5.00 2 | Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmTools 3 | Caption = "Tools" 4 | ClientHeight = 6480 5 | ClientLeft = 120 6 | ClientTop = 4470 7 | ClientWidth = 9120 8 | OleObjectBlob = "frmTools.frx":0000 9 | ShowModal = 0 'False 10 | StartUpPosition = 3 'Windows Default 11 | End 12 | Attribute VB_Name = "frmTools" 13 | Attribute VB_GlobalNameSpace = False 14 | Attribute VB_Creatable = False 15 | Attribute VB_PredeclaredId = True 16 | Attribute VB_Exposed = False 17 | 18 | 19 | 20 | Private Sub lstDataRequests_Change() 21 | txtDataRequests.Text = StringFromWebData(dicRequests(lstDataRequests.ListCount - (lstDataRequests.ListIndex + 1))) 22 | End Sub 23 | 24 | Private Sub lstDataResponses_Change() 25 | If dicResponses(lstDataResponses.ListCount - (lstDataResponses.ListIndex + 1)) Is Nothing Then Exit Sub 26 | txtDataResponses.Text = StringFromWebData(dicResponses(lstDataResponses.ListCount - (lstDataResponses.ListIndex + 1))) 27 | End Sub 28 | 29 | Private Sub lstDataResponses_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 30 | 31 | Dim sJSONString As String 32 | Dim vJSON As Variant 33 | Dim sState As String 34 | Dim vflat As Variant 35 | Dim strResult As Variant 36 | 37 | Dim req As clsWebResData 38 | 39 | Set req = dicResponses(lstDataResponses.ListCount - (lstDataResponses.ListIndex + 1)) 40 | 41 | txtDataResponses.Text = beautifyJSON(req.resContent) 42 | 43 | txtDataResponses.Text = txtDataResponses.Text & vbCrLf & vbCrLf & beautifyJSON(req.reqContent) 44 | 45 | End Sub 46 | 47 | Private Sub lstDataSearchData_Change() 48 | On Error Resume Next 49 | Dim dataidx As Long 50 | dataidx = CLng(lstDataSearchData.column(1, lstDataSearchData.ListIndex)) 51 | If dicData.Count > dataidx And lstDataSearchData.ListIndex > -1 Then 52 | txtDataSearchData.Text = StringFromWebData(dicData(CLng(lstDataSearchData.column(1, lstDataSearchData.ListIndex)))) 53 | End If 54 | End Sub 55 | 56 | Private Sub lstDataSingle_Change() 57 | txtDataSingle.Text = StringFromWebData(dicData(lstDataSingle.ListCount - (lstDataSingle.ListIndex + 1))) 58 | End Sub 59 | 60 | Private Sub txtDataResponses_Change() 61 | 62 | End Sub 63 | 64 | Private Sub txtDataSearch_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) 65 | If KeyCode = vbKeyReturn Then 66 | lstDataSearchData.Clear 67 | lstDataSearchData.ColumnWidths = (";0cm") 68 | Dim i As Long, res As clsWebResData 69 | For i = 0 To dicData.Count - 1 70 | Set res = dicData.Item(i) 71 | If InStr(res.uri, txtDataSearch) > 0 Then 72 | lstDataSearchData.AddItem Left$(res.uri, 25), 0 73 | lstDataSearchData.List(0, 1) = i 74 | lstDataSearchData.TopIndex = 0 75 | End If 76 | Next i 77 | txtDataSearch.SelStart = 0 78 | txtDataSearch.SelLength = Len(txtDataSearch.Text) 79 | End If 80 | End Sub 81 | 82 | Private Sub txtDataSearch_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) 83 | txtDataSearch.SelStart = 0 84 | txtDataSearch.SelLength = Len(txtDataSearch.Text) 85 | End Sub 86 | 87 | 88 | Private Sub UserForm_Initialize() 89 | MultiPage1.ForeColor = &H0 90 | End Sub 91 | 92 | Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) 93 | Unload Me 94 | End Sub 95 | -------------------------------------------------------------------------------- /src/frmTools.frx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lucasplumb/ExcelWebView2/fb2dbcb6b64a14de35bd6a80c5bbfc6d71d3b367/src/frmTools.frx -------------------------------------------------------------------------------- /src/pluginBase.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "pluginBase" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'pluginBase - example base class for a plugin to implement your own custom code on top of the normal browser functions 14 | 'the code in this class should essentially only *handle* events, it should not store any kind of state information or variables unless modified to do so 15 | 'the reason for this is due to the nature of handling Events in VBA, WithEvents can only be used with a single object - therefore, 16 | 'we create multiple "shadow copies" of this class via PluginManager every time a separate class i.e. 'clsWebViewEventHandlers' is created 17 | 'recommend creating a standard module which this class interacts with if you need to store any sort of state/information for your plugin to use 18 | '*** 19 | 20 | Implements pluginInterface 21 | 22 | Private WithEvents m_WebView2Event As clsWebViewEventHandlers 23 | Attribute m_WebView2Event.VB_VarHelpID = -1 24 | Private WithEvents m_ContentEvent As clsWebViewContentHandler 25 | Attribute m_ContentEvent.VB_VarHelpID = -1 26 | Private WithEvents m_ScriptEvent As clsWebViewScriptCompleteHandler 27 | Attribute m_ScriptEvent.VB_VarHelpID = -1 28 | 29 | Private Sub Class_Initialize() 30 | End Sub 31 | 32 | Private Sub Class_Terminate() 33 | 'clean up any data your plugin created 34 | End Sub 35 | 36 | Private Sub m_ContentEvent_WebResourceResponseViewGetContentCompleted(res As clsWebResData, Content As WebView2_edit.IStream) 37 | 38 | End Sub 39 | 40 | Private Sub m_ScriptEvent_wv2ScriptComplete(ByVal sender As wv2, resultObjectAsJson As String) 41 | 42 | End Sub 43 | 44 | Private Sub m_WebView2Event_DocumentTitleChanged(sender As WebView2_edit.ICoreWebView2, args As Long) 45 | 46 | End Sub 47 | 48 | Private Sub m_WebView2Event_DOMContentLoaded(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2DOMContentLoadedEventArgs) 49 | 50 | End Sub 51 | 52 | Private Sub m_WebView2Event_NavigationCompleted(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationCompletedEventArgs) 53 | 54 | End Sub 55 | 56 | Private Sub m_WebView2Event_NavigationStarting(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationStartingEventArgs) 57 | 58 | End Sub 59 | 60 | Private Sub m_WebView2Event_WebResourceRequested(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceRequestedEventArgs) 61 | 62 | End Sub 63 | 64 | Private Sub m_WebView2Event_WebResourceResponseReceived(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceResponseReceivedEventArgs) 65 | 66 | End Sub 67 | 68 | Private Sub m_WebView2Event_wv2ControllerReady(createdController As WebView2_edit.ICoreWebView2Controller) 69 | 70 | End Sub 71 | 72 | Private Sub m_WebView2Event_wv2EnvironmentReady(createdEnvironment As WebView2_edit.ICoreWebView2Environment) 73 | 74 | End Sub 75 | 76 | 77 | 'boilerplate 78 | Private Property Get pluginInterface_NewInstance() As pluginInterface 79 | Set pluginInterface_NewInstance = New pluginBase 'always set this to the class of your custom plugin 80 | End Property 81 | Private Property Get pluginInterface_ContentEvent() As clsWebViewContentHandler 82 | Set pluginInterface_ContentEvent = m_ContentEvent 83 | End Property 84 | 85 | Private Property Set pluginInterface_ContentEvent(ByVal RHS As clsWebViewContentHandler) 86 | Set m_ContentEvent = RHS 87 | End Property 88 | 89 | Private Property Set pluginInterface_ScriptEvent(ByVal RHS As clsWebViewScriptCompleteHandler) 90 | Set m_ScriptEvent = RHS 91 | End Property 92 | 93 | Private Property Get pluginInterface_ScriptEvent() As clsWebViewScriptCompleteHandler 94 | Set pluginInterface_ScriptEvent = m_ScriptEvent 95 | End Property 96 | 97 | Private Property Set pluginInterface_WebView2Event(ByVal RHS As clsWebViewEventHandlers) 98 | Set m_WebView2Event = RHS 99 | End Property 100 | Private Property Get pluginInterface_WebView2Event() As clsWebViewEventHandlers 101 | Set pluginInterface_WebView2Event = m_WebView2Event 102 | End Property 103 | '/boilerplate 104 | 105 | 'funcDispID -1610678272 106 | '4E8A3389C9D84BD2B6B5124FEE6CC14D[ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler]:IUnknown 107 | ' - VT(12) Invoke(errorCode As Long, createdEnvironment As *ICoreWebView2Environment) 108 | 109 | 'Public Sub ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler_Invoke(ByVal errorCode As Long, ByVal createdEnvironment As WebView2_edit.ICoreWebView2Environment) 110 | ''Attribute ICoreWebView2CreateCoreWebView2EnvironmentCompletedHandler_Invoke.VB_UserMemId = -1610678272 111 | ' 'RaiseEvent wv2EnvironmentReady(createdEnvironment) 112 | 'End Sub 113 | -------------------------------------------------------------------------------- /src/pluginContainer.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "pluginContainer" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'pluginContainer - contains duplicate instances of some type of pluginInterface, acting as a sort of delegate 14 | 'for more information on how plugins are managed, see the pluginManagerSingleton class 15 | '*** 16 | 17 | 'this is our "container" - these should act as essentially "shadow copies" of our plugin, whose only job is to handle events 18 | 'keep in mind, however, that they are *literally* copies of the plugin class, except they will have their "WithEvents" members actually set to an object which raises events 19 | 'it is important that they do not keep any state information or execute functions - they should raise everything up to the "parent" to actually act on the events 20 | 21 | Private m_pluginInstance As Dictionary 22 | 23 | 'this is the "parent" - it should not have any of its "WithEvents" or "listener" members assigned to - rather, the "shadow copies" in the container 24 | 'will forward all their events to this parent which will execute code to act on the events and manipulate data 25 | Private m_pluginTemplate As pluginInterface 26 | 27 | Public Property Set Template(newTemplate As pluginInterface) 28 | Set m_pluginTemplate = newTemplate 29 | End Property 30 | 31 | Public Property Get NewInstance() As pluginInterface 32 | Dim newInterface As pluginInterface 33 | Set newInterface = m_pluginTemplate.NewInstance 34 | m_pluginInstance.Add ObjPtr(newInterface), newInterface 35 | Set NewInstance = newInterface 36 | End Property 37 | 38 | Public Sub RemoveInstance(instancePtr As Long) 39 | If m_pluginInstance.Exists(instancePtr) Then 40 | Set m_pluginInstance(instancePtr) = Nothing 41 | m_pluginInstance.Remove instancePtr 42 | End If 43 | End Sub 44 | 45 | Private Sub Class_Initialize() 46 | Set m_pluginInstance = New Dictionary 47 | End Sub 48 | 49 | Private Sub Class_Terminate() 50 | m_pluginInstance.RemoveAll 51 | End Sub 52 | -------------------------------------------------------------------------------- /src/pluginExample.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "pluginExample" 2 | Option Explicit 3 | Private m_scriptComplete As Boolean 4 | Private m_lastExecutedScriptResponse As String 5 | Private m_lastWebContentResponse As String 6 | Private m_responseReceived As Boolean 7 | Public Property Let LastWebContentResponse(val As String) 8 | m_lastWebContentResponse = val 9 | End Property 10 | Public Property Let LastExecutedScriptResponse(val As String) 11 | m_lastExecutedScriptResponse = val 12 | End Property 13 | Public Property Get ScriptComplete() As Boolean 14 | ScriptComplete = m_scriptComplete 15 | End Property 16 | Public Property Let ScriptComplete(val As Boolean) 17 | m_scriptComplete = val 18 | End Property 19 | Public Property Get ResponseReceived() As Boolean 20 | ResponseReceived = m_responseReceived 21 | End Property 22 | Public Property Let ResponseReceived(val As Boolean) 23 | m_responseReceived = val 24 | End Property 25 | 26 | Public Sub Search1() 27 | Debug.Print "---SEARCH EXAMPLE #1---" 28 | ActiveBrowserTab.OpenUrl "en.wikipedia.org" 29 | 'the next line will fail, because the page navigation hasnt completed yet 30 | ActiveBrowserTab.ExecuteScript "document.getElementById('searchInput').value = 'WebView2'" 31 | Debug.Print "observe that the search input value was not set, because we tried to set it before the page was done loading..." 32 | Debug.Print "" 33 | Stop 34 | End Sub 35 | 36 | Public Sub Search2() 37 | Debug.Print "---SEARCH EXAMPLE #2---" 38 | ActiveBrowserTab.OpenUrl "en.wikipedia.org" 39 | 'since the browser is event driven, we need to wait for navigation to complete 40 | WaitForNavigation 41 | ActiveBrowserTab.ExecuteScript "document.getElementById('searchInput').value = 'WebView2'" 42 | ActiveBrowserTab.ExecuteScript "document.getElementById('search-form').submit();" 43 | WaitForNavigation 44 | ActiveBrowserTab.ExecuteScript "document.documentElement.outerHTML;" 45 | ScriptComplete = False 46 | Debug.Print "source - " & m_lastExecutedScriptResponse 'fails because the script hasnt completed yet - see pluginExampleCls - m_lastExecutedScriptResponse is set when the script event handler completes 47 | 'Stop 'pause to observe that the page HTML has not printed 48 | Debug.Print "observe that the source HTML is not printed correctly - that is because we need to wait for the script to complete" 49 | 'lets try waiting for it to finish now 50 | WaitForScriptComplete 51 | Debug.Print "source - " & Left$(m_lastExecutedScriptResponse, 1000) & "..." 52 | Debug.Print "as you can see, the source has now been printed" 53 | Debug.Print "" 54 | Stop 55 | End Sub 56 | 57 | Public Sub Search3() 58 | Debug.Print "---SEARCH EXAMPLE #3---" 59 | 'instead of navigating, lets send a POST (GET, in this case) request 60 | Dim source As String 61 | Dim webReq As clsWebResourceBuilder 62 | Set webReq = New clsWebResourceBuilder 63 | With webReq 64 | .Method = HTTP_GET 65 | .uri = "https://en.wikipedia.org/wiki/Special:Search?search=WebView2&go=Go" 66 | .SetRequestHeader "Referer", "https://www.wikipedia.org" 67 | .PostRequest ActiveBrowserTab 68 | End With 69 | WaitForNavigation 70 | ActiveBrowserTab.ExecuteScript "document.documentElement.innerHTML;" 71 | ScriptComplete = False 72 | Debug.Print "source - " & m_lastExecutedScriptResponse 'fails because the script hasnt completed yet - see pluginExampleCls - m_lastExecutedScriptResponse is set when the script event handler completes 73 | 'Stop 'pause to observe that the page HTML has not printed 74 | Debug.Print "observe that the source HTML is not printed correctly - that is because we need to wait for the script to complete" 75 | 'lets try waiting for it to finish now 76 | WaitForScriptComplete 77 | Debug.Print "source - " & Left$(m_lastExecutedScriptResponse, 1000) & "..." 78 | Debug.Print "as you can see, the source has now been printed" 79 | Debug.Print "" 80 | Stop 81 | End Sub 82 | 83 | Public Sub Search4() 84 | Debug.Print "---SEARCH EXAMPLE #4---" 85 | 'instead of navigating, lets send a POST (GET, in this case) request 86 | Dim source As String 87 | Dim webReq As clsWebResourceBuilder 88 | Set webReq = New clsWebResourceBuilder 89 | With webReq 90 | .Method = HTTP_GET 91 | .uri = "https://en.wikipedia.org/wiki/Special:Search?search=WebView2&go=Go" 92 | .SetRequestHeader "Referer", "https://www.wikipedia.org" 93 | .PostRequest ActiveBrowserTab 94 | End With 95 | WaitForResponse 'instead of waiting for navigation, wait for a particular response... see 'm_ContentEvent_WebResourceResponseViewGetContentCompleted' in the pluginExampleCls 96 | 'instead of getting the html via JS, lets get the web server's response content this time 97 | Debug.Print "web response - " & Left$(m_lastWebContentResponse, 1000) & "..." 98 | Debug.Print "as you can see, the source has now been printed - and its actually formatted a little more nicely for us" 99 | End Sub 100 | Private Sub WaitForNavigation() 101 | Do Until ActiveBrowserTab.NavigationComplete 102 | DoEvents 103 | Loop 104 | End Sub 105 | Private Sub WaitForResponse() 106 | Do Until ResponseReceived 107 | DoEvents 108 | Loop 109 | End Sub 110 | Private Sub WaitForScriptComplete() 111 | Do Until ScriptComplete 112 | DoEvents 113 | Loop 114 | End Sub 115 | -------------------------------------------------------------------------------- /src/pluginExampleCls.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "pluginExampleCls" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'pluginBase - example base class for a plugin to implement your own custom code on top of the normal browser functions 14 | 'the code in this class should essentially only *handle* events, it should not store any kind of state information or variables unless modified to do so 15 | 'the reason for this is due to the nature of handling Events in VBA, WithEvents can only be used with a single object - therefore, 16 | 'we create multiple "shadow copies" of this class via PluginManager every time a separate class i.e. 'clsWebViewEventHandlers' is created 17 | 'recommend creating a standard module which this class interacts with if you need to store any sort of state/information for your plugin to use 18 | '*** 19 | 20 | Implements pluginInterface 21 | 22 | Private WithEvents m_WebView2Event As clsWebViewEventHandlers 23 | Attribute m_WebView2Event.VB_VarHelpID = -1 24 | Private WithEvents m_ContentEvent As clsWebViewContentHandler 25 | Attribute m_ContentEvent.VB_VarHelpID = -1 26 | Private WithEvents m_ScriptEvent As clsWebViewScriptCompleteHandler 27 | Attribute m_ScriptEvent.VB_VarHelpID = -1 28 | 29 | Private Sub Class_Initialize() 30 | End Sub 31 | 32 | Private Sub Class_Terminate() 33 | 'clean up any data your plugin created 34 | End Sub 35 | 36 | Private Sub m_ContentEvent_WebResourceResponseViewGetContentCompleted(res As clsWebResData, Content As WebView2_edit.IStream) 37 | 'Debug.Print res.resContent 'server response content 38 | If res.Method = HTTPMethodToStr(HTTP_GET) And res.uri = "https://en.wikipedia.org/wiki/WebView2" Then 39 | pluginExample.LastWebContentResponse = res.resContent 40 | pluginExample.ResponseReceived = True 41 | End If 42 | End Sub 43 | 44 | Private Sub m_ScriptEvent_wv2ScriptComplete(ByVal sender As wv2, resultObjectAsJson As String) 45 | pluginExample.ScriptComplete = True 46 | pluginExample.LastExecutedScriptResponse = resultObjectAsJson 47 | End Sub 48 | 49 | Private Sub m_WebView2Event_DocumentTitleChanged(sender As WebView2_edit.ICoreWebView2, args As Long) 50 | 51 | End Sub 52 | 53 | Private Sub m_WebView2Event_DOMContentLoaded(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2DOMContentLoadedEventArgs) 54 | pluginExample.LastExecutedScriptResponse = "" 'reset script response on each page load 55 | End Sub 56 | 57 | Private Sub m_WebView2Event_NavigationCompleted(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationCompletedEventArgs) 58 | 59 | End Sub 60 | 61 | Private Sub m_WebView2Event_NavigationStarting(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationStartingEventArgs) 62 | End Sub 63 | 64 | Private Sub m_WebView2Event_WebResourceRequested(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceRequestedEventArgs) 65 | 'Debug.Print StrFromPtr(sender.source) 66 | pluginExample.ResponseReceived = False 67 | End Sub 68 | 69 | Private Sub m_WebView2Event_WebResourceResponseReceived(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceResponseReceivedEventArgs) 70 | 71 | End Sub 72 | 73 | Private Sub m_WebView2Event_wv2ControllerReady(createdController As WebView2_edit.ICoreWebView2Controller) 74 | 75 | End Sub 76 | 77 | Private Sub m_WebView2Event_wv2EnvironmentReady(createdEnvironment As WebView2_edit.ICoreWebView2Environment) 78 | 79 | End Sub 80 | 81 | 82 | 'boilerplate 83 | Private Property Get pluginInterface_NewInstance() As pluginInterface 84 | Set pluginInterface_NewInstance = New pluginExampleCls 'always set this to the class of your custom plugin 85 | End Property 86 | Private Property Get pluginInterface_ContentEvent() As clsWebViewContentHandler 87 | Set pluginInterface_ContentEvent = m_ContentEvent 88 | End Property 89 | 90 | Private Property Set pluginInterface_ContentEvent(ByVal RHS As clsWebViewContentHandler) 91 | Set m_ContentEvent = RHS 92 | End Property 93 | 94 | Private Property Set pluginInterface_ScriptEvent(ByVal RHS As clsWebViewScriptCompleteHandler) 95 | Set m_ScriptEvent = RHS 96 | End Property 97 | 98 | Private Property Get pluginInterface_ScriptEvent() As clsWebViewScriptCompleteHandler 99 | Set pluginInterface_ScriptEvent = m_ScriptEvent 100 | End Property 101 | 102 | Private Property Set pluginInterface_WebView2Event(ByVal RHS As clsWebViewEventHandlers) 103 | Set m_WebView2Event = RHS 104 | End Property 105 | Private Property Get pluginInterface_WebView2Event() As clsWebViewEventHandlers 106 | Set pluginInterface_WebView2Event = m_WebView2Event 107 | End Property 108 | '/boilerplate 109 | 110 | -------------------------------------------------------------------------------- /src/pluginInterface.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "pluginInterface" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'pluginInterface - interface for creating plugin classes 14 | ' - this is essentially a template - DO NOT ADD CODE HERE! 15 | ' - instead, create a new class and put "Implements pluginInterface" at the top, then add your code to those methods 16 | ' - see pluginBase class module for an example of how to create your own plugin 17 | '*** 18 | 19 | Private WithEvents m_WebView2Event As clsWebViewEventHandlers 20 | Attribute m_WebView2Event.VB_VarHelpID = -1 21 | Private WithEvents m_ContentEvent As clsWebViewContentHandler 22 | Attribute m_ContentEvent.VB_VarHelpID = -1 23 | Private WithEvents m_ScriptEvent As clsWebViewScriptCompleteHandler 24 | Attribute m_ScriptEvent.VB_VarHelpID = -1 25 | Public Property Get WebView2Event() As clsWebViewEventHandlers 26 | 27 | End Property 28 | Public Property Set WebView2Event(ByVal eventHandler As clsWebViewEventHandlers) 29 | 30 | End Property 31 | Public Property Get ContentEvent() As clsWebViewContentHandler 32 | 33 | End Property 34 | Public Property Set ContentEvent(ByVal eventHandler As clsWebViewContentHandler) 35 | 36 | End Property 37 | Public Property Get ScriptEvent() As clsWebViewScriptCompleteHandler 38 | 39 | End Property 40 | Public Property Set ScriptEvent(ByVal eventHandler As clsWebViewScriptCompleteHandler) 41 | 42 | End Property 43 | Public Property Get NewInstance() As pluginInterface 44 | 45 | End Property 46 | -------------------------------------------------------------------------------- /src/pluginLoader.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "pluginLoader" 2 | Option Explicit 3 | '*** 4 | 'ExcelWebView2 by Lucas Plumb @ 2023 5 | 'pluginLoader - load and register all plugins with a single call 6 | '*** 7 | 8 | Private plugins() As pluginInterface 9 | Private m_plugins As pluginManagerSingleton 10 | 11 | 'get or spawn a plugin manager instance 12 | Public Property Get PluginManager() As pluginManagerSingleton 'Public Function 13 | If m_plugins Is Nothing Then 14 | Set m_plugins = New pluginManagerSingleton 15 | End If 16 | Set PluginManager = m_plugins 17 | End Property 18 | Private Sub AddPlugin(plugin As pluginInterface) 19 | If (Not Not plugins) = 0 Then 20 | ReDim plugins(0) 21 | Else 22 | ReDim Preserve plugins(UBound(plugins) + 1) 23 | End If 24 | Set plugins(UBound(plugins)) = plugin 25 | End Sub 26 | Public Sub LoadPlugins() 27 | 'add your plugins here 28 | 'AddPlugin New pluginBase 29 | AddPlugin New pluginExampleCls 30 | 'add more plugins as desired above, just call AddPlugin(New myPluginClass) 31 | 32 | 'tell plugin manager to load plugins then clear this modules references to them so PluginManager controls their life time 33 | Dim i As Integer 34 | For i = 0 To UBound(plugins) 35 | PluginManager.LoadPlugin plugins(i) 36 | Set plugins(i) = Nothing 37 | Next i 38 | 39 | Erase plugins 40 | End Sub 41 | -------------------------------------------------------------------------------- /src/pluginManagerSingleton.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "pluginManagerSingleton" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'clsWebResourceBuilder - helper to create/read WebResourceRequest/WebResourceResponse 14 | '*** 15 | 16 | Private m_plugins() As TPlugin 17 | Private m_broadcasters As New Dictionary 18 | Private m_listenerContainer As New Dictionary 19 | Private m_listeners As New Dictionary 20 | 21 | 'here, for each item in the plugins list, we need to create a pluginContainer 22 | 'pluginContainer will contain an array of pluginInterfaces which are all the same type as the initial plugin loaded... 23 | 'then, every time we want to add a listener, we duplicate the initial plugin and store it in pluginContainer 24 | 'the end result looks something like this: 25 | 'pluginLoader creates a single instance of our plugin, and passes it to the PluginManager 26 | 'PluginManager creates a pluginContainer for each unique plugin instance loaded 27 | 'when some "event handler" needs to broadcast its events to this swarm of plugin instances, 28 | '-the handler will call PluginManager.AddBroadcaster(Me), where 'Me' is the target/broadcaster - which is the thing raising the events 29 | 'PluginManager.AddBroadcaster will iterate all pluginContainers and insert a new instance of the original plugin instance loaded 30 | 'for each new instance loaded, we then set that instances "WebView2Event" property, or whatever, based on the type of event handler passed as 'Me' in AddBroadcaster 31 | 'wow 32 | 33 | Public Sub AddBroadcaster(eventBroadcaster As Object) 34 | If m_broadcasters.Exists(ObjPtr(eventBroadcaster)) = False Then 35 | m_broadcasters.Add ObjPtr(eventBroadcaster), eventBroadcaster 36 | NewBroadcasterForListeners eventBroadcaster 37 | Else 38 | 'error - might want to raise an error here, as we probably shouldnt be trying to add multiple broadcasters to the same class instance 39 | Debug.Print "broadcaster already exists" 40 | End If 41 | End Sub 42 | Public Sub RemoveBroadcaster(eventBroadcaster As Object) 43 | Dim broadcasterPlugins() As Long, i As Long 44 | If m_broadcasters.Exists(ObjPtr(eventBroadcaster)) = True Then 45 | 46 | broadcasterPlugins = m_listeners(ObjPtr(eventBroadcaster)) 47 | For i = 0 To UBound(broadcasterPlugins) 48 | m_listenerContainer(m_listeners(ObjPtr(eventBroadcaster))).RemoveInstance broadcasterPlugins(i) 49 | Next i 50 | m_listenerContainer.Remove m_listeners(ObjPtr(eventBroadcaster)) 51 | m_listeners.Remove ObjPtr(eventBroadcaster) 52 | m_broadcasters.Remove ObjPtr(eventBroadcaster) 53 | Else 54 | 'error - dont want to actually raise an error here - maybe our classes are just being overzealous with cleanup 55 | 'thats fine - we really want to avoid circular references at all costs to avoid leaking memory 56 | Debug.Print "broadcaster doesnt exist" 57 | End If 58 | End Sub 59 | 60 | 'when we add a broadcaster (i.e., an object instance which has events we want to raise to our plugin), we need to create a new instance of that plugin and set a property based on the type of broadcaster class 61 | ' this could potentially be improved by searching through existing instances which do not have the "event type" ie, WebView2Event, ContentEvent, etc already set, and reusing those instead of making new instances 62 | Private Sub NewBroadcasterForListeners(eventBroadcaster As Object) 63 | On Error GoTo e 64 | Dim plugins() As TPlugin, plugin As pluginInterface, i As Long 65 | Dim interfaces() As pluginInterface 66 | Dim broadcasterPlugins() As Long 67 | plugins = PluginManager.AllPlugins 68 | For i = 0 To UBound(plugins) 69 | Select Case TypeName(eventBroadcaster) 70 | Case "clsWebViewEventHandlers" 71 | Set plugin = plugins(i).container.NewInstance 72 | Set plugin.WebView2Event = eventBroadcaster 73 | Case "clsWebViewContentHandler" 74 | Set plugin = plugins(i).container.NewInstance 75 | Set plugin.ContentEvent = eventBroadcaster 76 | Case "clsWebViewScriptCompleteHandler" 77 | Set plugin = plugins(i).container.NewInstance 78 | Set plugin.ScriptEvent = eventBroadcaster 79 | Case Else 80 | 'RemoveBroadcaster eventBroadcaster 'remove broadcaster created in AddBroadcaster 81 | err.Raise 1, "pluginManagerSingleton.NewBroadcasterForListeners", "Broadcaster class name must match one of the names in the Select statement." 82 | End Select 83 | m_listenerContainer.Add ObjPtr(plugin), plugins(i).container 84 | 'handle multiple plugins being added to the same broadcaster... 85 | If m_listeners.Exists(ObjPtr(eventBroadcaster)) Then 86 | broadcasterPlugins = m_listeners(ObjPtr(eventBroadcaster)) 87 | ReDim Preserve broadcasterPlugins(UBound(broadcasterPlugins) + 1) 88 | broadcasterPlugins(UBound(broadcasterPlugins)) = ObjPtr(plugin) 89 | m_listeners(ObjPtr(eventBroadcaster)) = broadcasterPlugins 90 | Else 91 | ReDim broadcasterPlugins(0) 92 | broadcasterPlugins(0) = ObjPtr(plugin) 93 | m_listeners.Add ObjPtr(eventBroadcaster), broadcasterPlugins 94 | End If 95 | Next i 96 | Exit Sub 97 | e: 98 | MsgBox err.Description, vbCritical, err.source: Exit Sub 99 | End Sub 100 | 101 | Private Function CreateContainer(plugin As pluginInterface) As pluginContainer 102 | Dim pContainer As pluginContainer 103 | If (Not Not pluginContainers) = 0 Then 104 | ReDim pluginContainers(0) 105 | Else 106 | ReDim Preserve pluginContainers(UBound(pluginContainers) + 1) 107 | End If 108 | Set pContainer = New pluginContainer 109 | Set pluginContainers(UBound(pluginContainers)) = pContainer 110 | Set pContainer.Template = plugin 111 | Set CreateContainer = pContainer 112 | End Function 113 | 114 | Public Sub LoadPlugin(plugin As pluginInterface) 115 | Dim pContainer As pluginContainer 116 | If (Not Not m_plugins) = 0 Then 117 | ReDim m_plugins(0) 118 | Else 119 | ReDim Preserve m_plugins(UBound(m_plugins) + 1) 120 | End If 121 | Set m_plugins(UBound(m_plugins)).plugin = plugin 122 | 123 | Set m_plugins(UBound(m_plugins)).container = New pluginContainer 124 | Set pContainer = m_plugins(UBound(m_plugins)).container 125 | Set pContainer.Template = plugin 126 | 127 | End Sub 128 | 129 | Public Property Get Count() 130 | If (Not Not plugins) = 0 Then 131 | Count = 0 132 | Else 133 | Count = UBound(plugins) + 1 134 | End If 135 | End Property 136 | 137 | Public Property Get AllPlugins() As TPlugin() 138 | AllPlugins = m_plugins 139 | End Property 140 | 141 | Private Sub Class_Initialize() 142 | 143 | End Sub 144 | Public Sub Kill() 145 | Class_Terminate 146 | End Sub 147 | 148 | Private Sub Class_Terminate() 149 | Dim i As Integer 150 | 151 | If (Not Not m_plugins) <> 0 Then 152 | For i = 0 To UBound(m_plugins) 153 | Set m_plugins(i).container = Nothing 154 | Set m_plugins(i).plugin = Nothing 155 | Next i 156 | End If 157 | Erase m_plugins 158 | 159 | m_broadcasters.RemoveAll 160 | m_listeners.RemoveAll 161 | m_listenerContainer.RemoveAll 162 | Set m_broadcasters = Nothing 163 | Set m_listeners = Nothing 164 | Set m_listenerContainer = Nothing 165 | End Sub 166 | 167 | -------------------------------------------------------------------------------- /src/wv2.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "wv2" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | '*** 12 | 'ExcelWebView2 by Lucas Plumb @ 2023 13 | 'wv2 14 | 'individual webview control object 15 | 'environment setup is performed automatically on first instantiation of this class 16 | 'simply spawn as many wv2's as needed for tabs etc 17 | '*** 18 | 19 | 20 | Private m_WebViewController As ICoreWebView2Controller 21 | Private m_WebViewCore As ICoreWebView2_2 22 | 23 | Private WithEvents m_wv2env As wv2Environment 24 | Attribute m_wv2env.VB_VarHelpID = -1 25 | Private WithEvents m_webViewHandlers As clsWebViewEventHandlers 26 | Attribute m_webViewHandlers.VB_VarHelpID = -1 27 | Private WithEvents m_scriptHandler As clsWebViewScriptCompleteHandler 28 | Attribute m_scriptHandler.VB_VarHelpID = -1 29 | 30 | Private m_tab As MSForms.Tab 31 | Attribute m_tab.VB_VarHelpID = -1 32 | 33 | Private resDict As Dictionary 34 | 35 | Private myIndex As Long 36 | 37 | Private m_pageSource As String 38 | Private m_navigationComplete As Boolean 39 | 40 | '/////////////////////////////// 41 | 'WEB CONTROL FUNCTIONS 42 | '/////////////////////////////// 43 | Function NavigateWithResource(res As ICoreWebView2WebResourceRequest) 'can be used to POST data 44 | m_WebViewCore.NavigateWithWebResourceRequest res 45 | NavigationComplete = False 46 | End Function 47 | Function GoBack() 48 | m_WebViewCore.GoBack 49 | End Function 50 | Function GoForward() 51 | m_WebViewCore.GoForward 52 | End Function 53 | Function StopLoading() 54 | m_WebViewCore.Stop 55 | End Function 56 | Function Reload() 57 | m_WebViewCore.Reload 58 | End Function 59 | Function OpenUrl(ByVal url As String) 60 | If Left$(LCase$(url), 4) <> "http" And Left$(LCase$(url), 4) <> "file" Then url = "http://" & url 61 | m_WebViewCore.Navigate url 62 | NavigationComplete = False 63 | End Function 64 | Function OpenDevTools() 65 | m_WebViewCore.OpenDevToolsWindow 66 | End Function 67 | Function Focus() 68 | Dim i As Integer 69 | If (Not Not g_wv2) <> 0 Then 70 | 'hide all controllers 71 | For i = LBound(g_wv2) To UBound(g_wv2) 72 | If Not g_wv2(i).controller Is Nothing Then 73 | g_wv2(i).controller.IsVisible = False 74 | End If 75 | Next i 76 | 'set myself to visible 77 | g_wv2(myIndex).controller.IsVisible = True 78 | End If 79 | End Function 80 | Function ExecuteScript(javaScript As String, Optional PropLet As String = vbNullString) 81 | Dim scriptHandler As clsWebViewScriptCompleteHandler 'create an instance of the scriptCompleteHandler class and set its parent, which will then call wv2.ExecuteScriptCompletedHandler back to us in this wv2 instance 82 | Set scriptHandler = New clsWebViewScriptCompleteHandler 83 | Set scriptHandler.Parent = Me 84 | scriptHandler.PropLet = PropLet 'if we want the result of the script to set some variable when it completes, we can use this argument 85 | m_WebViewCore.ExecuteScript javaScript, scriptHandler 'm_scriptHandler 86 | End Function 87 | '////////////////////////////// 88 | 89 | 90 | 91 | 92 | '/////////////////////////////// 93 | 'PROPERTIES 94 | '/////////////////////////////// 95 | Public Property Get index() As Long 96 | index = myIndex 97 | End Property 98 | Public Property Get controller() As ICoreWebView2Controller 99 | Set controller = m_WebViewController 100 | End Property 101 | Public Property Get handler() As clsWebViewEventHandlers 102 | If m_webViewHandlers Is Nothing Then 103 | Set m_webViewHandlers = New clsWebViewEventHandlers 104 | End If 105 | Set handler = m_webViewHandlers 106 | End Property 107 | Public Property Set handler(m_handler As clsWebViewEventHandlers) 108 | Set m_webViewHandlers = m_handler 109 | End Property 110 | Public Property Get browserTab() As MSForms.Tab 111 | Set browserTab = m_tab 112 | End Property 113 | Public Property Get resourceHistory(key As Long) As clsWebResData 114 | Set resourceHistory = resDict(key) 115 | End Property 116 | Public Property Get pageSource() As String 117 | ExecuteScript "document.documentElement.outerHTML;", "pageSource" 'use the PropLet argument to set the m_pageSource variable when the script completes 118 | pageSource = m_pageSource 'note this property will not be ready immediately, we need to wait for the script handler to return first 119 | End Property 120 | Public Property Let pageSource(val As String) 121 | m_pageSource = val 122 | End Property 123 | Public Property Get NavigationComplete() As Boolean 124 | NavigationComplete = m_navigationComplete 125 | End Property 126 | Public Property Let NavigationComplete(val As Boolean) 127 | m_navigationComplete = val 128 | End Property 129 | '//////////////////////////////// 130 | 131 | 132 | 133 | 134 | 135 | 136 | 137 | 138 | 139 | '/////////////////////////////// 140 | 'CLASS CREATION FUNCTIONS 141 | '/////////////////////////////// 142 | Private Sub WebViewReady() 'called each time a new wv2controller is ready (every new tab) 143 | Dim token As EventRegistrationToken 'just pass the same token pointer around, at this point we dont really care to ever remove these handlers, maybe in the future 144 | 145 | 'initialize web event handlers 146 | m_WebViewCore.AddWebResourceRequestedFilter "*", COREWEBVIEW2_WEB_RESOURCE_CONTEXT_ALL 'you MUST add a WebResource filter to receive the events at all, we want to see all events so use the * wildcard 147 | m_WebViewCore.add_WebResourceRequested m_webViewHandlers, token 148 | m_WebViewCore.add_WebResourceResponseReceived m_webViewHandlers, token 149 | m_WebViewCore.add_DOMContentLoaded m_webViewHandlers, token 150 | m_WebViewCore.add_NavigationCompleted m_webViewHandlers, token 151 | m_WebViewCore.add_NavigationStarting m_webViewHandlers, token 152 | m_WebViewCore.add_DocumentTitleChanged m_webViewHandlers, token 153 | 154 | 'navigate to homepage 155 | Me.OpenUrl homePageUrl 156 | End Sub 157 | 158 | Private Function GetWebView2Env(ByRef m_tab As MSForms.Tab) As wv2Environment 159 | Set m_tab = UserForm1.browserTabs.Tabs.Add("tab" & myIndex, "New Tab", myIndex) 160 | 161 | If g_wv2Env Is Nothing Then 162 | If g_webFrame Is Nothing Then 163 | Set g_webFrame = UserForm1.Controls.Add("Forms.Frame.1", "tab_Frame" & myIndex, False) 164 | With g_webFrame 165 | .Top = UserForm1.browserTabs.Top + 14 166 | .Left = UserForm1.browserTabs.Left 167 | .Height = UserForm1.browserTabs.Height - 14 168 | .Width = UserForm1.browserTabs.Width 169 | .TabStop = False 170 | .Visible = True 171 | End With 172 | End If 173 | 174 | g_webHostHwnd = g_webFrame.[_GethWnd] 175 | 176 | Set m_wv2env = New wv2Environment 177 | m_wv2env.Init 178 | End If 179 | 180 | Set m_wv2env = g_wv2Env 181 | Set GetWebView2Env = m_wv2env 182 | 'Debug.Print myIndex 183 | 'Set UserForm1.browserTabs.SelectedItem = UserForm1.browserTabs.Tabs.Item(myIndex + 1) 184 | End Function 185 | 186 | 187 | Private Sub Class_Initialize() 188 | Dim newCount As Integer 189 | Set resDict = New Dictionary 190 | 191 | 'keep a reference to this instance in global 192 | If (Not Not g_wv2) = 0 Then 'if the g_wv2 array is uninitialized, this is the first instance 193 | 194 | 'cleanup/initialize plugins on first instance creation 195 | PluginManager.Kill 196 | pluginLoader.LoadPlugins 197 | 198 | newCount = 0 199 | Else 200 | newCount = UBound(g_wv2) + 1 201 | End If 202 | myIndex = newCount 203 | 204 | If g_wv2Env Is Nothing Then 205 | 'create webview2 environment if it doesnt exist yet 206 | Set m_wv2env = GetWebView2Env(m_tab) 207 | 'controller will be created automatically when environment is initialized 208 | 'see m_wv2env_wv2EnvReady 209 | Else 210 | Set m_wv2env = GetWebView2Env(m_tab) 211 | 'environment already exists, so we need to create a new controller instead (this is called when this class is initialized more than once, for instance creating a new browser tab) 212 | g_wv2Env.this.CreateCoreWebView2Controller g_webHostHwnd, handler 213 | End If 214 | 215 | 216 | 217 | ReDim Preserve g_wv2(newCount) 218 | Set g_wv2(newCount) = Me 219 | End Sub 220 | 221 | Private Sub Class_Terminate() 222 | 223 | 'Set handler = Nothing 224 | If Not m_WebViewCore Is Nothing Then 225 | m_WebViewCore.Stop 226 | End If 227 | Set m_webViewHandlers = Nothing 228 | Set m_WebViewCore = Nothing 229 | Set m_WebViewController = Nothing 230 | If Not resDict Is Nothing Then 231 | Dim v As Variant 232 | For Each v In resDict.Items 233 | Set v = Nothing 234 | Next v 235 | For Each v In resDict.Keys 236 | Set v = Nothing 237 | Next v 238 | resDict.RemoveAll 239 | End If 240 | Set resDict = Nothing 241 | 242 | End Sub 243 | 244 | 245 | 246 | 247 | 248 | 249 | 250 | 251 | 252 | 253 | 254 | 255 | 256 | 257 | 258 | 259 | 260 | 261 | 262 | 263 | 264 | 265 | '/////////////////////////////// 266 | 'EVENT HANDLERS 267 | '/////////////////////////////// 268 | Private Sub m_scriptHandler_wv2ScriptComplete(ByVal sender As wv2, resultObjectAsJson As String) 269 | 270 | End Sub 271 | Public Sub ExecuteScriptCompletedHandler(errorCode As Long, resultObjectAsJson As String) 272 | 273 | End Sub 274 | 275 | Private Sub m_webViewHandlers_DocumentTitleChanged(sender As WebView2_edit.ICoreWebView2, args As Long) 276 | Dim docTitle As String 277 | docTitle = StrFromPtr(m_WebViewCore.DocumentTitle) 278 | If Len(docTitle) > 10 Then 279 | docTitle = Left(docTitle, 7) & "..." 280 | End If 281 | m_tab.Caption = docTitle 282 | End Sub 283 | 284 | Private Sub m_webViewHandlers_NavigationCompleted(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationCompletedEventArgs) 285 | Dim docTitle As String 286 | UserForm1.cmdStopReload.Caption = "R" 287 | docTitle = StrFromPtr(m_WebViewCore.DocumentTitle) 288 | If Len(docTitle) > 10 Then 289 | docTitle = Left(docTitle, 7) & "..." 290 | End If 291 | m_tab.Caption = docTitle 292 | NavigationComplete = True 293 | End Sub 294 | 295 | Private Sub m_webViewHandlers_NavigationStarting(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2NavigationStartingEventArgs) 296 | Dim uri As String 297 | UserForm1.cmdStopReload.Caption = "X" 298 | uri = StrFromPtr(args.uri) 299 | If Len(uri) > 10 Then 300 | uri = Left(uri, 7) & "..." 301 | End If 302 | m_tab.Caption = uri 303 | NavigationComplete = False 304 | End Sub 305 | 306 | Private Sub m_webViewHandlers_wv2ControllerReady(ByRef createdController As WebView2_edit.ICoreWebView2Controller) 307 | Dim wc2 As ICoreWebView2Controller2 308 | Set wc2 = createdController 309 | 310 | wc2.DefaultBackgroundColor = &H808080FF 311 | 312 | 'sets the viewing area for the web view controller 313 | Dim RECT1 As RECT 314 | GetClientRect g_webHostHwnd, RECT1 315 | createdController.set_Bounds RECT1.Left, RECT1.Top, RECT1.Right, RECT1.Bottom 316 | 317 | Set m_WebViewController = createdController 318 | Set m_WebViewCore = createdController.CoreWebView2 319 | WebViewReady 320 | End Sub 321 | 322 | Private Sub m_webViewHandlers_wv2EnvironmentReady(ByRef createdEnvironment As WebView2_edit.ICoreWebView2Environment) 323 | 324 | End Sub 325 | 326 | Private Sub m_webViewHandlers_DOMContentLoaded(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2DOMContentLoadedEventArgs) 327 | ' figure out how to ensure this event is raised here prior to any plugins, for some reason plugin callbacks are going first 328 | 'm_pageSource = pageSource 'when page loads, automatically request the source with javascript so that the pageSource property is populated when other code requests it 329 | End Sub 330 | 331 | Private Sub m_webViewHandlers_WebResourceRequested(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceRequestedEventArgs) 332 | 333 | End Sub 334 | 335 | Private Sub m_webViewHandlers_WebResourceResponseReceived(sender As WebView2_edit.ICoreWebView2, args As WebView2_edit.ICoreWebView2WebResourceResponseReceivedEventArgs) 336 | Dim req As clsWebResData 337 | Set req = New clsWebResData 338 | 339 | Set req.sender = sender 340 | 341 | req.metaTitle = "RESPONSE" 342 | 343 | If Not args.Request Is Nothing Then 344 | 'content/body/post data 345 | If Not args.Request.Content Is Nothing Then 346 | req.reqContent = IStreamToString(args.Request.Content) 347 | End If 348 | 349 | 'uri/url 350 | req.uri = StrFromPtr(args.Request.uri) 351 | 352 | 'GET/POST or whatever 353 | req.Method = StrFromPtr(args.Request.Method) 354 | 355 | 356 | 357 | 'headers 358 | If Not args.Request.Headers Is Nothing Then 359 | If IterateHeaders(args.Request.Headers.GetIterator, req, "REQUEST") = False Then 360 | 'error! 361 | End If 362 | End If 363 | End If 364 | 365 | If Not args.Response Is Nothing Then 366 | 367 | 'reason 368 | req.ReasonPhrase = args.Response.ReasonPhrase 369 | 370 | 'headers 371 | If Not args.Response.Headers Is Nothing Then 372 | If IterateHeaders(args.Response.Headers.GetIterator, req, "RESPONSE") = False Then 373 | 'error! 374 | End If 375 | End If 376 | 377 | 'status 378 | req.StatusCode = args.Response.StatusCode 379 | 380 | logResource req, resDict 381 | 382 | args.Response.GetContent req.contentHandler 383 | End If 384 | 385 | 386 | End Sub 387 | 388 | Private Sub m_wv2env_wv2CtrlReady(ByRef createdController As WebView2_edit.ICoreWebView2Controller) 389 | 390 | End Sub 391 | 392 | Private Sub m_wv2env_wv2EnvReady(ByRef createdEnvironment As WebView2_edit.ICoreWebView2Environment) 393 | g_wv2Env.this.CreateCoreWebView2Controller g_webHostHwnd, handler 394 | End Sub 395 | 396 | Private Sub m_wv2env_wv2Ready(env As wv2Environment) 397 | 398 | End Sub 399 | 400 | 401 | 402 | 403 | 404 | '/////////////////////////////// 405 | 'HELPER FUNCTIONS 406 | '/////////////////////////////// 407 | 408 | Private Function IterateHeaders(ByRef iterator As ICoreWebView2HttpHeadersCollectionIterator, ByRef webData As clsWebResData, Optional hmetaTitle As String) As Boolean 409 | 'this function probably belongs in WV2Tools because it specifically outputs a more readable format for clsWebResData 410 | Dim hName As Long, hVal As Long, sName As String, sVal As String 411 | If Not iterator Is Nothing Then 412 | If webData.Headers <> "" Then 413 | webData.Headers = webData.Headers & vbTab & "[" & hmetaTitle & "]" & vbCrLf & vbTab & "---------------" & vbCrLf 414 | Else 415 | webData.Headers = "[" & hmetaTitle & "]" & vbCrLf & vbTab & "---------------" & vbCrLf 416 | End If 417 | Do While iterator.HasCurrentHeader 418 | iterator.GetCurrentHeader hName, hVal 419 | If hName <> 0 Then sName = StrFromPtr(hName) 420 | If hVal <> 0 Then sVal = StrFromPtr(hVal) 421 | If sName <> "" Or sVal <> "" Then 422 | If webData.Headers <> "" Then 423 | webData.Headers = webData.Headers & vbTab & sName & ":" & sVal & vbCrLf 424 | Else 425 | webData.Headers = sName & ":" & sVal & vbCrLf 426 | End If 427 | End If 428 | iterator.MoveNext 429 | Loop 430 | webData.Headers = webData.Headers & vbTab & "---------------" & vbCrLf 431 | IterateHeaders = True 432 | Exit Function 433 | End If 434 | IterateHeaders = False 435 | End Function 436 | -------------------------------------------------------------------------------- /src/wv2Environment.cls: -------------------------------------------------------------------------------- 1 | VERSION 1.0 CLASS 2 | BEGIN 3 | MultiUse = -1 'True 4 | END 5 | Attribute VB_Name = "wv2Environment" 6 | Attribute VB_GlobalNameSpace = False 7 | Attribute VB_Creatable = False 8 | Attribute VB_PredeclaredId = False 9 | Attribute VB_Exposed = False 10 | Option Explicit 11 | 'ExcelWebView2 by Lucas Plumb @ 2023 12 | 'WebView2Environment object, do NOT instantiate this manually! 13 | 'simply create a new wv2 class object using: 14 | ' Dim wv As wv2 15 | ' Set wv = New wv2 16 | 'the wv2 object itself will handle everything needed for setup 17 | 'this class object will automatically be instantiated if needed by the wv2 object 18 | 19 | Private m_WebView2Environment As ICoreWebView2Environment 20 | Private WithEvents m_webViewHandlers As clsWebViewEventHandlers 21 | Attribute m_webViewHandlers.VB_VarHelpID = -1 22 | 23 | Public Event wv2CtrlReady(ByRef createdController As WebView2_edit.ICoreWebView2Controller) 24 | Public Event wv2EnvReady(ByRef createdEnvironment As WebView2_edit.ICoreWebView2Environment) 25 | Public Event wv2Ready(ByRef env As wv2Environment) 26 | 27 | 28 | Public Property Get this() As ICoreWebView2Environment 29 | If m_WebView2Environment Is Nothing Then 30 | If CreateCoreWebView2EnvironmentWithOptions(0&, StrPtr(userdata), 0&, handler) <> S_OK Then 31 | 'MessageBox 0, "Failed to create environment", "Error", 0 32 | Unload Me 33 | Else 34 | 'we could raise an "environment creation successful" event here, but we do it in "handler" instead 35 | End If 36 | Else 37 | Set this = m_WebView2Environment 38 | End If 39 | End Property 40 | 41 | Public Sub Init() 42 | If CreateCoreWebView2EnvironmentWithOptions(0&, StrPtr(userdata), 0&, handler) <> S_OK Then 43 | 'MessageBox 0, "Failed to create environment", "Error", 0 44 | Unload Me 45 | Else 46 | 'we could raise an "environment creation successful" event here, but we do it in "handler" instead 47 | End If 48 | RaiseEvent wv2Ready(Me) 49 | End Sub 50 | 51 | Public Property Get handler() As clsWebViewEventHandlers 52 | If m_webViewHandlers Is Nothing Then 53 | Set m_webViewHandlers = New clsWebViewEventHandlers 54 | End If 55 | Set handler = m_webViewHandlers 56 | End Property 57 | 58 | Public Property Set handler(m_handler As clsWebViewEventHandlers) 59 | Set m_webViewHandlers = m_handler 60 | End Property 61 | 62 | Private Sub Class_Initialize() 63 | If Not g_wv2Env Is Nothing Then 64 | MsgBox "wv2Environment error - class created when environment already exists", vbCritical, "Error" 65 | End If 66 | Set g_wv2Env = Me 67 | End Sub 68 | 69 | Private Sub Class_Terminate() 70 | Set m_WebView2Environment = Nothing 71 | Set m_webViewHandlers = Nothing 72 | End Sub 73 | 74 | Private Sub m_webViewHandlers_wv2ControllerReady(ByRef createdController As WebView2_edit.ICoreWebView2Controller) 75 | Debug.Print "controller ready in env" 76 | RaiseEvent wv2CtrlReady(createdController) 77 | End Sub 78 | 79 | Private Sub m_webViewHandlers_wv2EnvironmentReady(ByRef createdEnvironment As WebView2_edit.ICoreWebView2Environment) 80 | Set m_WebView2Environment = createdEnvironment 81 | Set g_Env = createdEnvironment 82 | RaiseEvent wv2EnvReady(g_Env) 83 | Debug.Print "environment ready in env" 84 | End Sub 85 | 86 | -------------------------------------------------------------------------------- /src/z_VB_IDE_Helpers.bas: -------------------------------------------------------------------------------- 1 | Attribute VB_Name = "z_VB_IDE_Helpers" 2 | Option Explicit 3 | '*** 4 | 'by Lucas Plumb @ 2023 5 | 'z_VB_IDE_Helpers 6 | 'contains development assistance/code automation functions 7 | '*** 8 | '*NOTE* - THIS MODULE REQUIRES 'TRUST ACCESS TO THE VBA PROJECT OBJECT MODEL' OPTION ENABLED IN TRUST CENTER SETTINGS 9 | 'THIS IS ONLY A DEVELOPMENT TOOL AND SHOULD NOT CONTAIN ANY METHODS USED IN THE REST OF THE PROJECT 10 | 'SIMILARLY, NONE OF THE METHODS IN THIS MODULE SHOULD BE USED ELSEWHERE IN THE PROJECT 11 | 'IT IS DESIGNED TO BE REMOVED FOR DISTRIBUTION SO THAT THE PROJECT CAN RUN WITHOUT REQUIRING TRUST TO THE VBA PROJECT OBJECT MODEL 12 | 13 | 'THE FUNCTIONS IN THIS CLASS MAY ALTER PROJECT FILES - BE CAREFUL! 14 | '*** 15 | 16 | 17 | 'select a module/class in the project window, then type 'VBIDE_EnumToStrings "NameOfEnumToConvert"' in the immediate window and press enter 18 | 'this will generate a function that returns enum names as strings which will be inserted into the selected module 19 | Public Function VBIDE_EnumToStrings(enumToFind As String) 20 | Dim selComp As VBComponent 21 | Dim moduleCodeStr As String 22 | Dim i As Long, strLines() As String, strTemp() As String, enumName As String, enumVal As Long 23 | Dim enumStartLine As Long, enumEndLine As Long, enumCaseName As String 24 | Dim strFunc As String, strFuncName As String 25 | strFuncName = "Function " & enumToFind & "ToStr" 26 | 27 | Dim lastExplicitVal As Long 28 | 29 | lastExplicitVal = -1 30 | enumStartLine = -1 31 | 32 | Set selComp = Application.VBE.SelectedVBComponent 33 | moduleCodeStr = selComp.CodeModule.lines(1, selComp.CodeModule.CountOfLines) 34 | strLines = Split(moduleCodeStr, vbNewLine) 35 | 36 | For i = 0 To UBound(strLines) 37 | 'Debug.Print "'" & LCase$(strLines(i)) 38 | If InStr(LCase$(strLines(i)), LCase$(strFuncName)) Then 39 | Debug.Print "The Function '" & enumToFind & "ToStr' already exists on line " & i & " in module '" & selComp.Name & "', VBIDE_EnumToStrings aborted" 40 | Exit Function 41 | End If 42 | Next i 43 | 44 | For i = 0 To UBound(strLines) 45 | If InStr(LCase$(strLines(i)), LCase$("Enum " & enumToFind)) Then 46 | strTemp = Split(strLines(i), "Enum ") 47 | enumCaseName = strTemp(1) 48 | enumStartLine = i 49 | End If 50 | If strLines(i) = "End Enum" And enumStartLine >= 0 Then enumEndLine = i 51 | If enumStartLine > -1 And enumEndLine > 0 Then Exit For 52 | Next i 53 | 54 | If enumStartLine > -1 And enumEndLine > 0 Then 55 | strFunc = "'EnumToStr generated by VBIDE_EnumToStrings for " & enumCaseName & vbNewLine 56 | strFunc = strFunc & "Public Function " & enumCaseName & "ToStr(enumVal As " & enumCaseName & ") As String" & vbNewLine 57 | strFunc = strFunc & vbTab & "Select Case enumVal" & vbNewLine 58 | For i = enumStartLine + 1 To enumEndLine - 1 59 | If InStr(strLines(i), " = ") Then 60 | strTemp = Split(strLines(i), " = ") 61 | enumName = Trim$(strTemp(0)) 62 | enumVal = strTemp(1) 63 | Else 64 | 'if no explicit assignment, enum values start at 0 or the last explicitly assigned value 65 | enumName = Trim$(strLines(i)) 66 | enumVal = lastExplicitVal + 1 67 | End If 68 | lastExplicitVal = enumVal 69 | strFunc = strFunc & vbTab & vbTab & "Case " & enumCaseName & "." & enumName & vbNewLine 70 | strFunc = strFunc & vbTab & vbTab & vbTab & enumCaseName & "ToStr = """ & enumName & """" & vbNewLine 71 | Next i 72 | strFunc = strFunc & vbTab & "End Select" & vbNewLine 73 | strFunc = strFunc & "End Function" 74 | 75 | Debug.Print strFunc 76 | ' NEED TO CHANGE THE INSERTLINES TO USE SOME LINE AFTER THE DECLARATION, SINCE ENUMS NEED TO BE DECLARED ABOVE ALL FUNCTIONS - CANT INSERT OUR FUNCTION DIRECTLY BELOW THE ENUM 77 | If MsgBox("Code will be inserted as shown in the Immediate Window in module '" & selComp.Name & "' on line " & enumEndLine + 2 & "." & vbCrLf & _ 78 | "Are you sure?", vbYesNo, "Prompt") = vbYes Then 79 | selComp.CodeModule.InsertLines enumEndLine + 2, strFunc 80 | Debug.Print "The Function '" & enumCaseName & "' was added on line " & enumEndLine + 2 & " in module '" & selComp.Name & "'" 81 | Else 82 | Debug.Print "Aborted" 83 | End If 84 | Else 85 | Debug.Print "Enum '" & enumToFind & "' was not found in the selected code module: '" & selComp.Name & "'" 86 | End If 87 | 88 | End Function 89 | --------------------------------------------------------------------------------