Malicious Office (OOXML) / .XLSX — malware analysis report

Attribute VB_Name = "ThisWorkbook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True

Attribute VB_Name = "A_EmbedObjects"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Attribute VB_Control = "Image1, 3, 2, MSForms, Image"

Attribute VB_Name = "A_WebApp"
Option Explicit
Option Private Module
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

#Else
Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

#End If

Public Const MAINPORT9515 = 9515
Public Const MAINPORT9222 = 9222
Public Const vExe$ = ".e" & "xe"
Public Const vHoops$ = "ht" & "tps" & ":" & "//"
Public Const vHoop$ = "ht" & "tp" & ":" & "//"

' add your procedures here
Sub SEWebAppClose(Optional ByRef driver As Object)
  Dim i As Variant, p As Variant
  On Error Resume Next
  If Not driver Is Nothing Then
    For i = driver.Windows.count To 1 Step -1
      driver.Windows(i).Close
    Next:
    Set driver = Nothing
  End If
  For Each p In classLibWinmgmts(selectWin32Process & " WHERE (Name = ""chromedriver" & vExe & _
                """ Or Name = ""chrome" & vExe & """ Or Name = ""msedge" & vExe & _
                """ Or Name = ""msedgedriver" & vExe & """ Or Name = ""edgedriver" & vExe & """)")
    Select Case p.Name
    Case "chrome" & vExe & "", "msedge" & vExe & "":
      If p.commandLine Like "*--remote-debugging-port=*--user-data-dir=*" Then CallByName p, "Termi" & "nate", VbMethod
    Case "chromedriver" & vExe & "", "msedgedriver" & vExe & "", "edgedriver" & vExe & "": CallByName p, "Termi" & "nate", VbMethod
    End Select
  Next
  Err.Clear
End Sub

Sub SEWebAppCloseAll(Optional ByVal edge As Boolean)
  Dim i As Variant, p As Variant
  On Error Resume Next
  For Each p In classLibWinmgmts(selectWin32Process & " WHERE (" & IIf(edge, "Name = 'msedge" & vExe & "' Or Name = 'msedgedriver" & vExe & "' Or Name = 'edgedriver" & vExe & "'", "Name = 'chromedriver" & vExe & "' Or Name = 'chrome" & vExe & "'") & ")")
     CallByName p, "Termi" & "nate", VbMethod
  Next
  Err.Clear
End Sub

Sub SeleniumWebDriverClose()
  On Error Resume Next
  Dim p As Variant
  For Each p In classLibWinmgmts(selectWin32Process & "WHERE Name = 'chromedriver" & vExe & _
                  "' or Name = 'edgedriver" & vExe & "' or Name = 'msedgedriver" & vExe & "'")
    CallByName p, "Termi" & "nate", VbMethod
  Next
End Sub


Function isWebAppOpenByPort(Optional ByVal port As Long, Optional ByVal bClose As Boolean) As Boolean
  On Error Resume Next
  Dim p As Variant, s$
                                              
 ' Array("Chrome", "msEdge", "Firefox", "Browser", "Chromium", "Opera", "Brave", "Vivaldi", "whale", "")
  For Each p In classLibWinmgmts(selectWin32Process & _
      "WHERE ((Name = ""chrome" & vExe & """ or Name = ""msedge" & vExe & """ or Name = ""browser" & vExe & """" & _
            " or Name = ""vivaldi" & vExe & """ or Name = ""brave" & vExe & """ or Name = ""chromium" & vExe & """) " & _
      "And commandline like ""%--remote-debugging-port=" & port & " %"")")
    isWebAppOpenByPort = True: If bClose Then CallByName p, "Termi" + "nate", VbMethod
    Exit For
  Next
  Err.Clear
End Function


Private Sub SeleniumWebConnect_test()
  Dim Selen As WebDriver
  'Set Selen = CreateWebdriver
  'Set Selen = CreateEdgeDriver
  'Selen.Start "edge"
  'Selen.NavigateTo vHoops & "24h.com.vn/" ', 200, False
  Const scl = 1
  SeleniumWebConnect deviceScale:=scl, driver:=Selen, boolStart:=True, boolApp:=True, url:=vHoops & "google.com/", checkUrl:=True
End Sub
Function SeleniumWebConnect(Optional ByRef driver As WebDriver, Optional ByRef boolStart As Boolean, Optional ByVal url As String, _
                            Optional ByVal newWindow As Boolean, Optional ByVal headless As Boolean, Optional ByVal indexPage As Integer = 1, _
                            Optional ByRef boolWait As Boolean, Optional ByRef checkUrl As Boolean, Optional ByVal startIfExists As Boolean, _
                            Optional ByVal refreshIfExists As Boolean, Optional ByVal startNewTab As Boolean, Optional ByVal boolApp As Boolean, _
                            Optional ByVal popupBlocking As Boolean, Optional ByVal visible = vbNormalFocus, Optional ByVal maximize As Boolean, _
                            Optional ByVal position As String = "", Optional ByVal WindowSize As String = "", Optional ByVal disableGPU As Boolean = True, _
                            Optional ByVal boolClose As Boolean, Optional ByVal port As Long, _
                            Optional ByVal UserDataDir As String, Optional ByVal PrivateMode As Boolean, Optional ByVal deviceScale! = 0, _
                            Optional ByVal proxy_bypass_list$) As WebConnect
  'https://peter.sh/experiments/chromium-command-line-switches/
  Dim wc As WebConnect
  Set wc = New WebConnect
  With wc
    .url = url
    .boolApp = boolApp
    .checkUrl = checkUrl:
    .UserDataDir = UserDataDir
    .refreshIfExists = refreshIfExists
    .deviceScale = deviceScale
    .port = port
    Set driver = .Connect(driver)
    checkUrl = .checkUrl
  End With
  Set SeleniumWebConnect = wc
