批处理之家 - Powered by Discuz! Board

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

作者: ww0000 时间: 2013-1-20 12:43 标题: VBS能否获取正在打开的网址并判断？

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

作者: ww0000 时间: 2013-1-20 12:44

下面一段是转帖过来的，应用在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 时间: 2013-1-20 14:34

本帖最后由 batman 于 2013-1-20 14:45 编辑

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 时间: 2013-1-20 14:59

回复 3# batman

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

能不能换成网址？

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

作者: ww0000 时间: 2013-1-20 15:03

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

作者: batman 时间: 2013-1-20 15:34

本帖最后由 batman 于 2013-1-20 18:51 编辑

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 时间: 2013-1-20 15:59

回复 6# batman

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

作者: ww0000 时间: 2013-1-20 16:07

回复 6# batman

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

作者: batman 时间: 2013-1-20 16:11

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

作者: ww0000 时间: 2013-1-20 16:25

回复 9# batman

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

finish有什么作用?

作者: ww0000 时间: 2013-1-20 16:35

回复 9# batman

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

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

作者: ww0000 时间: 2013-1-20 20:12

回复 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 时间: 2013-1-22 09:22

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

作者: ww0000 时间: 2013-1-22 10:33

回复 13# czjt1234

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

作者: zhangop9 时间: 2021-1-6 17:31

获取正在打开的网址

欢迎光临批处理之家 (http://bathome.net./)

Powered by Discuz! 7.2