Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
[vbscript] CreateObject() servers name
#16
Hello Wil,
Finaly I have found a way to work with VBScript without WScript.CreateObject().
My code below.
Regards,
Bernard.
Code:
' Test of AntView ocx with VBScript and Scripting Window SystemObject ocx.
'
' Sorry for the error(s), I am AntView and Scripting Window SystemObject junior.
' I would be happy to have your comments on this script.
'
' Download the Scripting Window SystemObject ocx :
' http://veretennikov.org/Default.aspx?f=WSO%2fDefault.aspx
'
' This code is a basic sample.

Option Explicit

' Parameters.
Dim pu_cHtml  : pu_cHtml = bv_DirBase() & "\_Result_html.txt"   ' TXT source file created.
Dim pu_cPdf   : pu_cPdf  = bv_DirBase() & "\_Result_pdf.pdf"    ' PDF file created.
Dim pu_cProp  : pu_cProp  = bv_DirBase() & "\_Result_Props.txt" ' TXT EdgeWebBrowser properties file created.
Dim pu_cWeb   : pu_cWeb  = "c:\Url_UserDataFolder"              ' Webview2 files folder.
Dim pu_nSpace : pu_nSpace = 37                                  ' Spaces in the EdgeWebBrowser properties function.

' Private variables.
Dim cPids          ' String of PIDs of WebView2 arent running.
Dim Document       ' Object for AntViewAx.AntViewDocument.
Dim DoMenu         ' Object for the menus.
Dim EdgeWebBrowser ' Object for the AntView browser.
Dim Form           ' Object for the form window.
Dim MenuBar        ' Object for the menus.
Dim mBrowserProp   ' Object for the menu list properties of EdgeWebBrowser.
Dim mCookiesYes    ' Object for accept the cookies.
Dim mGetHtml       ' Object for get the html source.
Dim mNavigate      ' Object for menu navigate.
Dim mPrintToPdf    ' Object for menu print to pdf.
Dim oUrls          ' Object for the combobx.
Dim ReBar          ' Object for all menus.
Dim StatusBar      ' Object for the status bar.
Dim ToolBar        ' Object for the choices.
Dim Wso            ' Object for Scripting Window SystemObject.

' Look and kill the precedent msedgewebview2.exe if running.
cPids = bv_GetAllPidForExeRun( "msedgewebview2.exe" )
If Len( cPids ) > 0 Then
   If MsgBox( "Do you want to kill the old(s) msedgewebview2.exe ?", vbYesNo + vbQuestion, "Question" )= vbYes Then
      bv_KillAllExeByPids( cPids )
   End If
End If

' Create the Scripting Window SystemObject
On Error Resume Next
   Set Wso = WScript.CreateObject( "Scripting.WindowSystemObject" )
   If Err.Number <> 0 Then
      MsgBox( "***Error = " & Err.Number & ", Description = "  & Err.Description )
      Err.Clear
      wscript.Quit
   End If
On Error GoTo 0

' Create the window.
Set Form          = Wso.CreateForm()
Form.ClientWidth  = 800
Form.ClientHeight = 500
Form.CenterControl()
Form.Text    = "Test of AntView Web Browser"
Form.OnClose = GetRef( "Form_OnClose" )

' Create a menu bar.
Set ReBar   = Form.CreateReBar(    0, 0, 0, 0 )
Set MenuBar = ReBar.CreateMenuBar( 0, 0, 0, 25 )

' Create the 1st choice group.
Set DoMenu = MenuBar.Menu.Add( "Menu" )

' Create the choices of the 1st group.

Set mNavigate       = DoMenu.Add( "Navigate" )
mNavigate.OnExecute = GetRef( "Menu_Navigate" )

Set mCookiesYes       = DoMenu.Add( "Cookies Yes" )
mCookiesYes.OnExecute = GetRef( "Menu_CookiesYes" )

Set mPrintToPdf       = DoMenu.Add( "Print To Pdf" )
mPrintToPdf.OnExecute = GetRef( "Menu_PrintToPdf" )

Set mGetHtml       = DoMenu.Add( "Get Html" )
mGetHtml.OnExecute = GetRef( "Menu_GetHtml" )

Set mBrowserProp       = DoMenu.Add( "Browser Prop" )
mBrowserProp.OnExecute = GetRef( "Menu_BrowserProp" )

' Write a line and create the choice for quit.
DoMenu.Add "-"
DoMenu.Add( "Quit" ).OnExecute = GetRef( "Form_Close" )