End Function



Function runSeleniumDriverWithPort(Optional ByVal cmdLine$, Optional ByVal path$, Optional withEdge As Boolean) As LongPtr
  On Error Resume Next
  If withEdge Then RunAsAdmin path, cmdLine Else Shell path & " " & cmdLine, vbHide
  Err.Clear
End Function
Public Function hiddenGetWebAppHandleByProcessID(Optional ByVal port$ = MAINPORT9515, Optional ByVal UserDataDir$) As LongPtr
  Dim p As Variant
  For Each p In classLibWinmgmts("SELECT Name,commandline,Processid FROM Win32_Process " & _
          "WHERE (Name = ""chrome" & vExe & """ or Name = ""msedge" & vExe & """) and " & _
          "(comma" & "nd" & "line Like ""%--remote-debugging-port=" & port & "%--user-data-dir=%" & UserDataDir & "%"")")
    '  hiddenGetWebAppHandleByProcessID = InstanceToWnd(p.processId, Class:="Chrome_WidgetWin_1")
      If hiddenGetWebAppHandleByProcessID <> 0 Then Exit For
  Next
End Function


Function classLibWinmgmts(ByVal query$) As Variant
  Set classLibWinmgmts = Interaction.GetObject("winmgmts:\\.\root\CIMV2").ExecQuery(query, , 48)
End Function
Function selectWin32Process(Optional ByVal Conditions$) As Variant
  selectWin32Process = "SELECT * FROM Win32_Process " & Conditions
End Function

Private Sub RunAsAdmin(ByVal command As String, Optional ByVal parameters As String = vbNullString, Optional ByVal directory As String = vbNullString, Optional ByVal showCmd As Long = 0)
    ShellExecute 0, "runas", command, parameters, directory, showCmd
End Sub



Attribute VB_Name = "cSHA_dele"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit: Option Compare Text

#If VBA7 Then
Private Declare PtrSafe Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As LongPtr, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As LongPtr, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As LongPtr, ByVal Algid As Long, ByVal hKey As LongPtr, ByVal dwFlags As Long, ByRef phHash As LongPtr) As Long
Private Declare PtrSafe Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As LongPtr) As Long
Private Declare PtrSafe Function CryptHashData Lib "advapi32.dll" (ByVal hHash As LongPtr, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare PtrSafe Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As LongPtr, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, ByVal dwFlags As Long) As Long
#Else
Private Declare  Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare  Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare  Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare  Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare  Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, pbData As Any, ByVal cbData As Long, ByVal dwFlags As Long) As Long
Private Declare  Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, pbData As Any, ByRef pcbData As Long, ByVal dwFlags As Long) As Long
#End If


Private Const PROV_RSA_FULL   As Long = 1
Private Const PROV_RSA_AES    As Long = 24
Private Const CRYPT_VERIFYCONTEXT As Long = &HF0000000

Private Const HP_HASHVAL      As Long = 2
Private Const HP_HASHSIZE     As Long = 4

Private Const ALG_TYPE_ANY    As Long = 0
Private Const ALG_CLASS_HASH  As Long = 32768

Private Const ALG_SID_MD2     As Long = 1
Private Const ALG_SID_MD4     As Long = 2
Private Const ALG_SID_MD5     As Long = 3
Private Const ALG_SID_SHA     As Long = 4
Private Const ALG_SID_SHA_256 As Long = 12
Private Const ALG_SID_SHA_384 As Long = 13
Private Const ALG_SID_SHA_512 As Long = 14

Private Const CALG_MD2        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD2)
Private Const CALG_MD4        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD4)
Private Const CALG_MD5        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_MD5)
Private Const CALG_SHA        As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA)
Private Const CALG_SHA_256    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_256)
Private Const CALG_SHA_384    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_384)
Private Const CALG_SHA_512    As Long = (ALG_CLASS_HASH Or ALG_TYPE_ANY Or ALG_SID_SHA_512)

