diff --git a/Example.bas b/Example.bas new file mode 100755 index 0000000..dd853da --- /dev/null +++ b/Example.bas @@ -0,0 +1,80 @@ +Attribute VB_Name = "Example" +' TinySeleniumVBA +' A tiny Selenium wrapper written in pure VBA +' +' (c)2021 uezo +' +' Mail: uezo@uezo.net +' Twitter: @uezochan +' https://github.com/uezo/TinySeleniumVBA +' +' ========================================================================== +' セットアップ +' +' 1. ツール＞参照設定で`Microsoft Scripting Runtime`をオンにする +' +' 2. WebDriver.cls, WebElement.cls JsonConverter.bas をプロジェクトに追加 +' +' 3. WebDriverをダウンロード（ブラウザのメジャーバージョンと同じもの） +' - Edge: https://developer.microsoft.com/ja-jp/microsoft-edge/tools/webdriver/ +' - Chrome: https://chromedriver.chromium.org/downloads +' +' 使い方 +' `WebDriver`のインスタンスをダウンロードしたWebDriverを使って生成します。 +' そこから先は下のExampleを参照ください。 +' ========================================================================== + +' ========================================================================== +' Setup +' +' 1. Set reference to `Microsoft Scripting Runtime` +' +' 2. Add WebDriver.cls, WebElement.cls and JsonConverter.bas to your VBA Project +' +' 3. Download WebDriver (driver and browser should be the same version) +' - Edge: https://developer.microsoft.com/ja-jp/microsoft-edge/tools/webdriver/ +' - Chrome: https://chromedriver.chromium.org/downloads +' +' Usase +' Create instance of `WebDriver` with the path to the driver you download. +' See also the example below. +' ========================================================================== + + +' ========================================================================== +' Example +' ========================================================================== +Option Explicit + +Public Sub main() + ' Start WebDriver (Edge) + Dim Driver As New WebDriver + Driver.Edge "path\to\msedgedriver.exe" + + ' Open browser + Driver.OpenBrowser + + ' Navigate to Google + Driver.Navigate "https://www.google.co.jp/?q=selenium" + + ' Get search textbox + Dim searchInput + Set searchInput = Driver.FindElement(By.Name, "q") + + ' Get value from textbox + Debug.Print searchInput.GetValue + + ' Set value to textbox + searchInput.SetValue "yomoda soba" + + ' Click search button + Driver.FindElement(By.Name, "btnK").Click + + ' Refresh - you can use Execute with driver command even if the method is not provided + Driver.Execute Driver.CMD_REFRESH +End Sub + + + + + diff --git a/JsonConverter.bas b/JsonConverter.bas new file mode 100755 index 0000000..5b93df3 --- /dev/null +++ b/JsonConverter.bas @@ -0,0 +1,1124 @@ +Attribute VB_Name = "JsonConverter" +'' +' VBA-JSON v2.3.1 +' (c) Tim Hall - https://github.com/VBA-tools/VBA-JSON +' +' JSON Converter for VBA +' +' Errors: +' 10001 - JSON parse error +' +' @class JsonConverter +' @author tim.hall.engr@gmail.com +' @license MIT (http://www.opensource.org/licenses/mit-license.php) +'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +' +' Based originally on vba-json (with extensive changes) +' BSD license included below +' +' JSONLib, http://code.google.com/p/vba-json/ +' +' Copyright (c) 2013, Ryo Yokoyama +' All rights reserved. +' +' Redistribution and use in source and binary forms, with or without +' modification, are permitted provided that the following conditions are met: +' * Redistributions of source code must retain the above copyright +' notice, this list of conditions and the following disclaimer. +' * Redistributions in binary form must reproduce the above copyright +' notice, this list of conditions and the following disclaimer in the +' documentation and/or other materials provided with the distribution. +' * Neither the name of the nor the +' names of its contributors may be used to endorse or promote products +' derived from this software without specific prior written permission. +' +' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +' ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +' WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +' DISCLAIMED. IN NO EVENT SHALL BE LIABLE FOR ANY +' DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +' (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +' LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +' ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +' (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +' SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' +Option Explicit + +' === VBA-UTC Headers +#If Mac Then + +#If VBA7 Then + +' 64-bit Mac (2016) +Private Declare PtrSafe Function utc_popen Lib "/usr/lib/libc.dylib" Alias "popen" _ + (ByVal utc_Command As String, ByVal utc_Mode As String) As LongPtr +Private Declare PtrSafe Function utc_pclose Lib "/usr/lib/libc.dylib" Alias "pclose" _ + (ByVal utc_File As LongPtr) As LongPtr +Private Declare PtrSafe Function utc_fread Lib "/usr/lib/libc.dylib" Alias "fread" _ + (ByVal utc_Buffer As String, ByVal utc_Size As LongPtr, ByVal utc_Number As LongPtr, ByVal utc_File As LongPtr) As LongPtr +Private Declare PtrSafe Function utc_feof Lib "/usr/lib/libc.dylib" Alias "feof" _ + (ByVal utc_File As LongPtr) As LongPtr + +#Else + +' 32-bit Mac +Private Declare Function utc_popen Lib "libc.dylib" Alias "popen" _ + (ByVal utc_Command As String, ByVal utc_Mode As String) As Long +Private Declare Function utc_pclose Lib "libc.dylib" Alias "pclose" _ + (ByVal utc_File As Long) As Long +Private Declare Function utc_fread Lib "libc.dylib" Alias "fread" _ + (ByVal utc_Buffer As String, ByVal utc_Size As Long, ByVal utc_Number As Long, ByVal utc_File As Long) As Long +Private Declare Function utc_feof Lib "libc.dylib" Alias "feof" _ + (ByVal utc_File As Long) As Long + +#End If + +#ElseIf VBA7 Then + +' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724421.aspx +' http://msdn.microsoft.com/en-us/library/windows/desktop/ms724949.aspx +' http://msdn.microsoft.com/en-us/library/windows/desktop/ms725485.aspx +Private Declare PtrSafe Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long +Private Declare PtrSafe Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long +Private Declare PtrSafe Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long + +#Else + +Private Declare Function utc_GetTimeZoneInformation Lib "kernel32" Alias "GetTimeZoneInformation" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION) As Long +Private Declare Function utc_SystemTimeToTzSpecificLocalTime Lib "kernel32" Alias "SystemTimeToTzSpecificLocalTime" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpUniversalTime As utc_SYSTEMTIME, utc_lpLocalTime As utc_SYSTEMTIME) As Long +Private Declare Function utc_TzSpecificLocalTimeToSystemTime Lib "kernel32" Alias "TzSpecificLocalTimeToSystemTime" _ + (utc_lpTimeZoneInformation As utc_TIME_ZONE_INFORMATION, utc_lpLocalTime As utc_SYSTEMTIME, utc_lpUniversalTime As utc_SYSTEMTIME) As Long + +#End If + +#If Mac Then + +#If VBA7 Then +Private Type utc_ShellResult + utc_Output As String + utc_ExitCode As LongPtr +End Type + +#Else + +Private Type utc_ShellResult + utc_Output As String + utc_ExitCode As Long +End Type + +#End If + +#Else + +Private Type utc_SYSTEMTIME + utc_wYear As Integer + utc_wMonth As Integer + utc_wDayOfWeek As Integer + utc_wDay As Integer + utc_wHour As Integer + utc_wMinute As Integer + utc_wSecond As Integer + utc_wMilliseconds As Integer +End Type + +Private Type utc_TIME_ZONE_INFORMATION + utc_Bias As Long + utc_StandardName(0 To 31) As Integer + utc_StandardDate As utc_SYSTEMTIME + utc_StandardBias As Long + utc_DaylightName(0 To 31) As Integer + utc_DaylightDate As utc_SYSTEMTIME + utc_DaylightBias As Long +End Type + +#End If +' === End VBA-UTC + +Private Type json_Options + ' VBA only stores 15 significant digits, so any numbers larger than that are truncated + ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits + ' See: http://support.microsoft.com/kb/269370 + ' + ' By default, VBA-JSON will use String for numbers longer than 15 characters that contain only digits + ' to override set `JsonConverter.JsonOptions.UseDoubleForLargeNumbers = True` + UseDoubleForLargeNumbers As Boolean + + ' The JSON standard requires object keys to be quoted (" or '), use this option to allow unquoted keys + AllowUnquotedKeys As Boolean + + ' The solidus (/) is not required to be escaped, use this option to escape them as \/ in ConvertToJson + EscapeSolidus As Boolean +End Type +Public JsonOptions As json_Options + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Convert JSON string to object (Dictionary/Collection) +' +' @method ParseJson +' @param {String} json_String +' @return {Object} (Dictionary or Collection) +' @throws 10001 - JSON parse error +'' +Public Function ParseJson(ByVal JsonString As String) As Object + Dim json_Index As Long + json_Index = 1 + + ' Remove vbCr, vbLf, and vbTab from json_String + JsonString = VBA.Replace(VBA.Replace(VBA.Replace(JsonString, VBA.vbCr, ""), VBA.vbLf, ""), VBA.vbTab, "") + + json_SkipSpaces JsonString, json_Index + Select Case VBA.Mid$(JsonString, json_Index, 1) + Case "{" + Set ParseJson = json_ParseObject(JsonString, json_Index) + Case "[" + Set ParseJson = json_ParseArray(JsonString, json_Index) + Case Else + ' Error: Invalid JSON string + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['") + End Select +End Function + +'' +' Convert object (Dictionary/Collection/Array) to JSON +' +' @method ConvertToJson +' @param {Variant} JsonValue (Dictionary, Collection, or Array) +' @param {Integer|String} Whitespace "Pretty" print json with given number of spaces per indentation (Integer) or given string +' @return {String} +'' +Public Function ConvertToJson(ByVal JsonValue As Variant, Optional ByVal Whitespace As Variant, Optional ByVal json_CurrentIndentation As Long = 0) As String + Dim json_Buffer As String + Dim json_BufferPosition As Long + Dim json_BufferLength As Long + Dim json_Index As Long + Dim json_LBound As Long + Dim json_UBound As Long + Dim json_IsFirstItem As Boolean + Dim json_Index2D As Long + Dim json_LBound2D As Long + Dim json_UBound2D As Long + Dim json_IsFirstItem2D As Boolean + Dim json_Key As Variant + Dim json_Value As Variant + Dim json_DateStr As String + Dim json_Converted As String + Dim json_SkipItem As Boolean + Dim json_PrettyPrint As Boolean + Dim json_Indentation As String + Dim json_InnerIndentation As String + + json_LBound = -1 + json_UBound = -1 + json_IsFirstItem = True + json_LBound2D = -1 + json_UBound2D = -1 + json_IsFirstItem2D = True + json_PrettyPrint = Not IsMissing(Whitespace) + + Select Case VBA.VarType(JsonValue) + Case VBA.vbNull + ConvertToJson = "null" + Case VBA.vbDate + ' Date + json_DateStr = ConvertToIso(VBA.CDate(JsonValue)) + + ConvertToJson = """" & json_DateStr & """" + Case VBA.vbString + ' String (or large number encoded as string) + If Not JsonOptions.UseDoubleForLargeNumbers And json_StringIsLargeNumber(JsonValue) Then + ConvertToJson = JsonValue + Else + ConvertToJson = """" & json_Encode(JsonValue) & """" + End If + Case VBA.vbBoolean + If JsonValue Then + ConvertToJson = "true" + Else + ConvertToJson = "false" + End If + Case VBA.vbArray To VBA.vbArray + VBA.vbByte + If json_PrettyPrint Then + If VBA.VarType(Whitespace) = VBA.vbString Then + json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) + json_InnerIndentation = VBA.String$(json_CurrentIndentation + 2, Whitespace) + Else + json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) + json_InnerIndentation = VBA.Space$((json_CurrentIndentation + 2) * Whitespace) + End If + End If + + ' Array + json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength + + On Error Resume Next + + json_LBound = LBound(JsonValue, 1) + json_UBound = UBound(JsonValue, 1) + json_LBound2D = LBound(JsonValue, 2) + json_UBound2D = UBound(JsonValue, 2) + + If json_LBound >= 0 And json_UBound >= 0 Then + For json_Index = json_LBound To json_UBound + If json_IsFirstItem Then + json_IsFirstItem = False + Else + ' Append comma to previous line + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength + End If + + If json_LBound2D >= 0 And json_UBound2D >= 0 Then + ' 2D Array + If json_PrettyPrint Then + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength + End If + json_BufferAppend json_Buffer, json_Indentation & "[", json_BufferPosition, json_BufferLength + + For json_Index2D = json_LBound2D To json_UBound2D + If json_IsFirstItem2D Then + json_IsFirstItem2D = False + Else + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength + End If + + json_Converted = ConvertToJson(JsonValue(json_Index, json_Index2D), Whitespace, json_CurrentIndentation + 2) + + ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null + If json_Converted = "" Then + ' (nest to only check if converted = "") + If json_IsUndefined(JsonValue(json_Index, json_Index2D)) Then + json_Converted = "null" + End If + End If + + If json_PrettyPrint Then + json_Converted = vbNewLine & json_InnerIndentation & json_Converted + End If + + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength + Next json_Index2D + + If json_PrettyPrint Then + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength + End If + + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + json_IsFirstItem2D = True + Else + ' 1D Array + json_Converted = ConvertToJson(JsonValue(json_Index), Whitespace, json_CurrentIndentation + 1) + + ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null + If json_Converted = "" Then + ' (nest to only check if converted = "") + If json_IsUndefined(JsonValue(json_Index)) Then + json_Converted = "null" + End If + End If + + If json_PrettyPrint Then + json_Converted = vbNewLine & json_Indentation & json_Converted + End If + + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength + End If + Next json_Index + End If + + On Error GoTo 0 + + If json_PrettyPrint Then + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength + + If VBA.VarType(Whitespace) = VBA.vbString Then + json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) + Else + json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) + End If + End If + + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + + ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) + + ' Dictionary or Collection + Case VBA.vbObject + If json_PrettyPrint Then + If VBA.VarType(Whitespace) = VBA.vbString Then + json_Indentation = VBA.String$(json_CurrentIndentation + 1, Whitespace) + Else + json_Indentation = VBA.Space$((json_CurrentIndentation + 1) * Whitespace) + End If + End If + + ' Dictionary + If VBA.TypeName(JsonValue) = "Dictionary" Then + json_BufferAppend json_Buffer, "{", json_BufferPosition, json_BufferLength + For Each json_Key In JsonValue.Keys + ' For Objects, undefined (Empty/Nothing) is not added to object + json_Converted = ConvertToJson(JsonValue(json_Key), Whitespace, json_CurrentIndentation + 1) + If json_Converted = "" Then + json_SkipItem = json_IsUndefined(JsonValue(json_Key)) + Else + json_SkipItem = False + End If + + If Not json_SkipItem Then + If json_IsFirstItem Then + json_IsFirstItem = False + Else + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength + End If + + If json_PrettyPrint Then + json_Converted = vbNewLine & json_Indentation & """" & json_Key & """: " & json_Converted + Else + json_Converted = """" & json_Key & """:" & json_Converted + End If + + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength + End If + Next json_Key + + If json_PrettyPrint Then + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength + + If VBA.VarType(Whitespace) = VBA.vbString Then + json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) + Else + json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) + End If + End If + + json_BufferAppend json_Buffer, json_Indentation & "}", json_BufferPosition, json_BufferLength + + ' Collection + ElseIf VBA.TypeName(JsonValue) = "Collection" Then + json_BufferAppend json_Buffer, "[", json_BufferPosition, json_BufferLength + For Each json_Value In JsonValue + If json_IsFirstItem Then + json_IsFirstItem = False + Else + json_BufferAppend json_Buffer, ",", json_BufferPosition, json_BufferLength + End If + + json_Converted = ConvertToJson(json_Value, Whitespace, json_CurrentIndentation + 1) + + ' For Arrays/Collections, undefined (Empty/Nothing) is treated as null + If json_Converted = "" Then + ' (nest to only check if converted = "") + If json_IsUndefined(json_Value) Then + json_Converted = "null" + End If + End If + + If json_PrettyPrint Then + json_Converted = vbNewLine & json_Indentation & json_Converted + End If + + json_BufferAppend json_Buffer, json_Converted, json_BufferPosition, json_BufferLength + Next json_Value + + If json_PrettyPrint Then + json_BufferAppend json_Buffer, vbNewLine, json_BufferPosition, json_BufferLength + + If VBA.VarType(Whitespace) = VBA.vbString Then + json_Indentation = VBA.String$(json_CurrentIndentation, Whitespace) + Else + json_Indentation = VBA.Space$(json_CurrentIndentation * Whitespace) + End If + End If + + json_BufferAppend json_Buffer, json_Indentation & "]", json_BufferPosition, json_BufferLength + End If + + ConvertToJson = json_BufferToString(json_Buffer, json_BufferPosition) + Case VBA.vbInteger, VBA.vbLong, VBA.vbSingle, VBA.vbDouble, VBA.vbCurrency, VBA.vbDecimal + ' Number (use decimals for numbers) + ConvertToJson = VBA.Replace(JsonValue, ",", ".") + Case Else + ' vbEmpty, vbError, vbDataObject, vbByte, vbUserDefinedType + ' Use VBA's built-in to-string + On Error Resume Next + ConvertToJson = JsonValue + On Error GoTo 0 + End Select +End Function + +' ============================================= ' +' Private Functions +' ============================================= ' + +Private Function json_ParseObject(json_String As String, ByRef json_Index As Long) As Dictionary + Dim json_Key As String + Dim json_NextChar As String + + Set json_ParseObject = New Dictionary + json_SkipSpaces json_String, json_Index + If VBA.Mid$(json_String, json_Index, 1) <> "{" Then + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '{'") + Else + json_Index = json_Index + 1 + + Do + json_SkipSpaces json_String, json_Index + If VBA.Mid$(json_String, json_Index, 1) = "}" Then + json_Index = json_Index + 1 + Exit Function + ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then + json_Index = json_Index + 1 + json_SkipSpaces json_String, json_Index + End If + + json_Key = json_ParseKey(json_String, json_Index) + json_NextChar = json_Peek(json_String, json_Index) + If json_NextChar = "[" Or json_NextChar = "{" Then + Set json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) + Else + json_ParseObject.Item(json_Key) = json_ParseValue(json_String, json_Index) + End If + Loop + End If +End Function + +Private Function json_ParseArray(json_String As String, ByRef json_Index As Long) As Collection + Set json_ParseArray = New Collection + + json_SkipSpaces json_String, json_Index + If VBA.Mid$(json_String, json_Index, 1) <> "[" Then + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '['") + Else + json_Index = json_Index + 1 + + Do + json_SkipSpaces json_String, json_Index + If VBA.Mid$(json_String, json_Index, 1) = "]" Then + json_Index = json_Index + 1 + Exit Function + ElseIf VBA.Mid$(json_String, json_Index, 1) = "," Then + json_Index = json_Index + 1 + json_SkipSpaces json_String, json_Index + End If + + json_ParseArray.Add json_ParseValue(json_String, json_Index) + Loop + End If +End Function + +Private Function json_ParseValue(json_String As String, ByRef json_Index As Long) As Variant + json_SkipSpaces json_String, json_Index + Select Case VBA.Mid$(json_String, json_Index, 1) + Case "{" + Set json_ParseValue = json_ParseObject(json_String, json_Index) + Case "[" + Set json_ParseValue = json_ParseArray(json_String, json_Index) + Case """", "'" + json_ParseValue = json_ParseString(json_String, json_Index) + Case Else + If VBA.Mid$(json_String, json_Index, 4) = "true" Then + json_ParseValue = True + json_Index = json_Index + 4 + ElseIf VBA.Mid$(json_String, json_Index, 5) = "false" Then + json_ParseValue = False + json_Index = json_Index + 5 + ElseIf VBA.Mid$(json_String, json_Index, 4) = "null" Then + json_ParseValue = Null + json_Index = json_Index + 4 + ElseIf VBA.InStr("+-0123456789", VBA.Mid$(json_String, json_Index, 1)) Then + json_ParseValue = json_ParseNumber(json_String, json_Index) + Else + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting 'STRING', 'NUMBER', null, true, false, '{', or '['") + End If + End Select +End Function + +Private Function json_ParseString(json_String As String, ByRef json_Index As Long) As String + Dim json_Quote As String + Dim json_Char As String + Dim json_Code As String + Dim json_Buffer As String + Dim json_BufferPosition As Long + Dim json_BufferLength As Long + + json_SkipSpaces json_String, json_Index + + ' Store opening quote to look for matching closing quote + json_Quote = VBA.Mid$(json_String, json_Index, 1) + json_Index = json_Index + 1 + + Do While json_Index > 0 And json_Index <= Len(json_String) + json_Char = VBA.Mid$(json_String, json_Index, 1) + + Select Case json_Char + Case "\" + ' Escaped string, \\, or \/ + json_Index = json_Index + 1 + json_Char = VBA.Mid$(json_String, json_Index, 1) + + Select Case json_Char + Case """", "\", "/", "'" + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "b" + json_BufferAppend json_Buffer, vbBack, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "f" + json_BufferAppend json_Buffer, vbFormFeed, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "n" + json_BufferAppend json_Buffer, vbCrLf, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "r" + json_BufferAppend json_Buffer, vbCr, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "t" + json_BufferAppend json_Buffer, vbTab, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + Case "u" + ' Unicode character escape (e.g. \u00a9 = Copyright) + json_Index = json_Index + 1 + json_Code = VBA.Mid$(json_String, json_Index, 4) + json_BufferAppend json_Buffer, VBA.ChrW(VBA.Val("&h" + json_Code)), json_BufferPosition, json_BufferLength + json_Index = json_Index + 4 + End Select + Case json_Quote + json_ParseString = json_BufferToString(json_Buffer, json_BufferPosition) + json_Index = json_Index + 1 + Exit Function + Case Else + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength + json_Index = json_Index + 1 + End Select + Loop +End Function + +Private Function json_ParseNumber(json_String As String, ByRef json_Index As Long) As Variant + Dim json_Char As String + Dim json_Value As String + Dim json_IsLargeNumber As Boolean + + json_SkipSpaces json_String, json_Index + + Do While json_Index > 0 And json_Index <= Len(json_String) + json_Char = VBA.Mid$(json_String, json_Index, 1) + + If VBA.InStr("+-0123456789.eE", json_Char) Then + ' Unlikely to have massive number, so use simple append rather than buffer here + json_Value = json_Value & json_Char + json_Index = json_Index + 1 + Else + ' Excel only stores 15 significant digits, so any numbers larger than that are truncated + ' This can lead to issues when BIGINT's are used (e.g. for Ids or Credit Cards), as they will be invalid above 15 digits + ' See: http://support.microsoft.com/kb/269370 + ' + ' Fix: Parse -> String, Convert -> String longer than 15/16 characters containing only numbers and decimal points -> Number + ' (decimal doesn't factor into significant digit count, so if present check for 15 digits + decimal = 16) + json_IsLargeNumber = IIf(InStr(json_Value, "."), Len(json_Value) >= 17, Len(json_Value) >= 16) + If Not JsonOptions.UseDoubleForLargeNumbers And json_IsLargeNumber Then + json_ParseNumber = json_Value + Else + ' VBA.Val does not use regional settings, so guard for comma is not needed + json_ParseNumber = VBA.Val(json_Value) + End If + Exit Function + End If + Loop +End Function + +Private Function json_ParseKey(json_String As String, ByRef json_Index As Long) As String + ' Parse key with single or double quotes + If VBA.Mid$(json_String, json_Index, 1) = """" Or VBA.Mid$(json_String, json_Index, 1) = "'" Then + json_ParseKey = json_ParseString(json_String, json_Index) + ElseIf JsonOptions.AllowUnquotedKeys Then + Dim json_Char As String + Do While json_Index > 0 And json_Index <= Len(json_String) + json_Char = VBA.Mid$(json_String, json_Index, 1) + If (json_Char <> " ") And (json_Char <> ":") Then + json_ParseKey = json_ParseKey & json_Char + json_Index = json_Index + 1 + Else + Exit Do + End If + Loop + Else + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting '""' or '''") + End If + + ' Check for colon and skip if present or throw if not present + json_SkipSpaces json_String, json_Index + If VBA.Mid$(json_String, json_Index, 1) <> ":" Then + Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(json_String, json_Index, "Expecting ':'") + Else + json_Index = json_Index + 1 + End If +End Function + +Private Function json_IsUndefined(ByVal json_Value As Variant) As Boolean + ' Empty / Nothing -> undefined + Select Case VBA.VarType(json_Value) + Case VBA.vbEmpty + json_IsUndefined = True + Case VBA.vbObject + Select Case VBA.TypeName(json_Value) + Case "Empty", "Nothing" + json_IsUndefined = True + End Select + End Select +End Function + +Private Function json_Encode(ByVal json_Text As Variant) As String + ' Reference: http://www.ietf.org/rfc/rfc4627.txt + ' Escape: ", \, /, backspace, form feed, line feed, carriage return, tab + Dim json_Index As Long + Dim json_Char As String + Dim json_AscCode As Long + Dim json_Buffer As String + Dim json_BufferPosition As Long + Dim json_BufferLength As Long + + For json_Index = 1 To VBA.Len(json_Text) + json_Char = VBA.Mid$(json_Text, json_Index, 1) + json_AscCode = VBA.AscW(json_Char) + + ' When AscW returns a negative number, it returns the twos complement form of that number. + ' To convert the twos complement notation into normal binary notation, add 0xFFF to the return result. + ' https://support.microsoft.com/en-us/kb/272138 + If json_AscCode < 0 Then + json_AscCode = json_AscCode + 65536 + End If + + ' From spec, ", \, and control characters must be escaped (solidus is optional) + + Select Case json_AscCode + Case 34 + ' " -> 34 -> \" + json_Char = "\""" + Case 92 + ' \ -> 92 -> \\ + json_Char = "\\" + Case 47 + ' / -> 47 -> \/ (optional) + If JsonOptions.EscapeSolidus Then + json_Char = "\/" + End If + Case 8 + ' backspace -> 8 -> \b + json_Char = "\b" + Case 12 + ' form feed -> 12 -> \f + json_Char = "\f" + Case 10 + ' line feed -> 10 -> \n + json_Char = "\n" + Case 13 + ' carriage return -> 13 -> \r + json_Char = "\r" + Case 9 + ' tab -> 9 -> \t + json_Char = "\t" + Case 0 To 31, 127 To 65535 + ' Non-ascii characters -> convert to 4-digit hex + json_Char = "\u" & VBA.Right$("0000" & VBA.Hex$(json_AscCode), 4) + End Select + + json_BufferAppend json_Buffer, json_Char, json_BufferPosition, json_BufferLength + Next json_Index + + json_Encode = json_BufferToString(json_Buffer, json_BufferPosition) +End Function + +Private Function json_Peek(json_String As String, ByVal json_Index As Long, Optional json_NumberOfCharacters As Long = 1) As String + ' "Peek" at the next number of characters without incrementing json_Index (ByVal instead of ByRef) + json_SkipSpaces json_String, json_Index + json_Peek = VBA.Mid$(json_String, json_Index, json_NumberOfCharacters) +End Function + +Private Sub json_SkipSpaces(json_String As String, ByRef json_Index As Long) + ' Increment index to skip over spaces + Do While json_Index > 0 And json_Index <= VBA.Len(json_String) And VBA.Mid$(json_String, json_Index, 1) = " " + json_Index = json_Index + 1 + Loop +End Sub + +Private Function json_StringIsLargeNumber(json_String As Variant) As Boolean + ' Check if the given string is considered a "large number" + ' (See json_ParseNumber) + + Dim json_Length As Long + Dim json_CharIndex As Long + json_Length = VBA.Len(json_String) + + ' Length with be at least 16 characters and assume will be less than 100 characters + If json_Length >= 16 And json_Length <= 100 Then + Dim json_CharCode As String + + json_StringIsLargeNumber = True + + For json_CharIndex = 1 To json_Length + json_CharCode = VBA.Asc(VBA.Mid$(json_String, json_CharIndex, 1)) + Select Case json_CharCode + ' Look for .|0-9|E|e + Case 46, 48 To 57, 69, 101 + ' Continue through characters + Case Else + json_StringIsLargeNumber = False + Exit Function + End Select + Next json_CharIndex + End If +End Function + +Private Function json_ParseErrorMessage(json_String As String, ByRef json_Index As Long, ErrorMessage As String) + ' Provide detailed parse error message, including details of where and what occurred + ' + ' Example: + ' Error parsing JSON: + ' {"abcde":True} + ' ^ + ' Expecting 'STRING', 'NUMBER', null, true, false, '{', or '[' + + Dim json_StartIndex As Long + Dim json_StopIndex As Long + + ' Include 10 characters before and after error (if possible) + json_StartIndex = json_Index - 10 + json_StopIndex = json_Index + 10 + If json_StartIndex <= 0 Then + json_StartIndex = 1 + End If + If json_StopIndex > VBA.Len(json_String) Then + json_StopIndex = VBA.Len(json_String) + End If + + json_ParseErrorMessage = "Error parsing JSON:" & VBA.vbNewLine & _ + VBA.Mid$(json_String, json_StartIndex, json_StopIndex - json_StartIndex + 1) & VBA.vbNewLine & _ + VBA.Space$(json_Index - json_StartIndex) & "^" & VBA.vbNewLine & _ + ErrorMessage +End Function + +Private Sub json_BufferAppend(ByRef json_Buffer As String, _ + ByRef json_Append As Variant, _ + ByRef json_BufferPosition As Long, _ + ByRef json_BufferLength As Long) + ' VBA can be slow to append strings due to allocating a new string for each append + ' Instead of using the traditional append, allocate a large empty string and then copy string at append position + ' + ' Example: + ' Buffer: "abc " + ' Append: "def" + ' Buffer Position: 3 + ' Buffer Length: 5 + ' + ' Buffer position + Append length > Buffer length -> Append chunk of blank space to buffer + ' Buffer: "abc " + ' Buffer Length: 10 + ' + ' Put "def" into buffer at position 3 (0-based) + ' Buffer: "abcdef " + ' + ' Approach based on cStringBuilder from vbAccelerator + ' http://www.vbaccelerator.com/home/VB/Code/Techniques/RunTime_Debug_Tracing/VB6_Tracer_Utility_zip_cStringBuilder_cls.asp + ' + ' and clsStringAppend from Philip Swannell + ' https://github.com/VBA-tools/VBA-JSON/pull/82 + + Dim json_AppendLength As Long + Dim json_LengthPlusPosition As Long + + json_AppendLength = VBA.Len(json_Append) + json_LengthPlusPosition = json_AppendLength + json_BufferPosition + + If json_LengthPlusPosition > json_BufferLength Then + ' Appending would overflow buffer, add chunk + ' (double buffer length or append length, whichever is bigger) + Dim json_AddedLength As Long + json_AddedLength = IIf(json_AppendLength > json_BufferLength, json_AppendLength, json_BufferLength) + + json_Buffer = json_Buffer & VBA.Space$(json_AddedLength) + json_BufferLength = json_BufferLength + json_AddedLength + End If + + ' Note: Namespacing with VBA.Mid$ doesn't work properly here, throwing compile error: + ' Function call on left-hand side of assignment must return Variant or Object + Mid$(json_Buffer, json_BufferPosition + 1, json_AppendLength) = CStr(json_Append) + json_BufferPosition = json_BufferPosition + json_AppendLength +End Sub + +Private Function json_BufferToString(ByRef json_Buffer As String, ByVal json_BufferPosition As Long) As String + If json_BufferPosition > 0 Then + json_BufferToString = VBA.Left$(json_Buffer, json_BufferPosition) + End If +End Function + +'' +' VBA-UTC v1.0.6 +' (c) Tim Hall - https://github.com/VBA-tools/VBA-UtcConverter +' +' UTC/ISO 8601 Converter for VBA +' +' Errors: +' 10011 - UTC parsing error +' 10012 - UTC conversion error +' 10013 - ISO 8601 parsing error +' 10014 - ISO 8601 conversion error +' +' @module UtcConverter +' @author tim.hall.engr@gmail.com +' @license MIT (http://www.opensource.org/licenses/mit-license.php) +'' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' + +' (Declarations moved to top) + +' ============================================= ' +' Public Methods +' ============================================= ' + +'' +' Parse UTC date to local date +' +' @method ParseUtc +' @param {Date} UtcDate +' @return {Date} Local date +' @throws 10011 - UTC parsing error +'' +Public Function ParseUtc(utc_UtcDate As Date) As Date + On Error GoTo utc_ErrorHandling + +#If Mac Then + ParseUtc = utc_ConvertDate(utc_UtcDate) +#Else + Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION + Dim utc_LocalDate As utc_SYSTEMTIME + + utc_GetTimeZoneInformation utc_TimeZoneInfo + utc_SystemTimeToTzSpecificLocalTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_UtcDate), utc_LocalDate + + ParseUtc = utc_SystemTimeToDate(utc_LocalDate) +#End If + + Exit Function + +utc_ErrorHandling: + Err.Raise 10011, "UtcConverter.ParseUtc", "UTC parsing error: " & Err.Number & " - " & Err.Description +End Function + +'' +' Convert local date to UTC date +' +' @method ConvertToUrc +' @param {Date} utc_LocalDate +' @return {Date} UTC date +' @throws 10012 - UTC conversion error +'' +Public Function ConvertToUtc(utc_LocalDate As Date) As Date + On Error GoTo utc_ErrorHandling + +#If Mac Then + ConvertToUtc = utc_ConvertDate(utc_LocalDate, utc_ConvertToUtc:=True) +#Else + Dim utc_TimeZoneInfo As utc_TIME_ZONE_INFORMATION + Dim utc_UtcDate As utc_SYSTEMTIME + + utc_GetTimeZoneInformation utc_TimeZoneInfo + utc_TzSpecificLocalTimeToSystemTime utc_TimeZoneInfo, utc_DateToSystemTime(utc_LocalDate), utc_UtcDate + + ConvertToUtc = utc_SystemTimeToDate(utc_UtcDate) +#End If + + Exit Function + +utc_ErrorHandling: + Err.Raise 10012, "UtcConverter.ConvertToUtc", "UTC conversion error: " & Err.Number & " - " & Err.Description +End Function + +'' +' Parse ISO 8601 date string to local date +' +' @method ParseIso +' @param {Date} utc_IsoString +' @return {Date} Local date +' @throws 10013 - ISO 8601 parsing error +'' +Public Function ParseIso(utc_IsoString As String) As Date + On Error GoTo utc_ErrorHandling + + Dim utc_Parts() As String + Dim utc_DateParts() As String + Dim utc_TimeParts() As String + Dim utc_OffsetIndex As Long + Dim utc_HasOffset As Boolean + Dim utc_NegativeOffset As Boolean + Dim utc_OffsetParts() As String + Dim utc_Offset As Date + + utc_Parts = VBA.Split(utc_IsoString, "T") + utc_DateParts = VBA.Split(utc_Parts(0), "-") + ParseIso = VBA.DateSerial(VBA.CInt(utc_DateParts(0)), VBA.CInt(utc_DateParts(1)), VBA.CInt(utc_DateParts(2))) + + If UBound(utc_Parts) > 0 Then + If VBA.InStr(utc_Parts(1), "Z") Then + utc_TimeParts = VBA.Split(VBA.Replace(utc_Parts(1), "Z", ""), ":") + Else + utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "+") + If utc_OffsetIndex = 0 Then + utc_NegativeOffset = True + utc_OffsetIndex = VBA.InStr(1, utc_Parts(1), "-") + End If + + If utc_OffsetIndex > 0 Then + utc_HasOffset = True + utc_TimeParts = VBA.Split(VBA.Left$(utc_Parts(1), utc_OffsetIndex - 1), ":") + utc_OffsetParts = VBA.Split(VBA.Right$(utc_Parts(1), Len(utc_Parts(1)) - utc_OffsetIndex), ":") + + Select Case UBound(utc_OffsetParts) + Case 0 + utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), 0, 0) + Case 1 + utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), 0) + Case 2 + ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues + utc_Offset = TimeSerial(VBA.CInt(utc_OffsetParts(0)), VBA.CInt(utc_OffsetParts(1)), Int(VBA.Val(utc_OffsetParts(2)))) + End Select + + If utc_NegativeOffset Then: utc_Offset = -utc_Offset + Else + utc_TimeParts = VBA.Split(utc_Parts(1), ":") + End If + End If + + Select Case UBound(utc_TimeParts) + Case 0 + ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), 0, 0) + Case 1 + ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), 0) + Case 2 + ' VBA.Val does not use regional settings, use for seconds to avoid decimal/comma issues + ParseIso = ParseIso + VBA.TimeSerial(VBA.CInt(utc_TimeParts(0)), VBA.CInt(utc_TimeParts(1)), Int(VBA.Val(utc_TimeParts(2)))) + End Select + + ParseIso = ParseUtc(ParseIso) + + If utc_HasOffset Then + ParseIso = ParseIso - utc_Offset + End If + End If + + Exit Function + +utc_ErrorHandling: + Err.Raise 10013, "UtcConverter.ParseIso", "ISO 8601 parsing error for " & utc_IsoString & ": " & Err.Number & " - " & Err.Description +End Function + +'' +' Convert local date to ISO 8601 string +' +' @method ConvertToIso +' @param {Date} utc_LocalDate +' @return {Date} ISO 8601 string +' @throws 10014 - ISO 8601 conversion error +'' +Public Function ConvertToIso(utc_LocalDate As Date) As String + On Error GoTo utc_ErrorHandling + + ConvertToIso = VBA.Format$(ConvertToUtc(utc_LocalDate), "yyyy-mm-ddTHH:mm:ss.000Z") + + Exit Function + +utc_ErrorHandling: + Err.Raise 10014, "UtcConverter.ConvertToIso", "ISO 8601 conversion error: " & Err.Number & " - " & Err.Description +End Function + +' ============================================= ' +' Private Functions +' ============================================= ' + +#If Mac Then + +Private Function utc_ConvertDate(utc_Value As Date, Optional utc_ConvertToUtc As Boolean = False) As Date + Dim utc_ShellCommand As String + Dim utc_Result As utc_ShellResult + Dim utc_Parts() As String + Dim utc_DateParts() As String + Dim utc_TimeParts() As String + + If utc_ConvertToUtc Then + utc_ShellCommand = "date -ur `date -jf '%Y-%m-%d %H:%M:%S' " & _ + "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & "' " & _ + " +'%s'` +'%Y-%m-%d %H:%M:%S'" + Else + utc_ShellCommand = "date -jf '%Y-%m-%d %H:%M:%S %z' " & _ + "'" & VBA.Format$(utc_Value, "yyyy-mm-dd HH:mm:ss") & " +0000' " & _ + "+'%Y-%m-%d %H:%M:%S'" + End If + + utc_Result = utc_ExecuteInShell(utc_ShellCommand) + + If utc_Result.utc_Output = "" Then + Err.Raise 10015, "UtcConverter.utc_ConvertDate", "'date' command failed" + Else + utc_Parts = Split(utc_Result.utc_Output, " ") + utc_DateParts = Split(utc_Parts(0), "-") + utc_TimeParts = Split(utc_Parts(1), ":") + + utc_ConvertDate = DateSerial(utc_DateParts(0), utc_DateParts(1), utc_DateParts(2)) + _ + TimeSerial(utc_TimeParts(0), utc_TimeParts(1), utc_TimeParts(2)) + End If +End Function + +Private Function utc_ExecuteInShell(utc_ShellCommand As String) As utc_ShellResult +#If VBA7 Then + Dim utc_File As LongPtr + Dim utc_Read As LongPtr +#Else + Dim utc_File As Long + Dim utc_Read As Long +#End If + + Dim utc_Chunk As String + + On Error GoTo utc_ErrorHandling + utc_File = utc_popen(utc_ShellCommand, "r") + + If utc_File = 0 Then: Exit Function + + Do While utc_feof(utc_File) = 0 + utc_Chunk = VBA.Space$(50) + utc_Read = CLng(utc_fread(utc_Chunk, 1, Len(utc_Chunk) - 1, utc_File)) + If utc_Read > 0 Then + utc_Chunk = VBA.Left$(utc_Chunk, CLng(utc_Read)) + utc_ExecuteInShell.utc_Output = utc_ExecuteInShell.utc_Output & utc_Chunk + End If + Loop + +utc_ErrorHandling: + utc_ExecuteInShell.utc_ExitCode = CLng(utc_pclose(utc_File)) +End Function + +#Else + +Private Function utc_DateToSystemTime(utc_Value As Date) As utc_SYSTEMTIME + utc_DateToSystemTime.utc_wYear = VBA.Year(utc_Value) + utc_DateToSystemTime.utc_wMonth = VBA.Month(utc_Value) + utc_DateToSystemTime.utc_wDay = VBA.Day(utc_Value) + utc_DateToSystemTime.utc_wHour = VBA.Hour(utc_Value) + utc_DateToSystemTime.utc_wMinute = VBA.Minute(utc_Value) + utc_DateToSystemTime.utc_wSecond = VBA.Second(utc_Value) + utc_DateToSystemTime.utc_wMilliseconds = 0 +End Function + +Private Function utc_SystemTimeToDate(utc_Value As utc_SYSTEMTIME) As Date + utc_SystemTimeToDate = DateSerial(utc_Value.utc_wYear, utc_Value.utc_wMonth, utc_Value.utc_wDay) + _ + TimeSerial(utc_Value.utc_wHour, utc_Value.utc_wMinute, utc_Value.utc_wSecond) +End Function + +#End If + diff --git a/README.ja.md b/README.ja.md new file mode 100644 index 0000000..e9861ba --- /dev/null +++ b/README.ja.md @@ -0,0 +1,60 @@ +# TinySeleniumVBA + +A tiny Selenium wrapper written in pure VBA. + +[汞ｬ汞ｧEnglish version is here](https://github.com/uezo/TinySeleniumVBA/blob/master/README.md) + +# 笨ｨ 迚ｹ髟ｷ + +- 繧､繝ｳ繧ｹ繝医ｼ繝ｫ荳崎ｦ: VBA縺ｮ縺ｿ縺ｧ譖ｸ縺九ｌ縺ｦ縺繧九ｮ縺ｧ縲√う繝ｳ繧ｹ繝医ｼ繝ｫ讓ｩ髯舌ｮ縺ｪ縺莠ｺ縺ｧ繧ゅ☆縺舌↓繝悶Λ繧ｦ繧ｶ閾ｪ蜍墓桃菴懊↓蜿悶ｊ謗帙°繧九％縺ｨ縺後〒縺阪∪縺 +- 萓ｿ蛻ｩ縺ｪ繝倥Ν繝代ｼ讖溯ｽ: FindElement(s)By*縲√ヵ繧ｩ繝ｼ繝縺ｸ縺ｮ蛟､縺ｮ蜈･蜃ｺ蜉帙√け繝ｪ繝繧ｯ繧縺昴ｮ莉紋ｾｿ蛻ｩ縺ｪ讖溯ｽ繧呈署萓帙＠縺ｦ縺縺ｾ縺 +- 繧ｪ繝ｼ繝励Φ縺ｪ莉墓ｧ: 蝓ｺ譛ｬ逧縺ｫ縺薙ｮ繝ｩ繝繝代ｼ縺ｯWebDriver縺ｮHTTP繧ｯ繝ｩ繧､繧｢繝ｳ繝医〒縺吶ｮ縺ｧ縲√Λ繝繝代ｼ縺ｮ菴ｿ縺譁ｹ繧貞ｭｦ縺ｶ縺薙→縺ｯWebDriver縺ｮ莉墓ｧ倥ｒ遏･繧九％縺ｨ縺ｨ蜷檎ｾｩ縺ｧ縺吶ら┌鬧縺ｫ縺ｪ繧九ｂ縺ｮ縺ｯ縺ゅｊ縺ｾ縺帙ｓ +https://www.w3.org/TR/webdriver/ + + +# 沒ｦ 繧ｻ繝繝医い繝繝 + +1. 繝繝ｼ繝ｫｼ槫盾辣ｧ險ｭ螳壹°繧 `Microsoft Scripting Runtime` 縺ｫ蜿らｧ繧帝壹＠縺ｦ縺上□縺輔＞ + +1. `WebDriver.cls`縲〜WebElement.cls`縲〜JsonConverter.bas`繧偵励Ο繧ｸ繧ｧ繧ｯ繝医↓霑ｽ蜉縺励※縺上□縺輔＞ + - 譛譁ｰ迚 (v0.1.0): https://github.com/uezo/TinySeleniumVBA/archive/v0.1.0.zip + +1. WebDriver繧偵ム繧ｦ繝ｳ繝ｭ繝ｼ繝峨＠縺ｦ縺上□縺輔＞ｼ医ヶ繝ｩ繧ｦ繧ｶ縺ｮ繝｡繧ｸ繝｣繝ｼ繝舌ｼ繧ｸ繝ｧ繝ｳ縺ｨ蜷後§繧ゅｮｼ + - Edge: https://developer.microsoft.com/ja-jp/microsoft-edge/tools/webdriver/ + - Chrome: https://chromedriver.chromium.org/downloads + +# 洙 菴ｿ縺譁ｹ + +```vb +Public Sub main() + ' WebDriver縺ｮ髢句ｧ (Edge) + Dim Driver As New WebDriver + Driver.Edge "path\to\msedgedriver.exe" + + ' 繝悶Λ繧ｦ繧ｶ繧帝幕縺 + Driver.OpenBrowser + + ' Google縺ｸ遘ｻ蜍 + Driver.Navigate "https://www.google.co.jp/?q=selenium" + + ' 讀懃ｴ｢繝繧ｭ繧ｹ繝医懊ャ繧ｯ繧ｹ繧貞叙蠕 + Dim searchInput + Set searchInput = Driver.FindElement(By.Name, "q") + + ' 繝繧ｭ繧ｹ繝医懊ャ繧ｯ繧ｹ縺ｮ蛟､繧貞叙蠕 + Debug.Print searchInput.GetValue + + ' 繝繧ｭ繧ｹ繝医懊ャ繧ｯ繧ｹ縺ｫ蛟､繧貞･蜉 + searchInput.SetValue "yomoda soba" + + ' 讀懃ｴ｢繝懊ち繝ｳ縺ｮ繧ｯ繝ｪ繝繧ｯ + Driver.FindElement(By.Name, "btnK").Click + + ' 蜀崎ｪｭ縺ｿ霎ｼ縺ｿ - 繝倥Ν繝代ｼ繝｡繧ｽ繝繝峨ｒ謠蝉ｾ帙＠縺ｦ縺縺ｪ縺蝣ｴ蜷医〒繧ゅ√ラ繝ｩ繧､繝舌ｼ繧ｳ繝槭Φ繝峨ｒ逶ｴ謗･螳溯｡後☆繧九％縺ｨ縺後〒縺阪∪縺 + Driver.Execute Driver.CMD_REFRESH +End Sub +``` + +# 笶､ｸ 隰晁ｾ + +[VBA-JSON](https://github.com/VBA-tools/VBA-JSON) 縺ｨ縺縺 Tim Hall 縺輔ｓ縺碁幕逋ｺ縺励◆VBA逕ｨJSON繧ｳ繝ｳ繝舌ｼ繧ｿ繝ｼ縺ｯHTTP繧ｯ繝ｩ繧､繧｢繝ｳ繝医ｒ菴懊ｋ荳翫〒縺ｨ縺ｦ繧ょｽｹ縺ｫ遶九■縺ｾ縺励◆縲ゅ％縺ｮ縺吶ｰ繧峨＠縺繝ｩ繧､繝悶Λ繝ｪ縺ｯ蠖楢ｩｲ繝ｩ繧､繝悶Λ繝ｪ縺ｮ繝ｩ繧､繧ｻ繝ｳ繧ｹ縺ｮ繧ゅ→縺ｧ繝ｪ繝ｪ繝ｼ繧ｹ縺ｫ蜷ｫ縺ｾ繧後※縺縺ｾ縺吶ゅ≠繧翫′縺ｨ縺縺斐＊縺縺ｾ縺呻ｼ diff --git a/README.md b/README.md new file mode 100644 index 0000000..da575c7 --- /dev/null +++ b/README.md @@ -0,0 +1,60 @@ +# TinySeleniumVBA + +A tiny Selenium wrapper written in pure VBA. + +[汞ｯ汞ｵ譌･譛ｬ隱槭ｮREADME縺ｯ縺薙■繧云(https://github.com/uezo/TinySeleniumVBA/blob/master/README.ja.md) + +# 笨ｨ Features + +- No insatallation: Everyone even who doesn't have permissions to install can automate browser operations. +- Useful helper Methods: FindElement(s)By*, Get/Set value to form, click and more. +- Open spec: Basically this wrapper is just a HTTP client of WebDriver server. Learning this wrapper equals to learning WebDriver. +https://www.w3.org/TR/webdriver/ + + +# 沒ｦ Setup + +1. Set reference to `Microsoft Scripting Runtime` + +1. Add `WebDriver.cls`, `WebElement.cls` and `JsonConverter.bas` to your VBA Project + - Latest (v0.1.0): https://github.com/uezo/TinySeleniumVBA/archive/v0.1.0.zip + +1. Download WebDriver (driver and browser should be the same version) + - Edge: https://developer.microsoft.com/ja-jp/microsoft-edge/tools/webdriver/ + - Chrome: https://chromedriver.chromium.org/downloads + +# 洙 Usage + +```vb +Public Sub main() + ' Start WebDriver (Edge) + Dim Driver As New WebDriver + Driver.Edge "path\to\msedgedriver.exe" + + ' Open browser + Driver.OpenBrowser + + ' Navigate to Google + Driver.Navigate "https://www.google.co.jp/?q=selenium" + + ' Get search textbox + Dim searchInput + Set searchInput = Driver.FindElement(By.Name, "q") + + ' Get value from textbox + Debug.Print searchInput.GetValue + + ' Set value to textbox + searchInput.SetValue "yomoda soba" + + ' Click search button + Driver.FindElement(By.Name, "btnK").Click + + ' Refresh - you can use Execute with driver command even if the method is not provided + Driver.Execute Driver.CMD_REFRESH +End Sub +``` + +# 笶､ｸ Thanks + +[VBA-JSON](https://github.com/VBA-tools/VBA-JSON) by Tim Hall, JSON converter for VBA helps me a lot to make HTTP client and this awesome library is included in the release under its license. Thank you! diff --git a/WebDriver.cls b/WebDriver.cls new file mode 100755 index 0000000..36bb928 --- /dev/null +++ b/WebDriver.cls @@ -0,0 +1,611 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "WebDriver" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' TinySeleniumVBA v0.1.0 +' A tiny Selenium wrapper written in pure VBA +' +' (c)2021 uezo +' +' Mail: uezo@uezo.net +' Twitter: @uezochan +' https://github.com/uezo/TinySeleniumVBA +' +' ========================================================================== +' MIT License +' +' Copyright (c) 2021 uezo +' +' 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. +' ========================================================================== + +Option Explicit + +Public DefaultSessionId As String +Public UrlBase As String + +' Driver commands +Public CMD_STATUS +Public CMD_NEW_SESSION +Public CMD_GET_ALL_SESSIONS +Public CMD_QUIT +Public CMD_GET_CURRENT_WINDOW_HANDLE +Public CMD_W3C_GET_CURRENT_WINDOW_HANDLE +Public CMD_GET_WINDOW_HANDLES +Public CMD_W3C_GET_WINDOW_HANDLES +Public CMD_GET +Public CMD_GO_FORWARD +Public CMD_GO_BACK +Public CMD_REFRESH +Public CMD_EXECUTE_SCRIPT +Public CMD_W3C_EXECUTE_SCRIPT +Public CMD_W3C_EXECUTE_SCRIPT_ASYNC +Public CMD_GET_CURRENT_URL +Public CMD_GET_TITLE +Public CMD_GET_PAGE_SOURCE +Public CMD_SCREENSHOT +Public CMD_ELEMENT_SCREENSHOT +Public CMD_FIND_ELEMENT +Public CMD_FIND_ELEMENTS +Public CMD_W3C_GET_ACTIVE_ELEMENT +Public CMD_GET_ACTIVE_ELEMENT +Public CMD_FIND_CHILD_ELEMENT +Public CMD_FIND_CHILD_ELEMENTS +Public CMD_CLICK_ELEMENT +Public CMD_CLEAR_ELEMENT +Public CMD_SUBMIT_ELEMENT +Public CMD_GET_ELEMENT_TEXT +Public CMD_SEND_KEYS_TO_ELEMENT +Public CMD_SEND_KEYS_TO_ACTIVE_ELEMENT +Public CMD_UPLOAD_FILE +Public CMD_GET_ELEMENT_VALUE +Public CMD_GET_ELEMENT_TAG_NAME +Public CMD_IS_ELEMENT_SELECTED +Public CMD_SET_ELEMENT_SELECTED +Public CMD_IS_ELEMENT_ENABLED +Public CMD_IS_ELEMENT_DISPLAYED +Public CMD_GET_ELEMENT_LOCATION +Public CMD_GET_ELEMENT_LOCATION_ONCE_SCROLLED_INTO_VIEW +Public CMD_GET_ELEMENT_SIZE +Public CMD_GET_ELEMENT_RECT +Public CMD_GET_ELEMENT_ATTRIBUTE +Public CMD_GET_ELEMENT_PROPERTY +Public CMD_GET_ALL_COOKIES +Public CMD_ADD_COOKIE +Public CMD_GET_COOKIE +Public CMD_DELETE_ALL_COOKIES +Public CMD_DELETE_COOKIE +Public CMD_SWITCH_TO_FRAME +Public CMD_SWITCH_TO_PARENT_FRAME +Public CMD_SWITCH_TO_WINDOW +Public CMD_CLOSE +Public CMD_GET_ELEMENT_VALUE_OF_CSS_PROPERTY +Public CMD_IMPLICIT_WAIT +Public CMD_EXECUTE_ASYNC_SCRIPT +Public CMD_SET_SCRIPT_TIMEOUT +Public CMD_SET_TIMEOUTS +Public CMD_DISMISS_ALERT +Public CMD_W3C_DISMISS_ALERT +Public CMD_ACCEPT_ALERT +Public CMD_W3C_ACCEPT_ALERT +Public CMD_SET_ALERT_VALUE +Public CMD_W3C_SET_ALERT_VALUE +Public CMD_GET_ALERT_TEXT +Public CMD_W3C_GET_ALERT_TEXT +Public CMD_SET_ALERT_CREDENTIALS +Public CMD_CLICK +Public CMD_W3C_ACTIONS +Public CMD_W3C_CLEAR_ACTIONS +Public CMD_DOUBLE_CLICK +Public CMD_MOUSE_DOWN +Public CMD_MOUSE_UP +Public CMD_MOVE_TO +Public CMD_GET_WINDOW_SIZE +Public CMD_SET_WINDOW_SIZE +Public CMD_GET_WINDOW_POSITION +Public CMD_SET_WINDOW_POSITION +Public CMD_SET_WINDOW_RECT +Public CMD_GET_WINDOW_RECT +Public CMD_MAXIMIZE_WINDOW +Public CMD_W3C_MAXIMIZE_WINDOW +Public CMD_SET_SCREEN_ORIENTATION +Public CMD_GET_SCREEN_ORIENTATION +Public CMD_SINGLE_TAP +Public CMD_TOUCH_DOWN +Public CMD_TOUCH_UP +Public CMD_TOUCH_MOVE +Public CMD_TOUCH_SCROLL +Public CMD_DOUBLE_TAP +Public CMD_LONG_PRESS +Public CMD_FLICK +Public CMD_EXECUTE_SQL +Public CMD_GET_LOCATION +Public CMD_SET_LOCATION +Public CMD_GET_APP_CACHE +Public CMD_GET_APP_CACHE_STATUS +Public CMD_CLEAR_APP_CACHE +Public CMD_GET_NETWORK_CONNECTION +Public CMD_SET_NETWORK_CONNECTION +Public CMD_GET_LOCAL_STORAGE_ITEM +Public CMD_REMOVE_LOCAL_STORAGE_ITEM +Public CMD_GET_LOCAL_STORAGE_KEYS +Public CMD_SET_LOCAL_STORAGE_ITEM +Public CMD_CLEAR_LOCAL_STORAGE +Public CMD_GET_LOCAL_STORAGE_SIZE +Public CMD_GET_SESSION_STORAGE_ITEM +Public CMD_REMOVE_SESSION_STORAGE_ITEM +Public CMD_GET_SESSION_STORAGE_KEYS +Public CMD_SET_SESSION_STORAGE_ITEM +Public CMD_CLEAR_SESSION_STORAGE +Public CMD_GET_SESSION_STORAGE_SIZE +Public CMD_GET_LOG +Public CMD_GET_AVAILABLE_LOG_TYPES +Public CMD_CURRENT_CONTEXT_HANDLE +Public CMD_CONTEXT_HANDLES +Public CMD_SWITCH_TO_CONTEXT +Public CMD_FULLSCREEN_WINDOW +Public CMD_MINIMIZE_WINDOW +Public CMD_SHUTDOWN + +Private Const ELEMENT_KEY = "element-6066-11e4-a52e-4f735466cecf" + +Public Enum By + ID = 0 + TagName = 1 + ClassName = 2 + Name = 3 + CssSelector = 4 +End Enum + + +' ========================================================================== +' Setup and shutdown +' ========================================================================== + +' Launch Edge Driver +Public Sub Edge(ByVal driverPath As String, Optional ByVal driverUrl As String = "http://localhost:9515") + Start driverPath, driverUrl +End Sub + +' Launch Chrome Driver +Public Sub Chrome(ByVal driverPath As String, Optional ByVal driverUrl As String = "http://localhost:9151") + Start driverPath, driverUrl +End Sub + +' Start WebDriver +Public Sub Start(ByVal driverPath As String, ByVal driverUrl As String) + ' Start WebDriver executable + If Shell(driverPath, vbMinimizedNoFocus) = 0 Then + MsgBox "Failed in starting WebDriver" + End + End If + + ' Set WebDriver url + UrlBase = driverUrl + + ' Initialize driver commands + InitCommands +End Sub + +' Shutdown WebDriver +Public Sub Shutdown() + Execute CMD_SHUTDOWN +End Sub + + +' ========================================================================== +' Browser operations +' ========================================================================== + +' Open browser +Public Function OpenBrowser(Optional capabilities As Dictionary = Nothing, Optional desiredCapabilities As Dictionary = Nothing, Optional ByVal useAsDefault As Boolean = True) As String + If capabilities Is Nothing Then + Set capabilities = New Dictionary + End If + + Dim resp As Dictionary + Set resp = Execute(CMD_NEW_SESSION, Params("capabilities", capabilities, "desiredCapabilities", desiredCapabilities)) + + If useAsDefault Then + DefaultSessionId = resp("sessionId") + End If + + OpenBrowser = resp("sessionId") +End Function + +' Close browser +Public Sub CloseBrowser(Optional ByVal sessionId As String = vbNullString) + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + + Execute CMD_QUIT, data + DefaultSessionId = vbNullString +End Sub + +' Open url +Public Sub Navigate(ByVal url As String, Optional ByVal sessionId As String = vbNullString) + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + data.Add "url", url + + Execute CMD_GET, data +End Sub + + +' ========================================================================== +' DOM operations +' ========================================================================== + +' Find DOM element +Public Function FindElement(by_ As By, value As String, Optional parentElementId As String = vbNullString, Optional ByVal sessionId As String = vbNullString) As WebElement + Dim data As Dictionary + Set data = ToSelector(by_, value) + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + + Dim cmd + If parentElementId <> vbNullString Then + data.Add "id", parentElementId + cmd = CMD_FIND_CHILD_ELEMENT + Else + cmd = CMD_FIND_ELEMENT + End If + + ' Return element + Set FindElement = ToWebElement(Execute(cmd, data)(ELEMENT_KEY), sessionId) +End Function + +' Find multiple DOM elements +Public Function FindElements(by_ As By, value As String, Optional parentElementId As String = vbNullString, Optional ByVal sessionId As String = vbNullString) As WebElement() + Dim data As Dictionary + Set data = ToSelector(by_, value) + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + + Dim cmd + If parentElementId <> vbNullString Then + data.Add "id", parentElementId + cmd = CMD_FIND_CHILD_ELEMENTS + Else + cmd = CMD_FIND_ELEMENTS + End If + + Dim elements + Set elements = Execute(cmd, data) + + ' To array of ids + Dim ret() As WebElement + Dim i As Integer + For i = 0 To elements.Count - 1 ' elements is Collection, not array + ReDim Preserve ret(i) + Set ret(i) = ToWebElement(elements(i + 1)(ELEMENT_KEY), sessionId) + Next + + ' Return element ids + FindElements = ret +End Function + +' by* to CSS selector +Private Function ToSelector(by_ As By, ByVal value As String) As Dictionary + If by_ = By.ID Then + value = "[id=""" + value + """]" + ElseIf by_ = By.ClassName Then + value = "." + value + ElseIf by_ = By.Name Then + value = "[name=""" + value + """]" + End If + + Dim data As New Dictionary + data.Add "using", "css selector" + data.Add "value", value + + Set ToSelector = data +End Function + +' Create element +Private Function ToWebElement(ByVal elementId As String, Optional ByVal sessionId As String = vbNullString) As WebElement + Dim element As New WebElement + Set element.Driver_ = Me + If sessionId = vbNullString Then + element.SessionId_ = sessionId + Else + element.SessionId_ = DefaultSessionId + End If + element.ElementId_ = elementId + Set ToWebElement = element +End Function + +' Returns element.value +Public Function GetValue(elementId As String, Optional ByVal sessionId As String = vbNullString) As String + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + data.Add "id", elementId + data.Add "name", "value" + + GetValue = Execute(CMD_GET_ELEMENT_ATTRIBUTE, data) +End Function + +' Set value to element +Public Sub SetValue(elementId As String, text As String, Optional ByVal sessionId As String = vbNullString) + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + data.Add "id", elementId + data.Add "text", text + + Dim chars() As String + ReDim chars(Len(text) - 1) + Dim i As Integer + For i = 0 To UBound(chars) + chars(i) = Mid(text, i + 1, 1) + Next + data.Add "value", chars + + Execute CMD_CLEAR_ELEMENT, data + Execute CMD_SEND_KEYS_TO_ELEMENT, data +End Sub + +' Click element +Public Sub Click(elementId As String, Optional ByVal sessionId As String = vbNullString) + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + data.Add "id", elementId + + Execute CMD_CLICK_ELEMENT, data +End Sub + +' Get text +Public Function GetText(elementId As String, Optional ByVal sessionId As String = vbNullString) As String + Dim data As New Dictionary + If sessionId <> vbNullString Then + data.Add "sessionId", sessionId + End If + data.Add "id", elementId + + GetText = Execute(CMD_GET_ELEMENT_TEXT, data) +End Function + + +' ========================================================================== +' Common functions +' ========================================================================== + +' Execute driver command +Public Function Execute(driverCommand, Optional parameters As Dictionary = Nothing) + Dim method As String: method = driverCommand(0) + Dim path As String: path = driverCommand(1) + If parameters Is Nothing Then + Set parameters = New Dictionary + End If + + ' Set default session id if session id is missing + If Not parameters.Exists("sessionId") Then + parameters.Add "sessionId", DefaultSessionId + End If + + ' Set params to path + Dim paramKey As Variant + For Each paramKey In parameters + If VarType(parameters(paramKey)) = vbString Then + path = Replace(path, "$" + paramKey, parameters(paramKey)) + End If + Next + + ' Send request to selenium server + Dim resp As Dictionary + Set resp = SendRequest(method, UrlBase + path, parameters) + + ' Return value(s) + If IsNull(resp("value")) Then + Set Execute = New Dictionary + ElseIf TypeName(resp("value")) = "Collection" Then + Set Execute = resp("value") + ElseIf VarType(resp("value")) = vbObject Then + If resp("value").Exists("error") Then + Err.Raise 513, "WebDriver.Execute", JsonConverter.ConvertToJson(resp("value")) + Else + Set Execute = resp("value") + End If + Else + Execute = resp("value") + End If +End Function + +' Send HTTP request +Private Function SendRequest(method As String, url As String, Optional data As Dictionary = Nothing) As Dictionary + Dim client As Object + Set client = CreateObject("MSXML2.ServerXMLHTTP") + + client.Open method, url + + If method = "POST" Or method = "PUT" Then + client.setRequestHeader "Content-Type", "application/json" + client.send JsonConverter.ConvertToJson(data) + Else + client.send + End If + + Do While client.readyState < 4 + DoEvents + Loop + + Dim Json As Object + Set Json = JsonConverter.ParseJson(client.responseText) + Set SendRequest = Json +End Function + + +' ========================================================================== +' Driver commands +' ========================================================================== +Private Sub InitCommands() + CMD_STATUS = Array("GET", "/status") + CMD_NEW_SESSION = Array("POST", "/session") + CMD_GET_ALL_SESSIONS = Array("GET", "/sessions") + CMD_QUIT = Array("DELETE", "/session/$sessionId") + CMD_GET_CURRENT_WINDOW_HANDLE = Array("GET", "/session/$sessionId/window_handle") + CMD_W3C_GET_CURRENT_WINDOW_HANDLE = Array("GET", "/session/$sessionId/window") + CMD_GET_WINDOW_HANDLES = Array("GET", "/session/$sessionId/window_handles") + CMD_W3C_GET_WINDOW_HANDLES = Array("GET", "/session/$sessionId/window/handles") + CMD_GET = Array("POST", "/session/$sessionId/url") + CMD_GO_FORWARD = Array("POST", "/session/$sessionId/forward") + CMD_GO_BACK = Array("POST", "/session/$sessionId/back") + CMD_REFRESH = Array("POST", "/session/$sessionId/refresh") + CMD_EXECUTE_SCRIPT = Array("POST", "/session/$sessionId/execute") + CMD_W3C_EXECUTE_SCRIPT = Array("POST", "/session/$sessionId/execute/sync") + CMD_W3C_EXECUTE_SCRIPT_ASYNC = Array("POST", "/session/$sessionId/execute/async") + CMD_GET_CURRENT_URL = Array("GET", "/session/$sessionId/url") + CMD_GET_TITLE = Array("GET", "/session/$sessionId/title") + CMD_GET_PAGE_SOURCE = Array("GET", "/session/$sessionId/source") + CMD_SCREENSHOT = Array("GET", "/session/$sessionId/screenshot") + CMD_ELEMENT_SCREENSHOT = Array("GET", "/session/$sessionId/element/$id/screenshot") + CMD_FIND_ELEMENT = Array("POST", "/session/$sessionId/element") + CMD_FIND_ELEMENTS = Array("POST", "/session/$sessionId/elements") + CMD_W3C_GET_ACTIVE_ELEMENT = Array("GET", "/session/$sessionId/element/active") + CMD_GET_ACTIVE_ELEMENT = Array("POST", "/session/$sessionId/element/active") + CMD_FIND_CHILD_ELEMENT = Array("POST", "/session/$sessionId/element/$id/element") + CMD_FIND_CHILD_ELEMENTS = Array("POST", "/session/$sessionId/element/$id/elements") + CMD_CLICK_ELEMENT = Array("POST", "/session/$sessionId/element/$id/click") + CMD_CLEAR_ELEMENT = Array("POST", "/session/$sessionId/element/$id/clear") + CMD_SUBMIT_ELEMENT = Array("POST", "/session/$sessionId/element/$id/submit") + CMD_GET_ELEMENT_TEXT = Array("GET", "/session/$sessionId/element/$id/text") + CMD_SEND_KEYS_TO_ELEMENT = Array("POST", "/session/$sessionId/element/$id/value") + CMD_SEND_KEYS_TO_ACTIVE_ELEMENT = Array("POST", "/session/$sessionId/keys") + CMD_UPLOAD_FILE = Array("POST", "/session/$sessionId/file") + CMD_GET_ELEMENT_VALUE = Array("GET", "/session/$sessionId/element/$id/value") + CMD_GET_ELEMENT_TAG_NAME = Array("GET", "/session/$sessionId/element/$id/name") + CMD_IS_ELEMENT_SELECTED = Array("GET", "/session/$sessionId/element/$id/selected") + CMD_SET_ELEMENT_SELECTED = Array("POST", "/session/$sessionId/element/$id/selected") + CMD_IS_ELEMENT_ENABLED = Array("GET", "/session/$sessionId/element/$id/enabled") + CMD_IS_ELEMENT_DISPLAYED = Array("GET", "/session/$sessionId/element/$id/displayed") + CMD_GET_ELEMENT_LOCATION = Array("GET", "/session/$sessionId/element/$id/location") + CMD_GET_ELEMENT_LOCATION_ONCE_SCROLLED_INTO_VIEW = Array("GET", "/session/$sessionId/element/$id/location_in_view") + CMD_GET_ELEMENT_SIZE = Array("GET", "/session/$sessionId/element/$id/size") + CMD_GET_ELEMENT_RECT = Array("GET", "/session/$sessionId/element/$id/rect") + CMD_GET_ELEMENT_ATTRIBUTE = Array("GET", "/session/$sessionId/element/$id/attribute/$name") + CMD_GET_ELEMENT_PROPERTY = Array("GET", "/session/$sessionId/element/$id/property/$name") + CMD_GET_ALL_COOKIES = Array("GET", "/session/$sessionId/cookie") + CMD_ADD_COOKIE = Array("POST", "/session/$sessionId/cookie") + CMD_GET_COOKIE = Array("GET", "/session/$sessionId/cookie/$name") + CMD_DELETE_ALL_COOKIES = Array("DELETE", "/session/$sessionId/cookie") + CMD_DELETE_COOKIE = Array("DELETE", "/session/$sessionId/cookie/$name") + CMD_SWITCH_TO_FRAME = Array("POST", "/session/$sessionId/frame") + CMD_SWITCH_TO_PARENT_FRAME = Array("POST", "/session/$sessionId/frame/parent") + CMD_SWITCH_TO_WINDOW = Array("POST", "/session/$sessionId/window") + CMD_CLOSE = Array("DELETE", "/session/$sessionId/window") + CMD_GET_ELEMENT_VALUE_OF_CSS_PROPERTY = Array("GET", "/session/$sessionId/element/$id/css/$propertyName") + CMD_IMPLICIT_WAIT = Array("POST", "/session/$sessionId/timeouts/implicit_wait") + CMD_EXECUTE_ASYNC_SCRIPT = Array("POST", "/session/$sessionId/execute_async") + CMD_SET_SCRIPT_TIMEOUT = Array("POST", "/session/$sessionId/timeouts/async_script") + CMD_SET_TIMEOUTS = Array("POST", "/session/$sessionId/timeouts") + CMD_DISMISS_ALERT = Array("POST", "/session/$sessionId/dismiss_alert") + CMD_W3C_DISMISS_ALERT = Array("POST", "/session/$sessionId/alert/dismiss") + CMD_ACCEPT_ALERT = Array("POST", "/session/$sessionId/accept_alert") + CMD_W3C_ACCEPT_ALERT = Array("POST", "/session/$sessionId/alert/accept") + CMD_SET_ALERT_VALUE = Array("POST", "/session/$sessionId/alert_text") + CMD_W3C_SET_ALERT_VALUE = Array("POST", "/session/$sessionId/alert/text") + CMD_GET_ALERT_TEXT = Array("GET", "/session/$sessionId/alert_text") + CMD_W3C_GET_ALERT_TEXT = Array("GET", "/session/$sessionId/alert/text") + CMD_SET_ALERT_CREDENTIALS = Array("POST", "/session/$sessionId/alert/credentials") + CMD_CLICK = Array("POST", "/session/$sessionId/click") + CMD_W3C_ACTIONS = Array("POST", "/session/$sessionId/actions") + CMD_W3C_CLEAR_ACTIONS = Array("DELETE", "/session/$sessionId/actions") + CMD_DOUBLE_CLICK = Array("POST", "/session/$sessionId/doubleclick") + CMD_MOUSE_DOWN = Array("POST", "/session/$sessionId/buttondown") + CMD_MOUSE_UP = Array("POST", "/session/$sessionId/buttonup") + CMD_MOVE_TO = Array("POST", "/session/$sessionId/moveto") + CMD_GET_WINDOW_SIZE = Array("GET", "/session/$sessionId/window/$windowHandle/size") + CMD_SET_WINDOW_SIZE = Array("POST", "/session/$sessionId/window/$windowHandle/size") + CMD_GET_WINDOW_POSITION = Array("GET", "/session/$sessionId/window/$windowHandle/position") + CMD_SET_WINDOW_POSITION = Array("POST", "/session/$sessionId/window/$windowHandle/position") + CMD_SET_WINDOW_RECT = Array("POST", "/session/$sessionId/window/rect") + CMD_GET_WINDOW_RECT = Array("GET", "/session/$sessionId/window/rect") + CMD_MAXIMIZE_WINDOW = Array("POST", "/session/$sessionId/window/$windowHandle/maximize") + CMD_W3C_MAXIMIZE_WINDOW = Array("POST", "/session/$sessionId/window/maximize") + CMD_SET_SCREEN_ORIENTATION = Array("POST", "/session/$sessionId/orientation") + CMD_GET_SCREEN_ORIENTATION = Array("GET", "/session/$sessionId/orientation") + CMD_SINGLE_TAP = Array("POST", "/session/$sessionId/touch/click") + CMD_TOUCH_DOWN = Array("POST", "/session/$sessionId/touch/down") + CMD_TOUCH_UP = Array("POST", "/session/$sessionId/touch/up") + CMD_TOUCH_MOVE = Array("POST", "/session/$sessionId/touch/move") + CMD_TOUCH_SCROLL = Array("POST", "/session/$sessionId/touch/scroll") + CMD_DOUBLE_TAP = Array("POST", "/session/$sessionId/touch/doubleclick") + CMD_LONG_PRESS = Array("POST", "/session/$sessionId/touch/longclick") + CMD_FLICK = Array("POST", "/session/$sessionId/touch/flick") + CMD_EXECUTE_SQL = Array("POST", "/session/$sessionId/execute_sql") + CMD_GET_LOCATION = Array("GET", "/session/$sessionId/location") + CMD_SET_LOCATION = Array("POST", "/session/$sessionId/location") + CMD_GET_APP_CACHE = Array("GET", "/session/$sessionId/application_cache") + CMD_GET_APP_CACHE_STATUS = Array("GET", "/session/$sessionId/application_cache/status") + CMD_CLEAR_APP_CACHE = Array("DELETE", "/session/$sessionId/application_cache/clear") + CMD_GET_NETWORK_CONNECTION = Array("GET", "/session/$sessionId/network_connection") + CMD_SET_NETWORK_CONNECTION = Array("POST", "/session/$sessionId/network_connection") + CMD_GET_LOCAL_STORAGE_ITEM = Array("GET", "/session/$sessionId/local_storage/key/$key") + CMD_REMOVE_LOCAL_STORAGE_ITEM = Array("DELETE", "/session/$sessionId/local_storage/key/$key") + CMD_GET_LOCAL_STORAGE_KEYS = Array("GET", "/session/$sessionId/local_storage") + CMD_SET_LOCAL_STORAGE_ITEM = Array("POST", "/session/$sessionId/local_storage") + CMD_CLEAR_LOCAL_STORAGE = Array("DELETE", "/session/$sessionId/local_storage") + CMD_GET_LOCAL_STORAGE_SIZE = Array("GET", "/session/$sessionId/local_storage/size") + CMD_GET_SESSION_STORAGE_ITEM = Array("GET", "/session/$sessionId/session_storage/key/$key") + CMD_REMOVE_SESSION_STORAGE_ITEM = Array("DELETE", "/session/$sessionId/session_storage/key/$key") + CMD_GET_SESSION_STORAGE_KEYS = Array("GET", "/session/$sessionId/session_storage") + CMD_SET_SESSION_STORAGE_ITEM = Array("POST", "/session/$sessionId/session_storage") + CMD_CLEAR_SESSION_STORAGE = Array("DELETE", "/session/$sessionId/session_storage") + CMD_GET_SESSION_STORAGE_SIZE = Array("GET", "/session/$sessionId/session_storage/size") + CMD_GET_LOG = Array("POST", "/session/$sessionId/log") + CMD_GET_AVAILABLE_LOG_TYPES = Array("GET", "/session/$sessionId/log/types") + CMD_CURRENT_CONTEXT_HANDLE = Array("GET", "/session/$sessionId/context") + CMD_CONTEXT_HANDLES = Array("GET", "/session/$sessionId/contexts") + CMD_SWITCH_TO_CONTEXT = Array("POST", "/session/$sessionId/context") + CMD_FULLSCREEN_WINDOW = Array("POST", "/session/$sessionId/window/fullscreen") + CMD_MINIMIZE_WINDOW = Array("POST", "/session/$sessionId/window/minimize") + CMD_SHUTDOWN = Array("GET", "/shutdown") +End Sub + + +' ========================================================================== +' Utility functions +' ========================================================================== + +' KeyValue arguments to parameters as dictionaly +Private Function Params(ParamArray keysAndValues()) As Dictionary + Dim dict As New Dictionary + Dim i As Integer + For i = 0 To UBound(keysAndValues) - 1 Step 2 + dict.Add keysAndValues(i), keysAndValues(i + 1) + Next i + Set Params = dict +End Function + diff --git a/WebElement.cls b/WebElement.cls new file mode 100755 index 0000000..e0b6870 --- /dev/null +++ b/WebElement.cls @@ -0,0 +1,78 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = "WebElement" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' TinySeleniumVBA v0.1.0 +' A tiny Selenium wrapper written in pure VBA +' +' (c)2021 uezo +' +' Mail: uezo@uezo.net +' Twitter: @uezochan +' https://github.com/uezo/TinySeleniumVBA +' +' ========================================================================== +' MIT License +' +' Copyright (c) 2021 uezo +' +' 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. +' ========================================================================== + +Option Explicit + +Public Driver_ As WebDriver +Public SessionId_ As String +Public ElementId_ As String + +' Find DOM element +Public Function FindElement(by_ As By, value As String) As WebElement + Set FindElement = Driver_.FindElement(by_, value, ElementId_, SessionId_) +End Function + +' Find multiple DOM elements +Public Function FindElements(by_ As By, value As String) As WebElement() + FindElements = Driver_.FindElements(by_, value, ElementId_, SessionId_) +End Function + +' Returns element.value +Public Function GetValue() As String + GetValue = Driver_.GetValue(ElementId_, SessionId_) +End Function + +' Set value to element +Public Sub SetValue(text As String) + Driver_.SetValue ElementId_, text, SessionId_ +End Sub + +' Click +Public Sub Click() + Driver_.Click ElementId_, SessionId_ +End Sub + +' Returns element.innerText +Public Function GetText() As String + GetText = Driver_.GetText(ElementId_, SessionId_) +End Function +