' Create shortcuts buttons for menus.
Set ToolBar = ReBar.CreateToolBar( 0, 0, 0, 25 )
ToolBar.ShowText = true
ToolBar.Buttons.Add( mNavigate )
ToolBar.Buttons.Add( mCookiesYes )
ToolBar.Buttons.Add( mPrintToPdf )
ToolBar.Buttons.Add( mGetHtml )
ToolBar.Buttons.Add( mBrowserProp )

' Create a combobox for select or write an URL address.
Set oUrls = ReBar.CreateComboBox( 0, 0, 100, 25 )
ReBar.Band( oUrls ).Text = "Address"
oUrls.Add( "https://www.cabinet-louis-reynaud.eu/index.php/clr-labs-3/" )
oUrls.Add( "https://antview.dev/" )
oUrls.Add( "https://www.google.fr/" )
oUrls.Text = ""

' Create a status bar.
Set StatusBar                 = Form.CreateStatusBar()
StatusBar.Add( 100 ).AutoSize = True
StatusBar.Item( 0 ).Text      = "Select something in the menu"

' Create the AntView ActiveX.
Set EdgeWebBrowser   = Form.CreateActiveXControl( 0, 0, 0, 0, "{7E146B1D-42ED-4386-904F-9A9EDB61F9AE}" )
EdgeWebBrowser.Align = Wso.Translate( "AL_CLIENT" )

' CreateWebView() failed if use defaut directory.
EdgeWebBrowser.Control.UserDataFolder = pu_cWeb

' AntView ActiveX events functions to execute.
EdgeWebBrowser.Events.OnExecuteScript       = GetRef( "EdgeWebBrowser_OnExecuteScript"       )
EdgeWebBrowser.Events.OnNavigationCompleted = GetRef( "EdgeWebBrowser_OnNavigationCompleted" )
EdgeWebBrowser.Events.OnPrintToPdfCompleted = GetRef( "EdgeWebBrowser_OnPrintToPdfCompleted" )

' *** Form events functions. ***

Sub Form_OnClose()
   EdgeWebBrowser.Control.CloseBrowserProcess
   EdgeWebBrowser.Control.CloseWebView
End Sub

' *** EdgeWebBrowser events functions. ***

Sub Document_OnRequestCurrentHtml( cHtml )
   ReBar.Enabled = True
   bv_MemoWritU pu_cHtml, cHtml
   bv_Run pu_cHtml, 1, False
   StatusBar.Item( 0 ).Text = "Select something in the menu"
End Sub

Sub EdgeWebBrowser_OnExecuteScript( HResult, JsonObject )
   ReBar.Enabled = True
   If Not HResult = 0 Then
      MsgBox "ExecuteScript() fail, HResult = " & Cstr( HResult ) & "."
   End If
   StatusBar.Item( 0 ).Text = "Select something in the menu"
End Sub

Sub EdgeWebBrowser_OnNavigationCompleted( IsSuccess, WebErrorStatus, NavigationId )
   ReBar.Enabled = True
   If Not IsSuccess Then
      MsgBox "Navigation error = " & CStr( WebErrorStatus ) & "."
   End If
   StatusBar.Item( 0 ).Text = "Select something in the menu"
End Sub

Sub EdgeWebBrowser_OnPrintToPdfCompleted( HResult, IsSuccessful )
   ReBar.Enabled = True
   If IsSuccessful Then
      bv_Run pu_cPdf, 1, False
   Else
      MsgBox "PrintToPdf() fail, HResult = " & CStr( HResult ) & "."
   End If
   StatusBar.Item( 0 ).Text = "Select something in the menu"
End Sub

' *** Menu functions.

Sub Menu_CookiesYes()
   Dim cUrl
   Dim cJscript
   If Len( EdgeWebBrowser.Control.DocumentTitle ) < 1 Then
      MsgBox "You must to navigate befor run this function."
      Exit Sub
   End If
   StatusBar.Item( 0 ).Text = "Accept the cookies"
   cUrl = oUrls.Text
   If cUrl = "https://www.cabinet-louis-reynaud.eu/index.php/clr-labs-3/" Then
      cJscript = "var button = document.getElementsByClassName(""cmplz-accept"");" & vbCrLf
      cJscript = cJscript & "button[0].click();"
   ElseIf cUrl = "https://www.google.fr/" Then
      cJscript = "var button = document.getElementsByClassName(""QS5gu sy4vM"");" & vbCrLf
      cJscript = cJscript & "button[1].click();" ' button[0] = not accept.
   Else
      MsgBox "Code in not in this script for this URL."
      Exit Sub
   End If
   ReBar.Enabled = False
   EdgeWebBrowser.Control.ExecuteScript cJscript
   ' The next is in EdgeWebBrowser_OnExecuteScript()