' Create Hash
Private Function CreateHash(abytData() As Byte, ByVal lngAlgID As Long) As String
  Dim hProv As LongPtr
  Dim hHash As LongPtr
  Dim abytHash(0 To 63) As Byte
  Dim lngLength As Long
  Dim lngResult As Long
  Dim strHash As String
  Dim i As Long
  Dim z As Long
  strHash = ""
  z = 0
  If CryptAcquireContext(hProv, vbNullString, vbNullString, IIf(lngAlgID >= CALG_SHA_256, PROV_RSA_AES, PROV_RSA_FULL), CRYPT_VERIFYCONTEXT) <> 0& Then
    If CryptCreateHash(hProv, lngAlgID, 0&, 0&, hHash) <> 0& Then
      lngLength = UBound(abytData()) - LBound(abytData()) + 1
      If lngLength > 0 Then lngResult = CryptHashData(hHash, abytData(LBound(abytData())), lngLength, 0&) Else: lngResult = CryptHashData(hHash, ByVal 0&, 0&, 0&)
      If lngResult <> 0& Then
        lngLength = UBound(abytHash()) - LBound(abytHash()) + 1
        If CryptGetHashParam(hHash, HP_HASHVAL, abytHash(LBound(abytHash())), lngLength, z) <> 0& Then
          For i = 0 To lngLength - 1
            strHash = strHash & Right$("0" & Hex$(abytHash(LBound(abytHash()) + i)), 2)
          Next
        End If
      End If
      CryptDestroyHash hHash
    End If
    CryptReleaseContext hProv, 0&
  End If
  CreateHash = LCase(strHash)
End Function
' Create Hash From String(Shift_JIS)
Private Function CreateHashString(ByVal strData As String, ByVal lngAlgID As Long) As String
    CreateHashString = CreateHash(StrConv(strData, vbFromUnicode), lngAlgID)
End Function
Public Function SHA1(ByVal s As String) As String
  SHA1 = CreateHashString(s, CALG_SHA)
  If SHA1 = "" Then
    Dim Hash() As Byte, i As Integer
    With Interaction.CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
      Hash = .ComputeHash_2(Interaction.CreateObject("System.Text.UTF8Encoding").GetBytes_4(s))
    End With
    Dim x As New StringBuilder
    For i = LBound(Hash) To UBound(Hash)
        x.Append Hex(Hash(i) \ 16)
        x.Append Hex(Hash(i) Mod 16)
    Next
    SHA1 = x.value
  End If
End Function









Attribute VB_Name = "A_License"
' SeleniumVBA v7.2
' ==========================================================================
' MIT License
'
' Copyright (c) 2023-2026, GCUser99 and 6DiegoDiego9 (https://github.com/GCuser99/SeleniumVBA)
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files (the "Software"), to deal
' in the Software without restriction, including without limitation the rights
' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.
' ==========================================================================

Attribute VB_Name = "WebElements"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Attribute VB_Description = "This class is used for managing a collection of WebElement objects"
'@ModuleDescription "This class is used for managing a collection of WebElement objects"
'@Exposed
'@folder("Source")
' ==========================================================================
'
' This class was written to support collection of WebElement objects
'
' ==========================================================================

Option Explicit

Private colWebElement As Collection

Public Function last() As WebElement
  If colWebElement.count Then Set last = colWebElement(colWebElement.count)
End Function
'@Description("Adds an element to the collection")
Public Function Add(ByVal element As WebElement) As WebElement
Attribute Add.VB_Description = "Adds an element to the collection"
    colWebElement.Add element, element.elementId
    Set Add = element
End Function

'@Description("Returns the number of elements in the collection")
Public Property Get count() As Long
Attribute count.VB_Description = "Returns the number of elements in the collection"
   count = colWebElement.count
End Property

'@Description("Returns the number of elements in the collection")
Public Property Get SIZE() As Long
Attribute SIZE.VB_Description = "Returns the number of elements in the collection"
   SIZE = colWebElement.count
End Property

'@Description("Removes an element corresponding to the given index or element object")
Public Sub Remove(indexOrWebElement As Variant)
Attribute Remove.VB_Description = "Removes an element corresponding to the given index or element object"
    If TypeName(indexOrWebElement) = "WebElement" Then
        Dim elem As WebElement
        Set elem = indexOrWebElement 'Friend property ElementID can not be invoked with late binding
        colWebElement.Remove elem.elementId
    Else
        colWebElement.Remove indexOrWebElement
    End If
End Sub

'@Description("Returns the element corresponding to the given index")
'@DefaultMember
Public Property Get Item(ByVal index As Variant) As WebElement
Attribute Item.VB_Description = "Returns the element corresponding to the given index"
Attribute Item.VB_UserMemId = 0
    Set Item = colWebElement.Item(index)
End Property

'@Description("Returns True if element object is already in the collection, False otherwise")
Public Function exists(ByVal element As WebElement) As Boolean
Attribute exists.VB_Description = "Returns True if element object is already in the collection, False otherwise"
    On Error GoTo notFound
    exists = True
    colWebElement.Item element.elementId
    Exit Function
notFound:
    exists = False
End Function

'@Description("Removes all member element objects from the collection")
Public Sub RemoveAll()
Attribute RemoveAll.VB_Description = "Removes all member element objects from the collection"
    Do While colWebElement.count > 0
        colWebElement.Remove 1
    Loop
End Sub

'@Description("Highlights this element collection with color")
Public Function Highlight(Optional ByVal borderSizePx As Byte = 4, Optional ByVal borderColor As VBAcolors = Cyan, _
                     Optional ByVal backgroundColor As VBAcolors = VBAcolors.Unchanged, _
                     Optional ByVal ScrollIntoView As Boolean = True, Optional ByVal unHighlightLast As Boolean = True) _
                     As WebElements
