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

ww0000

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

zhangop9

获取正在打开的网址

ww0000

回复 13# czjt1234


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

czjt1234

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

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

ww0000

回复 9# batman


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

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

ww0000

回复 9# batman

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


finish有什么作用?

batman

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

ww0000

回复 6# batman


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

ww0000

回复 6# batman


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

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

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

ww0000

回复 3# batman


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

能不能换成网址？

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

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

下面一段是转帖过来的，应用在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