End Sub

Sub Menu_GetHtml
   If Len( EdgeWebBrowser.Control.DocumentTitle ) < 1 Then
      MsgBox "You must to navigate befor run this function."
      Exit Sub
   End If
   StatusBar.Item( 0 ).Text = "Get the html source"
   bv_fErase( pu_cHtml )
   ReBar.Enabled = False
   Document.RequestCurrentHtml()
   ' The next is in Document_OnRequestCurrentHtml()
End Sub

Sub Menu_Navigate()
   Dim i    ' Count variable.
   If Len( oUrls.Text ) < 5 Then
      MsgBox "No URL selected !"
      Exit Sub
   End If
   ReBar.Enabled = False
   If Not EdgeWebBrowser.Control.WebViewCreated Then
      StatusBar.Item( 0 ).Text = "Create a WebViewver"
      EdgeWebBrowser.Control.CreateWebView
      For i = 1 to 60 Step 1
         If EdgeWebBrowser.Control.WebViewCreated Then Exit For
         bv_Sleep( 1 )
      Next
      If Not EdgeWebBrowser.Control.WebViewCreated Then
         ReBar.Enabled = True
         MsgBox "WebViewCreated() fail !"
         StatusBar.Item( 0 ).Text = "Select something in the menu"
         Exit Sub
      End If
      Set Document = Wscript.CreateObject( "AntViewAx.AntViewDocument", "Document_" )
      Document.BrowserDispatch( EdgeWebBrowser.Control.IDispatchPointer )
   End If
   StatusBar.Item( 0 ).Text = "Navigate URL = " & oUrls.Text
   EdgeWebBrowser.Control.Navigate( oUrls.Text )
   ' The next is in EdgeWebBrowser_OnNavigationCompleted()
End Sub

Sub Menu_PrintToPdf
   If Len( EdgeWebBrowser.Control.DocumentTitle ) < 1 Then
      MsgBox "You must to navigate befor run this function."
      Exit Sub
   End If
   StatusBar.Item( 0 ).Text = "Print to pdf"
   ReBar.Enabled = False
   bv_fErase( pu_cPdf )
   EdgeWebBrowser.Control.PrintToPdf pu_cPdf, ""
   ' The next is in EdgeWebBrowser_OnPrintToPdfCompleted()
End Sub