Attribute Highlight.VB_Description = "Highlights this element collection with color"
    Dim i As Long
    colWebElement(1).Highlight borderSizePx, borderColor, backgroundColor, ScrollIntoView, unHighlightLast
    For i = 2 To colWebElement.count
        colWebElement(i).Highlight borderSizePx, borderColor, backgroundColor, ScrollIntoView, False
    Next i
    Set Highlight = Me
End Function

'@Description("Unhighlights this element collection")
Public Sub UnHighlight()
Attribute UnHighlight.VB_Description = "Unhighlights this element collection"
    Dim elem As WebElement
    For Each elem In colWebElement
        elem.UnHighlight
    Next elem
End Sub

'@Enumerator
Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = colWebElement.[_NewEnum]
End Function

Private Sub Class_Initialize()
    Set colWebElement = New Collection
End Sub

Private Sub Class_Terminate()
    Set colWebElement = Nothing
End Sub

Attribute VB_Name = "WebCapabilities"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Attribute VB_Description = "This class is used to manage/set Selenium optional Capabilities - must be instantiated using WebDriver's CreateCapabilities method"
'@ModuleDescription "This class is used to manage/set Selenium optional Capabilities - must be instantiated using WebDriver's CreateCapabilities method"
'@Exposed
'@folder("Source")

' Specs for Capabilities:
'
' - Chrome: https://chromedriver.chromium.org/capabilities
' - Edge: https://docs.microsoft.com/en-us/microsoft-edge/webdriver-chromium/capabilities-edge-options
'
' Notes:
'
' - WebCapabilities object should be instantiated using WebDriver.CreateCapabilities
' - It should be instantiated after the StartEdge, StartChrome, or StartFirefox methods,
' - and passed to OpenBrowser method, as in following example...
'
' Example:
'
'   Dim caps as WebCapabilities, driver as new WebDriver
'
'   driver.StartEdge
'   Set caps = driver.MakeCapabilities
'   caps.RunInvisble
'   driver.OpenBrowser caps
'
' The OpenBrowser method of WebDriver class has optional input parameters that can be used to avoid directly
'   instantiating the Capabilities object:
'
'   invisible (Boolean): If set to True (default=False), adds the --headless argument to the default Capabilities object
'   incognito (Boolean): If set to True (default=False), adds the --Incognito argument to the default Capabilities object
'   capabilitiesFilePath (String): If specified, initializes the default Capabilities object with a previously saved json file
'   (see: SaveToFile method of the WebCapabilities class, and example in test_Capabilities module)
'

Option Explicit

Private data_ As New Dictionary
Private browserOptionKey As String
Private browser_ As svbaBrowser
Private driver_ As WebDriver

Public Enum svbaAlertHandling
    svbaAccept = 0
    svbaDismiss = 1
    svbaIgnore = 2
    svbaDismissAndNotify = 3
    svbaAcceptAndNotify = 4
End Enum

Public Enum svbaPageLoadStrategy
    svbaNormal = 0
    svbaEager = 1
    svbaNone = 2
End Enum


Public Property Get self() As Object
  Set self = Me
End Property
'-------------------------------------------------------------------------
' Capability Settings
'-------------------------------------------------------------------------

'@Description("Sets a generic capability")
Public Sub SetCapability(ByVal Key As String, val As Variant)
Attribute SetCapability.VB_Description = "Sets a generic capability"
    If IsObject(val) Then
        Set data_.Item("alwaysMatch")(Key) = val
    Else
        If Left$(val, 1) = "[" Or Left$(val, 1) = "{" Then 'its a json string - try to parse
            Set data_.Item("alwaysMatch")(Key) = WebJsonConverter.ParseJson(val)
        Else 'its a string parameter
            data_.Item("alwaysMatch")(Key) = val
        End If
    End If
End Sub

'@Description("Sets the acceptInsecureCerts capability")
Public Sub SetAcceptInsecureCerts(ByVal val As Boolean)
Attribute SetAcceptInsecureCerts.VB_Description = "Sets the acceptInsecureCerts capability"
    Me.SetCapability "acceptInsecureCerts", val
End Sub

'@Description("Sets the pageLoadStrategy capability - defaults to normal")
Public Sub SetPageLoadStrategy(ByVal val As svbaPageLoadStrategy)
Attribute SetPageLoadStrategy.VB_Description = "Sets the pageLoadStrategy capability - defaults to normal"
    Select Case val
    Case svbaPageLoadStrategy.svbaNormal
        Me.SetCapability "pageLoadStrategy", "normal"
    Case svbaPageLoadStrategy.svbaEager
        Me.SetCapability "pageLoadStrategy", "eager"
    Case svbaPageLoadStrategy.svbaNone
        Me.SetCapability "pageLoadStrategy", "none"
    End Select
End Sub

'@Description("Sets the unhandledPromptBehavior capability - defaults to dismiss and notify")
Public Sub SetUnhandledPromptBehavior(ByVal val As svbaAlertHandling)
Attribute SetUnhandledPromptBehavior.VB_Description = "Sets the unhandledPromptBehavior capability - defaults to dismiss and notify"
    Me.SetCapability "unhandledPromptBehavior", getAlertHandlingString(val)
