在HTA VBScript中打开IE - 不支持“导航”

时间:2017-07-17 22:28:56

标签: internet-explorer vbscript hta

出于特定原因,我正在尝试从HTA中打开Internet Explorer窗口并导航到特定的URL。

经过一番搜索,我发现了下面的解决方案。我成功打开了Internet Explorer,但是我被告知IE对象不支持Navigate?

<!DOCTYPE html>
<html lang="en">
<head>
    <title>Test</title>

    <hta:application
        id="oHTA"
        applicationname="Test"
        application="yes"
        icon=""
    >
    </hta:application>

    <script language="VBScript">
        Sub Sleep(seconds)
            CreateObject("WScript.Shell").Run "%COMSPEC% /c ping 127.0.0.1 -n " & seconds+1, 0, True
        End Sub

        Function openGoogle()

            Set webBrowser = CreateObject("InternetExplorer.Application")
            webBrowser.Visible = True
            webBrowser.Navigate = "https://google.co.uk/"

            Do While webBrowser.ReadyState <> 4 Or webBrowser.Busy
                Sleep 5
            Loop

        End Function

        openGoogle()

    </script>

</head>

<body>
    <h1>Test</h1>
</body>

</html>

2 个答案:

答案 0 :(得分:0)

您可以看一下:HTA opens internet explorer on enterbutton

而且,您可以从这个旧的HTA(法语版)中获得灵感,它允许您从命令行启动一些命令,因此,您可以打开系统上安装的任何浏览器的任何链接!

试试这段代码:

<html>
<head>
<HTA:APPLICATION
APPLICATIONNAME="Ouvrir des liens avec les navigateurs IE,Chrome et Firefox"
BORDER="THIN"
BORDERSTYLE="NORMAL"
ICON="Explorer.exe"
INNERBORDER="NO"
MAXIMIZEBUTTON="NO"
MINIMIZEBUTTON="NO"
SCROLL="NO"
SELECTION="NO"
SINGLEINSTANCE="YES"/>
<META HTTP-EQUIV="MSThemeCompatible" CONTENT="YES">
<title>Ouvrir des liens avec les navigateurs IE,Chrome et Firefox</title>
<SCRIPT LANGUAGE="VBScript">
'******
Option Explicit
 Function Executer(StrCmd,Console)
 Dim ws,MyCmd,Resultat
 Set ws = CreateObject("wscript.Shell")
'La valeur 0 pour cacher la console MS-DOS
 If Console = 0 Then
 MyCmd = "CMD /C " & StrCmd & " "
 Resultat = ws.run(MyCmd,Console,True)
 If Resultat = 0 Then
 'MsgBox "Success"
 Else
 MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
 End If
 End If
'La valeur 1 pour montrer la console MS-DOS
 If Console = 1 Then
 MyCmd = "CMD /K " & StrCmd & " "
 Resultat = ws.run(MyCmd,Console,False)
 If Resultat = 0 Then
 'MsgBox "Success"
 Else
 MsgBox "Une erreur inconnue est survenue !",16,"Une erreur inconnue est survenue !"
 End If
 End If
 Executer = Resultat
End Function
'******
Sub window_onload()
 CenterWindow 400,320
End Sub
'******
Sub CenterWindow(x,y)
 Dim iLeft,itop
 window.resizeTo x,y
 iLeft = window.screen.availWidth/2 - x/2
 itop = window.screen.availHeight/2 - y/2
 window.moveTo ileft,itop
End Sub
'******
Sub Ip_Publique()
 Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public
 Titre = "Adresse Ip Publique !"
 URL = "http://monip.org"
 If OnLine("smtp.gmail.com") = True Then
 Set ie = CreateObject("InternetExplorer.Application")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 ie.Navigate (URL)
 ie.Visible=False
 DO WHILE ie.busy
 Sleep 100
 Loop
 Data = ie.document.documentElement.innertext
 Set objRegex = new RegExp
 objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
 objRegex.Global = False
 objRegex.IgnoreCase = True
 Set Matches = objRegex.Execute(Data)
 For Each Match in Matches
 MsgBox "Votre IP Publique est : "& Match.Value,64,Titre
 Next
 ie.Quit
 Set ie = Nothing
 Else
 MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
 Exit Sub
 End If
End Sub

