update,

2025-02-01 01:59:56 +08:00
parent b3da7aaef5
commit 8719fe58b8
310 changed files with 6332 additions and 0 deletions
--- a/task1/task1-ticket1/_ref/Excel/Examples/usage_download.bas
+++ b/task1/task1-ticket1/_ref/Excel/Examples/usage_download.bas
@@ -0,0 +1,378 @@
+Attribute VB_Name = "usage_download"
+
+Private Declare PtrSafe Function FindWindowExA Lib "user32.dll" ( _
+  ByVal hwndParent As LongPtr, _
+  ByVal hwndChildAfter As LongPtr, _
+  ByVal lpszClass As String, _
+  ByVal lpszWindow As String) As Long
+
+Private Declare PtrSafe Function PostMessageA Lib "user32.dll" ( _
+  ByVal hwnd As LongPtr, _
+  ByVal wMsg As LongPtr, _
+  ByVal wParam As LongPtr, _
+  ByVal lParama As LongPtr) As Long
+
+Private Declare PtrSafe Function GetWindowLongA Lib "user32.dll" ( _
+  ByVal hwnd As LongPtr, ByVal nIndex As Integer) As Long
+
+Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc.dll" ( _
+  ByVal hwnd As LongPtr, _
+  ByVal dwId As Long, _
+  ByRef riid As Any, _
+  ByRef ppvObject As IAccessible) As Long
+                                       
+Private Declare PtrSafe Function AccessibleChildren Lib "oleacc.dll" ( _
+  ByVal paccContainer As IAccessible, _
+  ByVal iChildStart As Long, _
+  ByVal cChildren As Long, _
+  ByRef rgvarChildren As Variant, _
+  ByRef pcObtained As Long) As Long
+
+
+
+
+''
+' Downloads the link defined in the href attribute of a web element
+''
+Private Sub Usage_Download_StaticLink()
+  Dim driver As New IEDriver, ele As WebElement
+  driver.Get "https://www.mozilla.org/en-US/foundation/documents"
+  
+  Set ele = driver.FindElementByLinkText("IRS Form 872-C")
+  Download_StaticLink ele, ThisWorkbook.Path & "\irs-form-872-c_1.pdf"
+  
+  driver.Quit
+End Sub
+
+
+''
+' Downloads a file with IE and waits for completion
+''
+Private Sub Download_File_IE()
+  Dim driver As New IEDriver, ele As WebElement
+  driver.Get "https://www.mozilla.org/en-US/foundation/documents"
+  
+  Dim filePath As String
+  driver.FindElementByLinkText("IRS Form 872-C").ExecuteScript "this.click()"
+  filePath = DownloadFileSyncIE(ThisWorkbook.Path)
+  
+  driver.Quit
+End Sub
+
+
+''
+' Downloads a file with IE without waiting for completion
+''
+Private Sub Download_File_Asynchrone_IE()
+  Dim driver As New IEDriver, ele As WebElement
+  driver.Get "https://www.mozilla.org/en-US/foundation/documents"
+  
+  ' Init the file waiter
+  WaitNewFile ThisWorkbook.Path & "\*.pdf"
+  
+  driver.FindElementByLinkText("IRS Form 872-C").ExecuteScript "this.click()"
+  DownloadFileAsyncIE ThisWorkbook.Path
+  
+  ' Waits for a new file
+  file = WaitNewFile()
+  
+  Debug.Assert 0
+  driver.Quit
+End Sub
+
+''
+' Sets the download folder with Firefox
+''
+Private Sub Download_File_Firefox()
+  Dim driver As New ChromeDriver, file As String
+  
+  'Set the preferences specific to Firefox
+  driver.SetPreference "browser.download.folderList", 2
+  driver.SetPreference "browser.download.dir", ThisWorkbook.Path
+  driver.SetPreference "browser.helperApps.neverAsk.saveToDisk", "application/pdf"
+  driver.SetPreference "pdfjs.disabled", True
+  
+  ' Init the file waiter
+  WaitNewFile ThisWorkbook.Path & "\*.pdf"
+  
+  ' Open the file for download
+  driver.Get "https://www.mozilla.org/en-US/foundation/documents"
+  driver.FindElementByLinkText("IRS Form 872-C").Click
+  
+  ' Waits for a new file
+  file = WaitNewFile()
+  
+  'Stop the browser
+  driver.Quit
+End Sub
+
+''
+' Sets the download folder with Chrome
+''
+Private Sub Download_File_Chrome()
+  Dim driver As New ChromeDriver, file As String
+  
+  'Set the preferences specific to Chrome
+  driver.SetPreference "download.default_directory", ThisWorkbook.Path
+  driver.SetPreference "download.directory_upgrade", True
+  driver.SetPreference "download.prompt_for_download", False
+  driver.SetPreference "plugins.plugins_disabled", Array("Chrome PDF Viewer")
+  
+  ' Init the file waiter
+  WaitNewFile ThisWorkbook.Path & "\*.pdf"
+  
+  'Open the file for download
+  driver.Get "https://www.mozilla.org/en-US/foundation/documents"
+  driver.FindElementByLinkText("IRS Form 872-C").Click
+  
+  ' Waits for a new file
+  file = WaitNewFile()
+  
+  'Stop the browser
+  Debug.Assert 0
+  driver.Quit
+End Sub
+
+
+
+
+
+' ### HELPERS FUNCTIONS ###
+
+''
+' Saves the file pointed by the href attribute : <a href="/doc.pdf">Document</a>
+' @element {WebElement} Web element with the href link
+' @save_as {String}  Path were the file is to be saved
+''
+Private Sub Download_StaticLink(element As WebElement, save_as As String)
+  ' Extract the data to build the request (link, user-agent, language, cookie)
+  Dim info As Selenium.Dictionary
+  Set info = element.ExecuteScript("return {" & _
+    "link: this.href," & _
+    "agent: navigator.userAgent," & _
+    "lang: navigator.userLanguage," & _
+    "cookie: document.cookie };")
+  
+  ' Send the request
+  Static xhr As Object
+  If xhr Is Nothing Then Set xhr = CreateObject("Msxml2.ServerXMLHTTP.6.0")
+  xhr.Open "GET", info("link")
+  xhr.setRequestHeader "User-Agent", info("agent")
+  xhr.setRequestHeader "Accept-Language", info("lang")
+  xhr.setRequestHeader "Cookie", info("cookie")
+  xhr.Send
+  If (xhr.Status \ 100) - 2 Then Err.Raise 5, , xhr.Status & " " & xhr.StatusText
+  
+  ' Save the response to a file
+  Static bin As Object
+  If bin Is Nothing Then Set bin = CreateObject("ADODB.Stream")
+  If Len(Dir$(save_as)) Then Kill save_as
+  bin.Open
+  bin.Type = 1
+  bin.Write xhr.ResponseBody
+  bin.Position = 0
+  bin.SaveToFile save_as
+  bin.Close
+End Sub
+
+
+''
+' Waits for a new file to be created in a folder
+' @folder {String}  Folder where the file will be created
+' Usage:
+'   WaitNewFile "C:\download\*.pdf"
+'   ' The new file is created here
+'   filename = WaitNewFile()
+''
+Public Function WaitNewFile(Optional target As String) As String
+  Static files As Collection, filter$
+  Dim file$, file_path$, i&
+  If Len(target) Then
+    ' Initialize the list of files and return
+    filter = target
+    Set files = New Collection
+    file = Dir(filter, vbNormal)
+    Do While Len(file)
+      files.Add Empty, file
+      file = Dir
+    Loop
+    Exit Function
+  End If
+  
+  ' Waits for a file that is not in the list
+  On Error GoTo WaitReady
+  Do
+    file = Dir(filter, vbNormal)
+    Do While Len(file)
+      files.Item file
+      file = Dir
+    Loop
+    For i = 0 To 3000: DoEvents: Next
+  Loop
+  
+WaitReady:
+  ' Waits for the size to be superior to 0 and try to rename it
+  file_path = Left$(filter, InStrRev(filter, "\")) & file
+  Do
+    If FileLen(file_path) Then
+      On Error Resume Next
+      Name file_path As file_path
+      If Err = 0 Then Exit Do
+    End If
+    For i = 0 To 3000: DoEvents: Next
+  Loop
+  files.Add Empty, file
+  WaitNewFile = file_path
+End Function
+
+
+''
+' Saves the file from the download dialogue, waits for completion and returns the path
+' @save_as: folder or file path
+''
+Private Function DownloadFileSyncIE(ByVal save_as As String) As String
+  Const dl_key = "HKCU\Software\Microsoft\Internet Explorer\Main\Default Download Directory"
+  
+  Static shl As Object, Waiter As New Waiter
+  If shl Is Nothing Then
+    Set shl = CreateObject("WScript.Shell")
+    shl.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\NotifyDownloadComplete", "no", "REG_SZ"
+    shl.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_RESTRICT_FILEDOWNLOAD\iexplore.exe", 0, "REG_DWORD"
+  End If
+  
+  Dim ie_hwnd, frm_hwnd, endtime#, i&, n&, folder_bak$, file_name$
+  
+  ' wait for the download dialogue (IEFrame/Frame Notification Bar/DirectUIHWND)
+  ie_hwnd = FindWindowExA(0, 0, "IEFrame", vbNullString)
+  endtime = Now + 5000 / 86400#
+  Do
+    frm_hwnd = FindWindowExA(ie_hwnd, 0, "Frame Notification Bar", vbNullString)
+    If frm_hwnd Then
+      If GetWindowLongA(frm_hwnd, -16) And &H10000000 Then Exit Do ' If visible
+    End If
+    If Now > endtime Then Err.Raise 5, , "Failed to find the download dialog"
+    Waiter.Wait 100
+  Loop
+  
+  ' save the download folder path and create a temporary folder
+  tmp_dir = Environ$("TEMP") & "\dl-ie-4f521"
+  On Error Resume Next
+  folder_bak = shl.RegRead(dl_key)
+  MkDir tmp_dir
+  Kill tmp_dir & "\*"
+  On Error GoTo 0
+  
+  ' set the download folder in the registry
+  shl.RegWrite dl_key, tmp_dir, "REG_SZ"
+  
+  ' send the shortcut for Save (Alt + S)
+  Waiter.Wait 500
+  PostMessageA ie_hwnd, &H104&, &H12, &H20000001  'WM_SYSKEYDOWN, VK_MENU
+  PostMessageA ie_hwnd, &H104&, &H53, &H20000001  'WM_SYSKEYDOWN, S
+  PostMessageA ie_hwnd, &H105&, &H53, &HC0000001  'WM_SYSKEYUP, S
+  PostMessageA ie_hwnd, &H101&, &H12, &HC0000001  'WM_KEYUP, VK_MENU
+  
+  ' wait for the file to be downloaded
+  Do
+    Waiter.Wait 100
+    file_name = VBA.Dir$(tmp_dir & "\*")
+  Loop While InStr(Len(file_name) - 8, file_name, ".partial") Or Len(file_name) = 0
+  
+  ' restore the download folder in the registry
+  If folder_bak = Empty Then
+    shl.RegDelete dl_key
+  Else
+    shl.RegWrite dl_key, folder_bak, "REG_SZ"
+  End If
+  
+  ' delete existing file
+  If Len(VBA.Dir$(save_as, vbNormal)) Then Kill save_as
+  If Len(VBA.Dir$(save_as, vbDirectory)) Then
+    save_as = save_as & "\" & file_name
+    If Len(VBA.Dir$(save_as, vbNormal)) Then Kill save_as
+  End If
+  
+  ' move the file to the provided path
+  Name tmp_dir & "\" & file_name As save_as
+  DownloadFileSyncIE = save_as
+End Function
+
+''
+' Saves the file from the download dialogue without waiting for completion
+' @folder: download folder
+''
+Private Sub DownloadFileAsyncIE(folder As String)
+  Const timeout = 5000, bt_save = "Save", bt_close = "Close"
+  Const dl_key = "HKCU\Software\Microsoft\Internet Explorer\Main\Default Download Directory"
+  
+  Static shl As Object, Waiter As New Waiter
+  If shl Is Nothing Then
+    Set shl = CreateObject("WScript.Shell")
+    shl.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\NotifyDownloadComplete", "no", "REG_SZ"
+    shl.RegWrite "HKCU\Software\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_RESTRICT_FILEDOWNLOAD\iexplore.exe", 0, "REG_DWORD"
+  End If
+  
+  ' wait for the download dialog (IEFrame/Frame Notification Bar/DirectUIHWND)
+  Dim ie_hwnd, frm_hwnd, dlg_hwnd, endtime#, folder_bak$, i&
+  ie_hwnd = FindWindowExA(0, 0, "IEFrame", vbNullString)
+  endtime = Now + timeout / 86400#
+  Do
+    frm_hwnd = FindWindowExA(ie_hwnd, 0, "Frame Notification Bar", vbNullString)
+    If frm_hwnd Then
+      If GetWindowLongA(frm_hwnd, -16) And &H10000000 Then Exit Do  ' If visible
+    End If
+    If Now > endtime Then Err.Raise 5, , "Failed to find the download dialog"
+    For i = 1 To 5000: DoEvents: Next
+  Loop
+  
+  ' get the save button
+  Dim acc As IAccessible, bt As IAccessible
+  dlg_hwnd = FindWindowExA(frm_hwnd, 0, "DirectUIHWND", vbNullString)
+  Set acc = acc_from_window(dlg_hwnd)
+  Set bt = acc_find_button(acc, bt_save)
+  If bt Is Nothing Then Err.Raise 5, , "Failed to find the Save button"
+  
+  ' save and set the download folder in the registry
+  On Error Resume Next
+  folder_bak = shl.RegRead(dl_key)
+  On Error GoTo 0
+  shl.RegWrite dl_key, folder, "REG_SZ"
+  
+  ' click on Save
+  Waiter.Wait 500
+  bt.accDoDefaultAction 0&
+  Waiter.Wait 100
+  
+  ' restore the download folder in the registry
+  If folder_bak = Empty Then
+    shl.RegDelete dl_key
+  Else
+    shl.RegWrite dl_key, folder_bak, "REG_SZ"
+  End If
+End Sub
+
+  
+Private Function acc_from_window(hwnd) As IAccessible
+  Dim iid&(0 To 3)
+  iid(0) = &H618736E0 ' IAccessible interface
+  iid(1) = &H11CF3C3D
+  iid(2) = &HAA000C81
+  iid(3) = &H719B3800
+  AccessibleObjectFromWindow hwnd, 0&, iid(0), acc_from_window
+End Function
+
+Private Function acc_find_button(ByVal acc As IAccessible, name$) As IAccessible
+  If acc.accName(0&) Like name Then
+    Set acc_find_button = acc
+  ElseIf acc.accChildCount > 0 Then
+    Dim children(0 To 20), count&, i&
+    AccessibleChildren acc, 0, acc.accChildCount, children(0), count
+    For i = 0 To count - 1
+      If VBA.IsObject(children(i)) Then
+        Set acc_find_button = acc_find_button(children(i), name)
+        If Not acc_find_button Is Nothing Then Exit For
+      End If
+    Next
+  End If
+End Function
+