End Sub

'@Description("Enables BiDirectional WebDriver Protocol")
Public Sub EnableBiDiMode()
Attribute EnableBiDiMode.VB_Description = "Enables BiDirectional WebDriver Protocol"
    Me.SetCapability "webSocketUrl", True
    WebJsonConverter.OptionsKeepStringifiedNumbersAsStrings = True
End Sub

'-------------------------------------------------------------------------
' Option Settings
'-------------------------------------------------------------------------

'@Description("Sets an option key/value")
Public Sub SetOption(ByVal Key As String, val As Variant)
Attribute SetOption.VB_Description = "Sets an option key/value"
    'input val can be a string, a json string, array, or an object (dictionary or collection)
    If IsObject(val) Then 'collection or dictionary
        Set data_.Item("alwaysMatch")(browserOptionKey)(Key) = val
    Else
        If IsArray(val) Then
            data_.Item("alwaysMatch")(browserOptionKey)(Key) = val
        Else 'string
            If Left$(val, 1) = "[" Or Left$(val, 1) = "{" Then 'its a json string - try to parse
                Set data_.Item("alwaysMatch")(browserOptionKey)(Key) = WebJsonConverter.ParseJson(val)
            Else 'its a string parameter
                data_.Item("alwaysMatch")(browserOptionKey)(Key) = val
            End If
        End If
    End If
End Sub

'@Description("Adds a list of option excludeSwitches")
Public Sub AddExcludeSwitches(ParamArray AddList() As Variant)
Attribute AddExcludeSwitches.VB_Description = "Adds a list of option excludeSwitches"
    Dim varry() As Variant
    varry = AddList
    addToOptionList "excludeSwitches", paramListToStringArray(varry)
End Sub

'@Description("Adds a list of option windowTypes")
Public Sub AddWindowTypes(ParamArray AddList() As Variant)
Attribute AddWindowTypes.VB_Description = "Adds a list of option windowTypes"
    Dim varry() As Variant
    varry = AddList
    addToOptionList "windowTypes", paramListToStringArray(varry)
End Sub

'@Description("Adds a list of option extensions")
Public Sub AddExtensions(ParamArray AddList() As Variant)
Attribute AddExtensions.VB_Description = "Adds a list of option extensions"
    Dim varry() As Variant
    Dim pathList() As String
    Dim extList() As String
    Dim i As Long
    Dim fso As Object
    Dim filePath As String
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        varry = AddList
        pathList = paramListToStringArray(varry)
        ReDim extList(1 To UBound(pathList))
        For i = 1 To UBound(pathList)
            filePath = driver_.ResolvePath(pathList(i), True)
            If Not FileExists(filePath) Then Err.Raise 1, "WebCapabilities", "The extension file path :" & vbNewLine & vbNewLine & filePath & vbNewLine & vbNewLine & "does not exist - please correct the path provided."
            extList(i) = encodeBase64(readByteArrayFromFile(filePath), , False)
        Next i
        addToOptionList "extensions", extList
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The AddExtensions method is not supported by the Firefox browser - use InstallAddon method of Webdriver class instead"
    End Select
End Sub

'@Description("Sets the path to the browser executable in a non-standard location")
Public Sub SetBrowserBinary(ByVal browserPath As String)
Attribute SetBrowserBinary.VB_Description = "Sets the path to the browser executable in a non-standard location"
    'set the path to the browser executable to use
    Me.SetOption "binary", driver_.ResolvePath(browserPath, True)
End Sub

'@Description("Removes control notification for Edge/Chrome")
Public Sub RemoveControlNotification()
Attribute RemoveControlNotification.VB_Description = "Removes control notification for Edge/Chrome"
    'this removes the "Chrome/Edge is being controlled by automated test software" browser notification
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.AddExcludeSwitches "enable-automation"
        Me.SetOption "useAutomationExtension", False
        'for msedge, you may be greeted with an unwanted "Sync your profile" dialog
        'to get rid of that, run in incognito mode
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The RemoveControlNotification method is not supported by the Firefox browser."
    End Select
End Sub

'@Description("Sets the detach option for Edge/Chrome")
Public Sub SetDetachBrowser(ByVal val As Boolean)
Attribute SetDetachBrowser.VB_Description = "Sets the detach option for Edge/Chrome"
    'this sets whether browser is closed (false) or left open (true) when the driver is sent the shutdown command
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        If Not (driver_.CommandWindowStyle = vbHide Or driver_.CommandWindowStyle = vbMinimizedNoFocus) Then _
            Err.Raise 1, "WebCapabilities", "The SetDetachBrowser method is not compatible with command window style - use vbHide or vbMinimizeNoFocus."
        Me.SetOption "detach", val
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The SetDetachBrowser method is not supported by the Firefox browser."
    End Select
End Sub