'******
Sub Sleep(MSecs)'Fonction pour faire une pause car wscript.sleep ne marche pas dans un HTA
 Dim fso,objOutputFile
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim tempFolder : Set tempFolder = fso.GetSpecialFolder(2)
    Dim tempName : tempName = "Sleeper.vbs"
    If Fso.FileExists(tempFolder&"\"&tempName)=False Then
      Set objOutputFile = fso.CreateTextFile(tempFolder&"\"&tempName, True)
      objOutputFile.Write "wscript.sleep WScript.Arguments(0)"
      objOutputFile.Close
    End If
    CreateObject("WScript.Shell").Run tempFolder&"\"&tempName &" "& MSecs,1,True
End Sub
'******
Sub SSID_names()
Dim objShell,fso,File,strContents,objRegEx,objMatch,colMatches
 set objShell = CreateObject("WScript.Shell")
 Set fso = CreateObject("Scripting.FileSystemObject")
 If Executer("netsh wlan show all > Wlan.txt",0) = 0 Then
 Set File = fso.OpenTextFile("Wlan.txt",1)
 strContents = File.ReadAll
 Set objRegEx = New RegExp
 objRegEx.IgnoreCase = True
 objRegEx.Global = True
 objRegEx.Multiline = True
 objRegEx.Pattern = """([^""]+)"""
 set colMatches = objRegEx.Execute(strContents)
 For each objMatch in colMatches
 MsgBox "SSID name: " & objMatch.Value,64,"SSID name"
 Next
 End If
End sub
'******
Function OnLine(strHost)
Dim objPing,z,objRetStatus,PingStatus
    Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
    z = 0
    Do   
      z = z + 1
      For Each objRetStatus In objPing
      If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
            PingStatus = False
      Else
            PingStatus = True
      End If     
    Next   
      sleep 200
      If z = 4 Then Exit Do
    Loop until PingStatus = True
    If PingStatus = True Then
      OnLine = True
    Else
      OnLine = False
    End If
End Function
'******
Sub WLAN_Networks()
 If Executer("netsh wlan show profiles > Wlan_tmp.txt & netsh wlan show networks >> Wlan_tmp.txt & netsh wlan show interfaces >> Wlan_tmp.txt & cmd /U /C Type Wlan_tmp.txt > Wlan_Networks.txt",0) = 0 Then
 Call Executer("Start Wlan_Networks.txt & Del Wlan_tmp.txt",0)
 End If
End Sub
</script>
</head>
<p>Une liste de liens :</p>
<ol>
<li><a href="#" onClick="Call Executer('Start iexplore.exe www.google.com',0)">Lien Google avec iexplore.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe http://bbat.forumeiro.com/',0)">Lien BBAT avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start Firefox.exe www.developpez.net',0)">Lien developpez.net avec Firefox.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.yahoo.fr',0)">Lien Yahoo avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.fr',0)">Lien Autoitscript.fr (Français) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start chrome.exe www.autoitscript.com',0)">Lien autoitscript.com (Anglais) avec Chrome.exe</a></li>
<li><a href="#" onClick="Call Executer('Start www.sfr.fr',0)">Lien SFR avec votre navigateur par défaut</a></li>
</ol>
<BODY text=white bgcolor="DarkOrange" TOPMARGIN="1" LEFTMARGIN="1">
 <center><button onclick="Call Executer('mode con cols=90 lines=15 & Color 0A & Title Ping sur www.developpez.net by Hackoo & Ping www.developpez.net',1)">Ping sur developpez.net</button>
 <center><button onclick="Call Executer('FindStr /? > HelpFindStrTmp.txt & cmd /U /C Type HelpFindStrTmp.txt > HelpFindStr.txt & start HelpFindStr.txt',0)">Help sur FindStr</button>
 <button onclick="Call Executer('ipconfig /all > configTmp.txt & cmd /U /C Type configTmp.txt > MyIPconfig.txt & start MyIPconfig.txt',0)">IpConfig</button>
 <button onclick="Call Executer('mode con cols=80 lines=50 & Color 9B & Title Hackoo & netstat -a',1)">Netstat</button>
 <button onclick="Call Executer('mode con cols=60 lines=10 & Color 0A & Title Hackoo & arp -a',1)">Arp</button>
 <button onclick="Call Executer('mode con cols=80 lines=30 & Color 9B & Title Tracert vers www.developpez.com by Hackoo & Tracert www.developpez.com',1)">Tracert</button><br>
 <center><button onclick="Call Ip_Publique">IP Publique</button>
 <button onclick="Call SSID_names()">SSID WLAN</button>
  <button onclick="Call WLAN_Networks()">WLAN Network</button>
 </center>
 </center>
</body>
</html> 

答案 1 :(得分:0)

Navigate是子程序而不是属性。变化

webBrowser.Navigate = "https://google.co.uk/"

webBrowser.Navigate "https://google.co.uk/"