[问题求助] VBS能否获取正在打开的网址并判断？

ww0000

写一段VBS，设定一个或两个网址，运行代码后，只要指定的网址一打开，就会跳出警告框！
最好还能有个倒计时关闭这个网页的功能！谢谢

ww0000

下面一段是转帖过来的，应用在VB上，通过取得ie句柄获得ie的url，希望对你有帮助：
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim dWinFolder As SHDocVw.ShellWindows  
Set dWinFolder = New SHDocVw.ShellWindows  
Dim objIE1 As SHDocVw.InternetExplorer  
Dim ActID As Long  
Dim myUrl as String   
ActID = FindWindow("IEFrame", vbNullString)
For Each objIE1 In dWinFolder  
  '过滤掉windows资源管理器的窗口  
　　If InStr(1, objIE1.FullName, "IEXPLORE.EXE", vbTextCompare) <> 0 Then  
  '是否是当前正在浏览的IE窗口  
  If objIE1.hWnd = ActID Then  
  '执行程序  
  myUrl = objIE1.LocationURL     '取得地址
  End If  
  End If  
Next

batman

1秒检测一次，要终止的话只要在VBS所在目录下新建一个finish（无后缀）的文件即可：

Do Until CreateObject("Scripting.FileSystemObject").FileExists("finish")
  Dim Urls
  '自已添加想要延时关闭的网页标题关键词到Urls集合中，中间以逗号分隔
  Urls = Array("百度一下", "新浪首页")
  Dim objSHELL
  Set objSHELL = CreateObject("Wscript.Shell")
  Dim objWORD, objTasks, objTask, objStr
  Set objWORD = CreateObject("Word.Application") 
  Set objTasks = objWORD.Tasks
  For Each objTask in objTasks
    If objTask.Visible Then 
      For i = 0 To UBound(Urls) 
        If InStr(objTask.Name, Urls(i)) Then
          objStr = Split(objTask.Name, " ")(0)
          objSHELL.Popup "五秒后将自动关闭“" & objStr & "”窗口", 5
          objTask.Close
        End If
      Next
    End If 
  Next 
  objWORD.Quit
  Set objWORD = Nothing
  Set objSHELL = Nothing
  WScript.Sleep 1000 
Loop
复制代码

ww0000

回复 3# batman


    谢谢老师，Urls = Array("百度一下", "新浪首页")

能不能换成网址？

Urls = Array("http://www.baidu.com/", "http://www.sina.com.cn/")

ww0000

打开时还会出现这个?怎么回事?

batman

Dim Urls, Arr
Urls = "http://www.baidu.com,http://www.sina.com.cn"
Arr = Split(Urls, ",")
Dim objIE, objTitles
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = False
For i = 0 To UBound(Arr)
  objIE.Navigate Arr(i)
  Do Until objIE.ReadyState = 4 : WScript.Sleep 200 : Loop
  objTitles = objTitles & objIE.Document.GetElementsByTagName("title")(0).InnerText & "@#$"
Next
objIE.Quit
Set objIE = Nothing
Arr = Split(objTitles, "@#$")
Do Until CreateObject("Scripting.FileSystemObject").FileExists("finish")
  Dim objSHELL
  Set objSHELL = CreateObject("Wscript.Shell")
  Dim objWORD, objTasks, objTask, objStr
  Set objWORD = CreateObject("Word.Application") 
  Set objTasks = objWORD.Tasks
  For Each objTask in objTasks
    On Error Resume Next
    If objTask.Visible Then 
      For i = 0 To UBound(Arr) - 1
        If InStr(objTask.Name, Arr(i)) Then
          objStr = Split(objTask.Name, " ")(0)
          objSHELL.Popup "五秒后将自动关闭“" & objStr & "”窗口", 5
          objTask.Close
          If Err.Number <> 0 Then Err.Clear
        End If
      Next
    End If 
  Next 
  objWORD.Quit
  Set objWORD = Nothing
  Set objSHELL = Nothing
  WScript.Sleep 1000 
Loop
复制代码

ww0000

回复 6# batman


    谢谢老师,你真的很厉害!!

ww0000

回复 6# batman


    但是老师还有一个问题呀，只要是已经执行了这个程序，再执行一次，就会出现上面那个窗口，会提示WORD已经被另一个用户或程序使用，怎么关也关不了！！
看进程，里面有许多的WINWORD.EXE在运行,怎么办??

batman

那是因为你没有关闭开始的wscript.exe，你没看我在三楼的说明吗？

ww0000

回复 9# batman

秒检测一次，要终止的话只要在VBS所在目录下新建一个finish（无后缀）的文件即可?


finish有什么作用?

ww0000

回复 9# batman


    老师，真的不好意思！测试了一下，又发现一个问题，

就是在运行这个代码前，必须已经有一个网站打开了，不然就会打开代码里设定要监控的网站，并出现下面的提示！

ww0000

回复 3# batman

这是个对比IP的代码，能不能达到你上面的功能？谢谢！

on error resume next
AllowIP="192.168.1.100"
set ws=CreateObject("wscript.shell")
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")
For Each objItem in colItems
    For Each objAddress in objItem.IPAddress
        If objAddress <> "" then NowIP = objAddress
        exit for
    Next
Next
if AllowIP<>NowIP then
ws.popup "IP非法！",5,"提示",48
wscript.quit
end if

czjt1234

只能检测网页标题栏并关闭

ww0000

回复 13# czjt1234


    6楼的代码能达到要求，但执行代码前必须是已经有一个窗口打开了，不然就会打开代码中设定的窗口！

zhangop9

获取正在打开的网址