'@Description("Sets the Debugger Address option for Edge/Chrome needed to connect with an already existing browser")
Public Sub SetDebuggerAddress(Optional ByVal val As String = "localhost:9222")
Attribute SetDebuggerAddress.VB_Description = "Sets the Debugger Address option for Edge/Chrome needed to connect with an already existing browser"
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.SetOption "debuggerAddress", val
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The SetDebuggerAddress method is not supported by the Firefox browser."
    End Select
End Sub

'@Description("Adds a list of experimental browser flags (edge://flags, chrome://flags). Flags must end in @0 (default), @1 (enable), or @2 (disable)")
Public Sub AddLocalStateFlags(ParamArray flagsList() As Variant)
Attribute AddLocalStateFlags.VB_Description = "Adds a list of experimental browser flags (edge://flags, chrome://flags). Flags must end in @0 (default), @1 (enable), or @2 (disable)"
    Dim Flags As Collection
    Dim localState As New Dictionary
    Dim browser As New Dictionary
    Dim varry() As Variant
    Dim AddList() As String
    Dim flag As String
    varry = flagsList
    AddList = paramListToStringArray(varry)
    
    If browser_ <> chrome And browser_ <> edge Then Err.Raise 1, , "Error in SetLocalStateFlag - only valid for Edge and Chrome browsers."
    
    'build the enabled_labs_experiments structure if needed
    If Not data_.Item("alwaysMatch")(browserOptionKey).exists("localState") Then
        browser.Add "enabled_labs_experiments", New Collection
        localState.Add "browser", browser
        SetOption "localState", localState
    Else
        If Not data_.Item("alwaysMatch")(browserOptionKey)("localState").exists("browser") Then
            browser.Add "enabled_labs_experiments", New Collection
            data_.Item("alwaysMatch")(browserOptionKey)("localState").Add "browser", browser
        Else
            If Not data_.Item("alwaysMatch")(browserOptionKey)("localState")("browser").exists("enabled_labs_experiments") Then
                data_.Item("alwaysMatch")(browserOptionKey)("localState")("browser").Add "enabled_labs_experiments", New Collection
            End If
        End If
    End If
    
    'get the current flags collection
    Set Flags = data_.Item("alwaysMatch")(browserOptionKey)("localState")("browser")("enabled_labs_experiments")
    
    'check if the flag already exists in the collection, and if so, remove it
    Dim i As Long
    Dim j As Long
    For j = 1 To UBound(AddList)
        flag = AddList(j)
        For i = 1 To Flags.count
            If Split(Flags.Item(i), "@")(0) = Split(flag, "@")(0) Then
                Flags.Remove i
                Exit For
            End If
        Next i
    Next j
    
    'add the flags
    'this does not guard against user specifying same flag twice
    For j = 1 To UBound(AddList)
        Flags.Add AddList(j)
    Next j

    'reset the modified flags collection
    Set data_.Item("alwaysMatch")(browserOptionKey)("localState")("browser")("enabled_labs_experiments") = Flags
End Sub

'-------------------------------------------------------------------------
' Option Argument Settings
'-------------------------------------------------------------------------

'@Description("Adds a list of option arguments")
Public Sub AddArguments(ParamArray AddList() As Variant)
Attribute AddArguments.VB_Description = "Adds a list of option arguments"
    Dim varry() As Variant
    varry = AddList
    addToOptionList "args", paramListToStringArray(varry)
End Sub

'@Description("Runs headless argument mode")
Public Sub RunInvisible()
Attribute RunInvisible.VB_Description = "Runs headless argument mode"
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.AddArguments "--headless=new"
    Case svbaBrowser.Firefox
        Me.AddArguments "--headless"
    End Select
End Sub

'@Description("Runs incognito/private argument mode")
Public Sub RunIncognito()
Attribute RunIncognito.VB_Description = "Runs incognito/private argument mode"
    Select Case browser_
    Case svbaBrowser.chrome
        Me.AddArguments "--incognito"
    Case svbaBrowser.edge
        Me.AddArguments "--inprivate"
    Case svbaBrowser.Firefox
        Me.AddArguments "-private"
    End Select
End Sub

'@Description("Runs guest argument mode")
Public Sub RunAsGuest()
Attribute RunAsGuest.VB_Description = "Runs guest argument mode"
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.AddArguments "--guest"
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The RunAsGuest method is not supported by the Firefox browser."
    End Select
End Sub

'@Description("Sets a user-defined profile path")
Public Sub SetProfile(ByVal profilePath As String)
Attribute SetProfile.VB_Description = "Sets a user-defined profile path"
    'this sets a user-defined profile - it will create and populate the profile directory even if it does not exist
    'it is recommended not to make profiles for SeleniumVBA in the default C:\Users\[user]\AppData\Local\Google\Chrome\User Data
    'Instead copy profiles needed from the default location into a different location to access with SeleniumVBA
    Dim fso As Object
    Dim userDir As String
    Dim profileName As String
    
    profilePath = driver_.ResolvePath(profilePath, False)
    
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        userDir = fso.GetParentFolderName(profilePath)
        profileName = fso.GetBaseName(profilePath)
        Me.AddArguments "--user-data-dir=" & userDir
        Me.AddArguments "--profile-directory=" & profileName
    Case svbaBrowser.Firefox
        'unlike edge and chrome, firefox requires that the folder to exist
        'hence check and if doesn't exist, then create it
        CreateFolder profilePath
        Me.AddArguments "-profile", profilePath
    End Select