Sub Menu_BrowserProp()
   Dim cProps
   bv_fErase( pu_cProp )
   cProps = "EdgeWebBrowser properties." & vbCrLf
   cProps = cProps & "!"     & String( pu_nSpace    , "-" )& "!-------------!" & vbCrLf
   cProps = cProps & "!Name" & String( pu_nSpace - 4, " ") & "!Type         !Value" & vbCrLf
   cProps = cProps & "!"     & String( pu_nSpace    , "-") & "!-------------!" & vbCrLf
   On Error Resume Next : cProps = cProps & WriteProperty( "Active"                                , EdgeWebBrowser.Control.Active                                 ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AdditionalBrowserArguments"            , EdgeWebBrowser.Control.AdditionalBrowserArguments             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AlignDisabled"                         , EdgeWebBrowser.Control.AlignDisabled                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AlignWithMargins"                      , EdgeWebBrowser.Control.AlignWithMargins                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AllowSingleSignOnUsingOSPrimaryAccount", EdgeWebBrowser.Control.AllowSingleSignOnUsingOSPrimaryAccount ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AlignDisabled"                         , EdgeWebBrowser.Control.AlignDisabled                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AutoScroll"                            , EdgeWebBrowser.Control.AutoScroll                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AutoSize"                              , EdgeWebBrowser.Control.AutoSize                               ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "AxBorderStyle"                         , EdgeWebBrowser.Control.AxBorderStyle                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BorderWidth"                           , EdgeWebBrowser.Control.BorderWidth                            ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BrowserAcceleratorKeysEnabled"         , EdgeWebBrowser.Control.BrowserAcceleratorKeysEnabled          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BrowserProcessID"                      , EdgeWebBrowser.Control.BrowserProcessID                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BrowserProcessIDLong"                  , EdgeWebBrowser.Control.BrowserProcessIDLong                   ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BrowserVersionString"                  , EdgeWebBrowser.Control.BrowserVersionString                   ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "BuiltInErrorPageEnabled"               , EdgeWebBrowser.Control.BuiltInErrorPageEnabled                ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "CanGoBack"                             , EdgeWebBrowser.Control.CanGoBack                              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "CanGoForward"                          , EdgeWebBrowser.Control.CanGoForward                           ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Caption"                               , EdgeWebBrowser.Control.Caption                                ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Color"                                 , EdgeWebBrowser.Control.Color                                  ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ContainsFullScreenElement"             , EdgeWebBrowser.Control.ContainsFullScreenElement              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Controller"                            , EdgeWebBrowser.Control.Controller                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "CookieManager"                         , EdgeWebBrowser.Control.CookieManager                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "CreateWebViewOnCreate"                 , EdgeWebBrowser.Control.CreateWebViewOnCreate                  ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "CurrentPPI"                            , EdgeWebBrowser.Control.CurrentPPI                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DefaultContextMenusEnabled"            , EdgeWebBrowser.Control.DefaultContextMenusEnabled             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DefaultInterface"                      , EdgeWebBrowser.Control.DefaultInterface                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DefaultScriptDialogsEnabled"           , EdgeWebBrowser.Control.DefaultScriptDialogsEnabled            ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DefaultUserDataFolderLocation"         , EdgeWebBrowser.Control.DefaultUserDataFolderLocation          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DemoDaysLeft"                          , EdgeWebBrowser.Control.DemoDaysLeft                           ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DevToolsEnabled"                       , EdgeWebBrowser.Control.DevToolsEnabled                        ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DockSite"                              , EdgeWebBrowser.Control.DockSite                               ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DocumentTitle"                         , EdgeWebBrowser.Control.DocumentTitle                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DoubleBuffered"                        , EdgeWebBrowser.Control.DoubleBuffered                         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DownloadDialogCornerAlignment"         , EdgeWebBrowser.Control.DownloadDialogCornerAlignment          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "DropTarget"                            , EdgeWebBrowser.Control.DropTarget                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Enabled"                               , EdgeWebBrowser.Control.Enabled                                ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Environment"                           , EdgeWebBrowser.Control.Environment                            ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "EventsUseHexadecimal"                  , EdgeWebBrowser.Control.EventsUseHexadecimal                   ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ExplicitHeight"                        , EdgeWebBrowser.Control.ExplicitHeight                         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ExplicitLeft"                          , EdgeWebBrowser.Control.ExplicitLeft                           ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ExplicitTop"                           , EdgeWebBrowser.Control.ExplicitTop                            ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ExplicitWidth"                         , EdgeWebBrowser.Control.ExplicitWidth                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Font"                                  , EdgeWebBrowser.Control.Font                                   ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "GeneralAutofillEnabled"                , EdgeWebBrowser.Control.GeneralAutofillEnabled                 ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "HelpFile"                              , EdgeWebBrowser.Control.HelpFile                               ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "IDispatchPointer"                      , EdgeWebBrowser.Control.IDispatchPointer                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "KeyPreview"                            , EdgeWebBrowser.Control.KeyPreview                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Language"                              , EdgeWebBrowser.Control.Language                               ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "LastErrorCode"                         , EdgeWebBrowser.Control.LastErrorCode                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "LastErrorMessage"                      , EdgeWebBrowser.Control.LastErrorMessage                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "MouseInClient"                         , EdgeWebBrowser.Control.MouseInClient                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Muted"                                 , EdgeWebBrowser.Control.Muted                                  ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "NextFocusWindowHandle"                 , EdgeWebBrowser.Control.NextFocusWindowHandle                  ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "NextFocusWindowHandleUInt"             , EdgeWebBrowser.Control.NextFocusWindowHandleUInt              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ParentCustomHint"                      , EdgeWebBrowser.Control.ParentCustomHint                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ParentDoubleBuffered"                  , EdgeWebBrowser.Control.ParentDoubleBuffered                   ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PasswordAutosaveEnabled"               , EdgeWebBrowser.Control.PasswordAutosaveEnabled                ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PixelsPerInch"                         , EdgeWebBrowser.Control.PixelsPerInch                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PopupMode"                             , EdgeWebBrowser.Control.PopupMode                              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PreviousFocusWindowHandle"             , EdgeWebBrowser.Control.PreviousFocusWindowHandle              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PreviousFocusWindowHandleUInt"         , EdgeWebBrowser.Control.PreviousFocusWindowHandleUInt          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "PrintScale"                            , EdgeWebBrowser.Control.PrintScale                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Scaled"                                , EdgeWebBrowser.Control.Scaled                                 ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ScaleFactor"                           , EdgeWebBrowser.Control.ScaleFactor                            ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ScreenSnap"                            , EdgeWebBrowser.Control.ScreenSnap                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ScriptEnabled"                         , EdgeWebBrowser.Control.ScriptEnabled                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Settings"                              , EdgeWebBrowser.Control.Settings                               ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "SizeRatio"                             , EdgeWebBrowser.Control.SizeRatio                              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "SnapBuffer"                            , EdgeWebBrowser.Control.SnapBuffer                             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Source"                                , EdgeWebBrowser.Control.Source                                 ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "StatusBarEnabled"                      , EdgeWebBrowser.Control.StatusBarEnabled                       ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "StatusBarText"                         , EdgeWebBrowser.Control.StatusBarText                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "StyleName"                             , EdgeWebBrowser.Control.StyleName                              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "SynchronousTimeOut"                    , EdgeWebBrowser.Control.SynchronousTimeOut                     ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "TargetCompatibleBrowserVersion"        , EdgeWebBrowser.Control.TargetCompatibleBrowserVersion         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "UseDockManager"                        , EdgeWebBrowser.Control.UseDockManager                         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "UserAgent"                             , EdgeWebBrowser.Control.UserAgent                              ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "UserDataFolder"                        , EdgeWebBrowser.Control.UserDataFolder                         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "VersionString"                         , EdgeWebBrowser.Control.VersionString                          ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "Visible"                               , EdgeWebBrowser.Control.Visible                                ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "VisibleDockClientCount"                , EdgeWebBrowser.Control.VisibleDockClientCount                 ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "WebMessageEnabled"                     , EdgeWebBrowser.Control.WebMessageEnabled                      ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "WebResourceResponseReceivedEnabled"    , EdgeWebBrowser.Control.WebResourceResponseReceivedEnabled     ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "WebView2LoaderPath"                    , EdgeWebBrowser.Control.WebView2LoaderPath                     ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "WebViewCreated"                        , EdgeWebBrowser.Control.WebViewCreated                         ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "WindowClosedRequestEnabled"            , EdgeWebBrowser.Control.WindowClosedRequestEnabled             ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ZoomControlEnabled"                    , EdgeWebBrowser.Control.ZoomControlEnabled                     ) : Err.Clear : On Error GoTo 0
   On Error Resume Next : cProps = cProps & WriteProperty( "ZoomFactor"                            , EdgeWebBrowser.Control.ZoomFactor                             ) : Err.Clear : On Error GoTo 0
   cProps = cProps & "!"     & String( pu_nSpace    , "-") & "!-------------!" & vbCrLf
   bv_MemoWritU pu_cProp, cProps
   bv_Run pu_cProp, 1, False
End Sub

Function WriteProperty( cName, xProperty )
   Dim cStringe  ' String created.
   cStringe      = "!" & cName & String( pu_nSpace - Len( cName ), " ") & "!"
   cStringe      = cStringe & TypeName( xProperty ) & String( 13 - Len( TypeName ( xProperty ) ), " ") & "!"
   WriteProperty = cStringe & xProperty & vbCrLf
End Function

Sub Form_Close( Sender )
   Sender.Form.Close()
End Sub

Form.Show()
Wso.Run()

Set Document       = Nothing
Set EdgeWebBrowser = Nothing
Set Form           = Nothing
Set Wso            = Nothing

wscript.Quit

' *** Tools functions. ***

' Get the default directory.
Function bv_DirBase()
   bv_DirBase = Left( WScript.ScriptFullName, InStrRev( WScript.ScriptFullName, "\" ) )
End Function

' Erase a file.
Sub bv_fErase( cFile_bv )
   Dim oFso_bv
   Set oFso_bv = CreateObject( "Scripting.FileSystemObject" )
   If oFso_bv.FileExists( cFile_bv ) Then
      oFso_bv.DeleteFile cFile_bv
   End If
   Set oFso_bv = Nothing
End Sub

' Get a string with coma with the PIDs of an exe is running.
Function bv_GetAllPidForExeRun( cExe_bv )
   Dim cPids_bv
   Dim oPid_bv
   Dim oLocator_bv
   Dim oProcess_bv
   Dim oWMI_bv
   Set oLocator_bv = CreateObject( "WbemScripting.SWbemLocator" )
   Set oWMI_bv     = oLocator_bv.ConnectServer( ".", "root\cimv2" )
   oWMI_bv.Security_.ImpersonationLevel = 3
   Set oProcess_bv = oWMI_bv.ExecQuery( "Select * from Win32_Process where Name = '" & cExe_bv & "'" )
   cPids_bv        = ""
   For each oPid_bv in oProcess_bv
      cPids_bv = cPids_bv & Cstr( oPid_bv.ProcessId ) & ","
   Next
   Set oPid_bv           = Nothing
   Set oLocator_bv       = Nothing
   Set oProcess_bv       = Nothing
   Set oWMI_bv           = Nothing
   bv_GetAllPidForExeRun = cPids_bv
End Function

' Kill all exe by pids ( paramater string of pids with coma ).
' Depends : bv_KillExeByPid()
Function bv_KillAllExeByPids( cPids_bv )
   Dim cReturn_bv
   Dim cPid_bv
   Dim cString_bv
   Dim i_bv
   cString_bv = cPids_bv
   cReturn_bv = ""
   Do While ( True )
      i_bv    = InStr( cString_bv, "," )
      If i_bv = 0 Then Exit Do
      cPid_bv = Left(  cString_bv, i_bv - 1 )
      If Len( cPid_bv ) = 0 Then Exit Do
      cReturn_bv = cReturn_bv  & bv_KillExeByPid( cPid_bv )
      cString_bv = Right( cString_bv, Len( cString_bv ) - i_bv )
      If Len( cString_bv ) = 0 Then Exit Do
   Loop
   bv_KillAllExeByPids = cReturn_bv
End Function

' Kill an exe with his PID.
Function bv_KillExeByPid( cPid_bv )
   Dim cReturn_bv
   Dim oPid_bv
   Dim oLocator_bv
   Dim oProcess_bv
   Dim oWMI_bv
   Set oLocator_bv = CreateObject( "WbemScripting.SWbemLocator" )
   Set oWMI_bv     = oLocator_bv.ConnectServer( ".", "root\cimv2" )
   oWMI_bv.Security_.ImpersonationLevel = 3
   Set oProcess_bv = oWMI_bv.ExecQuery( "Select * from Win32_Process where ProcessId = " & cPid_bv )
   cReturn_bv = ""
   For each oPid_bv in oProcess_bv
      cReturn_bv = cReturn_bv & cPid_bv & " "
      On Error Resume Next
         oPid_bv.Terminate
         If Err.Number <> 0 Then
            cReturn_bv = cReturn_bv & "Not "
            Err.Clear
         End If
      On Error GoTo 0
      cReturn_bv = cReturn_bv & "Killed" & vbCrLf
   Next
   Set oPid_bv     = Nothing
   Set oLocator_bv = Nothing
   Set oProcess_bv = Nothing
   Set oWMI_bv     = Nothing
   bv_KillExeByPid = cReturn_bv
End Function

' Write a string in a file : charset = UNICODE.
Sub bv_MemoWritU( cFile_bv, cString_bv )
   Dim oFile_bv
   Dim oFso_bv
   Dim ForWriting   : ForWriting   =  2
   Dim TristateTrue : TristateTrue = -1
   Set oFso_bv = CreateObject( "Scripting.FileSystemObject" )
   If oFso_bv.FileExists( cFile_bv ) Then
      oFso_bv.DeleteFile cFile_bv
   End If
   Set oFile_bv = oFso_bv.OpenTextFile( cFile_bv, ForWriting, True, TristateTrue )
   oFile_bv.Write cString_bv
   oFile_bv.Close
   Set oFile_bv = Nothing
   Set oFso_bv  = Nothing
End Sub

' Run with options.
Sub bv_Run( cRun_bv, cDisplay_bv, lStop_bv )
   CreateObject( "WScript.Shell" ).Run cRun_bv, cDisplay_bv, lStop_bv
End Sub

' Pause in script in second(s).
Sub bv_Sleep( nSeconds_bv )
   WScript.Sleep Int( nSeconds_bv * 1000 )
End Sub
Reply


Messages In This Thread
RE: [vbscript] CreateObject() servers name - by Bernard Mouille - 2023-02-16, 23:31:18

Forum Jump:


Users browsing this thread: 1 Guest(s)