[VBS] Microsoft Edge 실행 및 복합 동작 시나리오

 

Microsoft Edge 실행 및 복합 동작 시나리오 VBScript

• Windows 10 Pro x86/x64
• Microsoft Edge 20.10240.16384.0
• WebDriver 1.0

 

Edge를 외부에서 조작하는 VBScript 입니다.

1. Launch MS Edge and navigate "https://www.bing.com/"

2. Enter search word in textbox

3. Click 'Search' button

4. Take a screenshot

5. Terminate MS Edge

 

Option Explicit
 
Private http
Private doc
Private Const WebDriverFileName = "MicrosoftWebDriver.exe"
Private Const URI = "http://localhost:17556/"
Private Const CSIDL_PROGRAM_FILESX86 = 42
 
Set http = CreateObject("MSXML2.XMLHTTP")
Set doc = CreateObject("htmlfile")
Call AutomateMicrosoftEdge
 
Public Sub AutomateMicrosoftEdge()
'Microsoft Edge Automation using WebDriver
  Dim proc
  Dim sid, eid
  Dim b64
  Dim WebDriverFilePath
   
  'Run the Microsoft WebDriver Server
  WebDriverFilePath = CreateObject("Shell.Application").Namespace(CSIDL_PROGRAM_FILESX86).Self.Path
  WebDriverFilePath = WebDriverFilePath & "\Microsoft Web Driver\" & WebDriverFileName
  If CreateObject("Scripting.FileSystemObject") _
     .FileExists(WebDriverFilePath) = False Then Exit Sub
  If CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery _
     ("Select * From Win32_Process Where Name = '" & WebDriverFileName & "'").Count < 1 Then
    Set proc = CreateObject("WScript.Shell").Exec(WebDriverFilePath & " --port=17556")
  End If
   
  sid = StartSession()
  If sid = "" Then Exit Sub
  NavigateToURL sid, "https://www.bing.com/"
  WScript.Sleep 1000
  eid = FindElement(sid, "id", "sb_form_q")
  If eid = "" Then Exit Sub
  SendKeysElement sid, eid, "Microsoft MVP"
  eid = FindElement(sid, "id", "sb_form_go")
  If eid = "" Then Exit Sub
  ClickElement sid, eid
  WScript.Sleep 2000
  b64 = TakeScreenshot(sid)
  If b64 = "" Then Exit Sub
  DecodeBase64 b64, GetScriptFolderPath() & "Screenshot.png"
  EndSession sid
  If Not proc Is Nothing Then proc.Terminate 'Terminate Microsoft WebDriver Server
   
  MsgBox "done.", vbInformation + vbSystemModal
End Sub
 
Private Function StartSession()
'return sessionId
  Dim ret
  Dim json
  Dim elm
   
  On Error Resume Next
  With http
    .Open "POST", URI & "session", False
    .send "{""desiredCapabilities"": {}, ""requiredCapabilities"": {}}"
    Select Case .Status
      Case 200
        json = "(" & .responseText & ")"
        Set elm = doc.createElement("span")
        elm.setAttribute "id", "result"
        doc.appendChild elm
        doc.parentWindow.execScript _
          "document.getElementById('result').innerText=eval(" & json & ").sessionId;"
        If LCase(elm.innerText) = "null" Then
          ret = ""
        Else
          ret = elm.innerText
        End If
        doc.RemoveChild elm
    End Select
  End With
  On Error GoTo 0
  StartSession = ret
End Function
 
Private Sub NavigateToURL(ByVal sessionId, ByVal URL)
  On Error Resume Next
  With http
    .Open "POST", URI & "session/" & sessionId & "/url", False
    .send "{""url"": """ & URL & """}"
  End With
  On Error GoTo 0
End Sub
 
Private Function FindElement(ByVal sessionId, ByVal using, ByVal elmValue)
'return elementId
  Dim ret
  Dim json
  Dim elm
   
  On Error Resume Next
  With http
    .Open "POST", URI & "session/" & sessionId & "/element", False
    .send "{""using"": """ & using & """, ""value"": """ & elmValue & """}"
    Select Case .Status
      Case 200
        json = "(" & .responseText & ")"
        Set elm = doc.createElement("span")
        elm.setAttribute "id", "result"
        doc.appendChild elm
        doc.parentWindow.execScript _
          "document.getElementById('result').innerText=eval(" & json & ").value.ELEMENT;"
        If LCase(elm.innerText) = "null" Then
          ret = ""
        Else
          ret = elm.innerText
        End If
        doc.RemoveChild elm
    End Select
  End With
  On Error GoTo 0
  FindElement = ret
End Function
 
Private Sub SendKeysElement(ByVal sessionId, ByVal elementId, ByVal elmValue)
  On Error Resume Next
  With http
    .Open "POST", URI & "session/" & sessionId & "/element/" & elementId & "/value", False
    .send "{""value"":[""" & elmValue & """]}"
  End With
  On Error GoTo 0
End Sub
 
Private Sub ClickElement(ByVal sessionId, ByVal elementId)
  On Error Resume Next
  With http
    .Open "POST", URI & "session/" & sessionId & "/element/" & elementId & "/click", False
    .send
  End With
  On Error GoTo 0
End Sub
 
Private Function TakeScreenshot(ByVal sessionId)
'return screenshot as a base64 encoded PNG
  Dim ret
  Dim json
  Dim elm
   
  On Error Resume Next
  With http
    .Open "GET", URI & "session/" & sessionId & "/screenshot", False
    .send
    Select Case .Status
      Case 200
        json = "(" & .responseText & ")"
        Set elm = doc.createElement("span")
        elm.setAttribute "id", "result"
        doc.appendChild elm
        doc.parentWindow.execScript _
          "document.getElementById('result').innerText=eval(" & json & ").value;"
        If LCase(elm.innerText) = "null" Then
          ret = ""
        Else
          ret = elm.innerText
        End If
        doc.RemoveChild elm
    End Select
  End With
  On Error GoTo 0
  TakeScreenshot = ret
End Function
 
Private Sub EndSession(ByVal sessionId)
  On Error Resume Next
  With http
    .Open "DELETE", URI & "session/" & sessionId, False
    .send
  End With
  On Error GoTo 0
End Sub
 
Private Sub DecodeBase64(ByVal base64, ByVal filePath)
'decode a base64 string
  Dim elm
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
   
  On Error Resume Next
  Set elm = CreateObject("MSXML2.DOMDocument").createElement("base64")
  elm.DataType = "bin.base64"
  elm.Text = base64
  With CreateObject("ADODB.Stream")
    .Type = adTypeBinary
    .Open
    .Write elm.nodeTypedValue
    .SaveToFile filePath, adSaveCreateOverWrite
    .Close
  End With
  On Error GoTo 0
End Sub
 
Private Function GetScriptFolderPath()
  Dim ret
   
  With CreateObject("Scripting.FileSystemObject")
    ret = .GetParentFolderName(WScript.ScriptFullName)
  End With
  If Right(ret, 1) <> ChrW(92) Then ret = ret & ChrW(92)
  GetScriptFolderPath = ret
End Function