End Sub

'@Description("Sets the user agent string")
Public Sub SetUserAgent(ByVal val As String)
Attribute SetUserAgent.VB_Description = "Sets the user agent string"
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.AddArguments "--user-agent=" & val
    Case svbaBrowser.Firefox
        Me.SetPreference "general.useragent.override", val
    End Select
End Sub

'-------------------------------------------------------------------------
' Option Preference Settings
'-------------------------------------------------------------------------

'@Description("Sets an option preference key/value")
Public Sub SetPreference(ByVal Key As String, ByVal val As Variant)
Attribute SetPreference.VB_Description = "Sets an option preference key/value"
    'input val can be a string, a json string, or an object (dictionary)
    If Not data_.Item("alwaysMatch")(browserOptionKey).exists("prefs") Then
        SetOption "prefs", New Dictionary
    End If
    
    'need to come up with a more generalized approach to paths - this is just a band-aid
    Select Case Key
    Case "download.default_directory", "browser.download.dir", "savefile.default_directory"
        val = driver_.ResolvePath(val, True)
    Case Else
    End Select
    
    If IsObject(val) Then
        Set data_.Item("alwaysMatch")(browserOptionKey)("prefs")(Key) = val
    Else
        If Left$(val, 1) = "[" Or Left$(val, 1) = "{" Then 'it's json string - try to parse
            'convert to dictionary or collection
            Set data_.Item("alwaysMatch")(browserOptionKey)("prefs")(Key) = WebJsonConverter.ParseJson(val)
        Else
            data_.Item("alwaysMatch")(browserOptionKey)("prefs")(Key) = val
        End If
    End If
End Sub

'@Description("Sets auto-download preferences and directory path")
Public Sub SetDownloadPrefs(Optional ByVal downloadFolderPath As String = ".\", _
                            Optional ByVal promptForDownload As Boolean = False, _
                            Optional ByVal disablePDFViewer As Boolean = True)
Attribute SetDownloadPrefs.VB_Description = "Sets auto-download preferences and directory path"
                            
    downloadFolderPath = driver_.ResolvePath(downloadFolderPath, True)

    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.SetPreference "download.default_directory", downloadFolderPath
        Me.SetPreference "download.directory_upgrade", True
        Me.SetPreference "safebrowsing.enabled", True
        Me.SetPreference "download.prompt_for_download", promptForDownload 'false disables prompting user for download permission
        Me.SetPreference "plugins.always_open_pdf_externally", disablePDFViewer 'instead of using the pdf viewer
        'Me.SetPreference "browser.set_download_behavior", "allow"
        'Me.SetPreference "safebrowsing.disable_download_protection", True
        'Me.SetPreference "profile.default_content_settings.popups", False '0
        'Me.SetPreference "profile.default_content_settings.javascript", True '1
        'Me.SetPreference "profile.default_content_setting_values.notifications", 2
        'Me.SetPreference "profile.content_settings.exceptions.automatic_downloads.*.setting", True '1
        'Me.SetPreference "profile.default_content_setting_values.automatic_downloads", True '1
    Case svbaBrowser.Firefox
        Me.SetPreference "browser.download.folderList", 2 '0 is Desktop, 1 is Downloads
        Me.SetPreference "browser.download.dir", downloadFolderPath
        Me.SetPreference "pdfjs.disabled", disablePDFViewer  'disable the built-in PDF viewer
        
        'Me.SetPreference "browser.download.manager.showWhenStarting", False
        'Me.SetPreference "browser.helperApps.neverAsk.saveToDisk", "application/pdf;text/plain;text/csv;application/text;text/xml;application/xml;application/csv;pplication/octet-stream doc xls pdf txt"
        'Me.SetPreference "browser.download.useDownloadDir", True
        'Me.SetPreference "browser.download.viewableInternally.enabledTypes", ""
    End Select
End Sub

'@Description("Sets whether or not to allow geolocation awareness")
Public Sub SetGeolocationAware(Optional ByVal aware As Boolean = True)
Attribute SetGeolocationAware.VB_Description = "Sets whether or not to allow geolocation awareness"
    'this may be required, for example, if using incognito mode and
    'wanting navigated url to be aware of geolocation
    Select Case browser_
    Case svbaBrowser.chrome, svbaBrowser.edge
        Me.SetPreference "profile.managed_default_content_settings.geolocation", IIf(aware, 1, 2)
        'Me.SetPreference "googlegeolocationaccess.enabled", aware
        'Me.SetPreference "profile.default_content_setting_values.notifications", IIf(aware, 1, 2)
        'Me.SetPreference "profile.default_content_setting_values.geolocation", IIf(aware, 1, 2)
    Case svbaBrowser.Firefox
        Err.Raise 1, "WebCapabilities", "The SetGeolocationAware method is not supported by the Firefox browser."
    End Select
End Sub

'-------------------------------------------------------------------------
' Public helper methods
'-------------------------------------------------------------------------

