Initial version - wrapper (clsCDP and cdp/*) of the CDP protocol with most of the types also generated, initial higher level driver (AutomateBrowser), generator for CDP protocol vba wrapper (generates cdp/*)

Author: PerditionC

src/AutomateBrowser.cls

@@ -0,0 +1,60 @@
+Attribute VB_Name = "ClipboardUtils"
+'misc clipboard functions, allows selection Range and converting to CSV in clipboard to paste into another application
+Option Explicit
+
+
+' Work around for bug in Excel, must put directly in clipboard or results potentially scrambled when Explorer window open
+' https://msdn.microsoft.com/en-us/library/office/ff192913.aspx?f=255&MSPPError=-2147217396
+' https://www.experts-exchange.com/questions/28960655/after-upgrade-to-windows-10-vba-dataobject-putinclipboard-stops-working.html
+
+Private Declare PtrSafe Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
+Private Declare PtrSafe Function EmptyClipboard Lib "user32.dll" () As Long
+Private Declare PtrSafe Function CloseClipboard Lib "user32.dll" () As Long
+Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
+Private Declare PtrSafe Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
+Private Declare PtrSafe Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As LongPtr) As Long
+Private Declare PtrSafe Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPtr
+Private Declare PtrSafe Function GlobalLock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
+Private Declare PtrSafe Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As LongPtr) As LongPtr
+Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
+Private Declare PtrSafe Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As LongPtr, ByVal lpString2 As LongPtr) As Long
+
+Public Sub SetClipboard(sUniText As String)
+    Dim iStrPtr As LongPtr
+    Dim iLen As Long
+    Dim iLock As LongPtr
+    Const GMEM_MOVEABLE As Long = &H2
+    Const GMEM_ZEROINIT As Long = &H40
+    Const CF_UNICODETEXT As Long = &HD
+    OpenClipboard 0&
+    EmptyClipboard
+    iLen = LenB(sUniText) + 2&
+    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
+    iLock = GlobalLock(iStrPtr)
+    lstrcpy iLock, StrPtr(sUniText)
+    GlobalUnlock iStrPtr
+    SetClipboardData CF_UNICODETEXT, iStrPtr
+    CloseClipboard
+End Sub
+
+Public Function GetClipboard() As String
+    Dim iStrPtr As LongPtr
+    Dim iLen As Long
+    Dim iLock As LongPtr
+    Dim sUniText As String
+    Const CF_UNICODETEXT As Long = 13&
+    OpenClipboard 0&
+    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
+        iStrPtr = GetClipboardData(CF_UNICODETEXT)
+        If iStrPtr Then
+            iLock = GlobalLock(iStrPtr)
+            iLen = CLng(GlobalSize(iStrPtr)) ' GlobalSize returns a Long Long (LongPtr) so cast to Long
+            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
+            lstrcpy StrPtr(sUniText), iLock
+            GlobalUnlock iStrPtr
+        End If
+        GetClipboard = sUniText
+    End If
+    CloseClipboard
+End Function
+

src/ClipboardUtils.bas

@@ -0,0 +1,183 @@
+Attribute VB_Name = "Functions"
+Option Explicit
+
+
+'from https://stackoverflow.com/questions/62172551/error-with-createpipe-in-vba-office-64bit
+
+
+Public Declare PtrSafe Function CreatePipe Lib "kernel32" ( _
+    phReadPipe As LongPtr, _
+    phWritePipe As LongPtr, _
+    lpPipeAttributes As SECURITY_ATTRIBUTES, _
+    ByVal nSize As Long) As Long
+
+Public Declare PtrSafe Function ReadFile Lib "kernel32" ( _
+    ByVal hFile As LongPtr, _
+    ByVal lpBuffer As String, _
+    ByVal nNumberOfBytesToRead As Long, _
+    lpNumberOfBytesRead As Long, _
+    ByVal lpOverlapped As Any) As Long
+
+Public Declare PtrSafe Function CreateProcessA Lib "kernel32" ( _
+    ByVal lpApplicationName As Long, _
+    ByVal lpCommandLine As String, _
+    lpProcessAttributes As Any, _
+    lpThreadAttributes As Any, _
+    ByVal bInheritHandles As Long, _
+    ByVal dwCreationFlags As Long, _
+    ByVal lpEnvironment As Long, _
+    ByVal lpCurrentDirectory As Long, _
+    lpStartupInfo As Any, _
+    lpProcessInformation As Any) As Long
+
+Public Declare PtrSafe Function CloseHandle Lib "kernel32" ( _
+    ByVal hObject As LongPtr) As Long
+
+Public Declare PtrSafe Function PeekNamedPipe Lib "kernel32" ( _
+    ByVal hNamedPipe As LongPtr, _
+    lpBuffer As Any, _
+    ByVal nBufferSize As Long, _
+    lpBytesRead As Long, _
+    lpTotalBytesAvail As Long, _
+    lpBytesLeftThisMessage As Long) As Long
+
+
+Declare PtrSafe Function WriteFile Lib "kernel32" ( _
+    ByVal hFile As LongPtr, _
+    ByRef lpBuffer As Any, _
+    ByVal nNumberOfBytesToWrite As Long, _
+    ByRef lpNumberOfBytesWritten As Long, _
+    lpOverlapped As Long) As Long
+
+Public Type SECURITY_ATTRIBUTES
+    nLength As Long
+    lpSecurityDescriptor As LongPtr
+    bInheritHandle As Long
+End Type
+
+
+Public Type STARTUPINFO
+    cb As Long
+    lpReserved As LongPtr
+    lpDesktop As LongPtr
+    lpTitle As LongPtr
+    dwX As Long
+    dwY As Long
+    dwXSize As Long
+    dwYSize As Long
+    dwXCountChars As Long
+    dwYCountChars As Long
+    dwFillAttribute As Long
+    dwFlags As Long
+    wShowWindow As Integer
+    cbReserved2 As Integer
+    lpReserved2 As LongPtr
+    hStdInput As LongPtr
+    hStdOutput As LongPtr
+    hStdError As LongPtr
+End Type
+
+'this is the structure to pass more than 3 fds to a child process
+
+'see https://github.com/libuv/libuv/blob/v1.x/src/win/process-stdio.c
+Public Type STDIO_BUFFER
+    number_of_fds As Long
+    crt_flags(0 To 4) As Byte
+    os_handle(0 To 4) As LongPtr
+End Type
+
+' the fields crt_flags and os_handle must lie contigously in memory
+' i.e. should not be aligned to byte boundaries
+' you cannot define a packed struct in VBA
+' thats why we need to have a second struct
+
+#If Win64 Then
+Public Type STDIO_BUFFER2
+    number_of_fds As Long
+    raw_bytes(0 To 44) As Byte
+End Type
+#Else
+Public Type STDIO_BUFFER2
+    number_of_fds As Long
+    raw_bytes(0 To 24) As Byte
+End Type
+#End If
+
+Public Type PROCESS_INFORMATION
+    hProcess As LongPtr
+    hThread As LongPtr
+    dwProcessId As Long
+    dwThreadId As Long
+End Type
+
+Public Const STARTF_USESTDHANDLES = &H100&
+Public Const NORMAL_PRIORITY_CLASS = &H20&
+Public Const STARTF_USESHOWWINDOW As Long = &H1&
+
+' we need to move memory
+'Public Declare PtrSafe Function GetAddrOf Lib "kernel32" Alias "MulDiv" (ByVal nNumber As Any, ByVal nNumerator As Long, ByVal nDenominator As Long) As Long
+   ' This is the dummy function used to get the addres of a VB variable.
+
+Public Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, source As Any, ByVal Length As LongPtr)
+
+
+Private Declare PtrSafe Sub sleep2 Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
+
+'Custom sleep function
+'change sleep period if processing is not robust
+Public Const cnlngSleepPeriod As Long = 1000
+
+Public Sub Sleep(Optional dblFrac As Double = 1)
+    DoEvents
+    Call sleep2(cnlngSleepPeriod * dblFrac)
+    DoEvents
+End Sub
+
+
+' returns [current (Now)] time  as seconds since 1970, ie UnixTime
+Function UnixTime(Optional localDateTime As Variant) As Long
+    If IsMissing(localDateTime) Then
+        UnixTime = DateDiff("S", "1/1/1970", Now())
+    Else
+        UnixTime = DateDiff("S", "1/1/1970", CDate(localDateTime))
+    End If
+End Function
+
+
+' returns True if no process found or successfully terminated process; false or error or user cancels
+Function TerminateProcess(ByVal ProcessName As String, Optional ByVal PromptBefore As Boolean = False) As Boolean
+    On Error Resume Next ' for now ignore errors
+    Dim processFound As Boolean: processFound = False
+    Dim processes As Object
+    Dim process As Object
+
+    Set processes = getObject("winmgmts:").ExecQuery("SELECT * FROM win32_process")
+    
+    For Each process In processes
+        If process.name = ProcessName Then
+            processFound = True
+        
+            If PromptBefore Then
+                If MsgBox("Browser Automation requires that " & ProcessName & " be closed before initializing. " & vbCrLf & _
+                          "If you'll use Edge Automation routinely, it is suggested you use Chrome as your default browser. " & _
+                          "If you need help changing your default browser contact the macro administrator for assistance." & vbCrLf & vbCrLf & _
+                          "Click [OK] to terminate all Edge processes." & vbCrLf & _
+                          "Click [Cancel] to abort and ", vbOKCancel, "Edge Automation") = vbCancel Then
+                    'Abort runtime so user can finish up with their current Edge session(s)
+                    GoTo Cleanup ' returns False
+                End If
+            End If
+            
+            TerminateProcess = (process.Terminate = 0)
+            
+            Exit For
+        End If
+    Next
+
+Cleanup:
+    Set processes = Nothing
+    Set process = Nothing
+    TerminateProcess = TerminateProcess Or (Not processFound) ' successfully terminated process or no process found
+End Function
+
+