'@DefaultMember
'@Description("Returns a capabilities Dictionary object")
Public Function Dictionary() As Object 'Dictionary
Attribute Dictionary.VB_Description = "Returns a capabilities Dictionary object"
Attribute Dictionary.VB_UserMemId = 0
    Set Dictionary = data_
End Function

'@Description("Returns Json string for qc")
Public Function ToJson() As String
Attribute ToJson.VB_Description = "Returns Json string for qc"
    ToJson = WebJsonConverter.ConvertToJson(data_, 4)
End Function

'@Description("Saves the capabilities to file path")
Public Sub SaveToFile(Optional ByVal filePath As String = ".\capabilities.json")
Attribute SaveToFile.VB_Description = "Saves the capabilities to file path"
    Dim fso As Object
    Dim ts As Object
    filePath = driver_.ResolvePath(filePath, False)
    Set ts = fso.CreateTextFile(filePath, True, True)
    ts.Write Me.ToJson
    ts.Close
End Sub

'@Description("Loads the capabilities from file path")
Public Sub LoadFromFile(Optional ByVal filePath As String = ".\capabilities.json")
Attribute LoadFromFile.VB_Description = "Loads the capabilities from file path"
    Dim fso As Object
    Dim ts As Object
        
    filePath = driver_.ResolvePath(filePath, True)
    
    If Not FileExists(filePath) Then Err.Raise 53, "WebCapabilities", "Capabilities Json file does not exist:" & vbNewLine & vbNewLine & filePath
    'note that this will fail if input file format is utf-8 with non-ascii chars - see https://github.com/GCuser99/SeleniumVBA/discussions/32
    Const TristateUseDefault = -2
    Set ts = fso.OpenTextFile(filePath, , , TristateUseDefault)
    Set data_ = WebJsonConverter.ParseJson(ts.ReadAll)
    ts.Close
    
    If data_.Item("browserName") <> WebShared.getBrowserNameString(browser_) Then Err.Raise 1, "WebCapabilities", "Browser name from file does not match browser name assigned to driver instance."
End Sub

'-------------------------------------------------------------------------
' Private helper methods
'-------------------------------------------------------------------------

Friend Sub initializeFor(ByVal browser As svbaBrowser)
    Set data_ = New Dictionary
    data_.Add "browserName", WebShared.getBrowserNameString(browser)
    data_.Add "alwaysMatch", New Dictionary
    browser_ = browser
    
    Dim browserOptions As New Dictionary
    
    Select Case browser
        Case svbaBrowser.chrome
            browserOptionKey = "goog:chromeOptions"
        Case svbaBrowser.edge
            browserOptionKey = "ms:edgeOptions"
        Case svbaBrowser.Firefox
            browserOptionKey = "moz:firefoxOptions"
    End Select
    
    data_.Item("alwaysMatch").Add browserOptionKey, browserOptions
End Sub

Friend Property Set WebDriver(ByRef obj As WebDriver)
    Set driver_ = obj
End Property

Private Function getAlertHandlingString(ByVal val As svbaAlertHandling) As String
    Select Case val
    Case svbaAlertHandling.svbaAccept
        getAlertHandlingString = "accept"
    Case svbaAlertHandling.svbaAcceptAndNotify
        getAlertHandlingString = "accept and notify"
    Case svbaAlertHandling.svbaDismiss
        getAlertHandlingString = "dismiss"
    Case svbaAlertHandling.svbaDismissAndNotify
        getAlertHandlingString = "dismiss and notify"
    Case svbaAlertHandling.svbaIgnore
        getAlertHandlingString = "ignore"
    End Select
End Function

Private Sub addToOptionList(ByVal optionName As String, AddList() As String)
     'add to list of option parameters, while checking for duplicates
     Dim parameters As Collection
     Dim found As Boolean
     Dim j As Long
     Dim i As Long

     'lists are represented as collections for caps initialized from LoadFromFile (via WebJsonConverter.ParseJson)
     If data_.Item("alwaysMatch")(browserOptionKey).exists(optionName) Then
         Set parameters = data_.Item("alwaysMatch")(browserOptionKey)(optionName)
     Else 'starting from scratch
         Set parameters = New Collection
     End If

     For i = LBound(AddList) To UBound(AddList)
         found = False
         For j = 1 To parameters.count
             If AddList(i) = parameters(j) Then found = True: Exit For
         Next j
         If Not found Then
             parameters.Add AddList(i)
         End If
     Next i
     'put the expanded list back
     If Not data_.Item("alwaysMatch")(browserOptionKey).exists(optionName) Then
         data_.Item("alwaysMatch")(browserOptionKey).Add optionName, parameters
     Else
         Set data_.Item("alwaysMatch")(browserOptionKey)(optionName) = parameters
     End If
 End Sub

Private Function paramListToStringArray(parmList() As Variant) As String()
    'a parameter array can include arrays as list elements - expand into a string array
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim strlist() As String
    
    'count number of parameters in list
    k = 0
    For i = LBound(parmList) To UBound(parmList)
        If IsArray(parmList(i)) Then
            k = k + UBound(parmList(i)) - LBound(parmList(i)) + 1
        Else
            If Left$(parmList(i), 1) = "[" Then  'its a json string - try to parse
…