[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

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

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

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

TOP

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

1秒检测一次,要终止的话只要在VBS所在目录下新建一个finish(无后缀)的文件即可:
  1. Do Until CreateObject("Scripting.FileSystemObject").FileExists("finish")
  2.   Dim Urls
  3.   '自已添加想要延时关闭的网页标题关键词到Urls集合中,中间以逗号分隔
  4.   Urls = Array("百度一下", "新浪首页")
  5.   Dim objSHELL
  6.   Set objSHELL = CreateObject("Wscript.Shell")
  7.   Dim objWORD, objTasks, objTask, objStr
  8.   Set objWORD = CreateObject("Word.Application")
  9.   Set objTasks = objWORD.Tasks
  10.   For Each objTask in objTasks
  11.     If objTask.Visible Then
  12.       For i = 0 To UBound(Urls)
  13.         If InStr(objTask.Name, Urls(i)) Then
  14.           objStr = Split(objTask.Name, " ")(0)
  15.           objSHELL.Popup "五秒后将自动关闭“" & objStr & "”窗口", 5
  16.           objTask.Close
  17.         End If
  18.       Next
  19.     End If
  20.   Next
  21.   objWORD.Quit
  22.   Set objWORD = Nothing
  23.   Set objSHELL = Nothing
  24.   WScript.Sleep 1000
  25. Loop
复制代码
***共同提高***

TOP

回复 3# batman


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

能不能换成网址?

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

TOP

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

TOP

本帖最后由 batman 于 2013-1-20 18:51 编辑
  1. Dim Urls, Arr
  2. Urls = "http://www.baidu.com,http://www.sina.com.cn"
  3. Arr = Split(Urls, ",")
  4. Dim objIE, objTitles
  5. Set objIE = CreateObject("InternetExplorer.Application")
  6. objIE.Visible = False
  7. For i = 0 To UBound(Arr)
  8.   objIE.Navigate Arr(i)
  9.   Do Until objIE.ReadyState = 4 : WScript.Sleep 200 : Loop
  10.   objTitles = objTitles & objIE.Document.GetElementsByTagName("title")(0).InnerText & "@#$"
  11. Next
  12. objIE.Quit
  13. Set objIE = Nothing
  14. Arr = Split(objTitles, "@#$")
  15. Do Until CreateObject("Scripting.FileSystemObject").FileExists("finish")
  16.   Dim objSHELL
  17.   Set objSHELL = CreateObject("Wscript.Shell")
  18.   Dim objWORD, objTasks, objTask, objStr
  19.   Set objWORD = CreateObject("Word.Application")
  20.   Set objTasks = objWORD.Tasks
  21.   For Each objTask in objTasks
  22.     On Error Resume Next
  23.     If objTask.Visible Then
  24.       For i = 0 To UBound(Arr) - 1
  25.         If InStr(objTask.Name, Arr(i)) Then
  26.           objStr = Split(objTask.Name, " ")(0)
  27.           objSHELL.Popup "五秒后将自动关闭“" & objStr & "”窗口", 5
  28.           objTask.Close
  29.           If Err.Number <> 0 Then Err.Clear
  30.         End If
  31.       Next
  32.     End If
  33.   Next
  34.   objWORD.Quit
  35.   Set objWORD = Nothing
  36.   Set objSHELL = Nothing
  37.   WScript.Sleep 1000
  38. Loop
复制代码
***共同提高***

TOP

回复 6# batman


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

TOP

回复 6# batman


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

TOP

那是因为你没有关闭开始的wscript.exe,你没看我在三楼的说明吗?
***共同提高***

TOP

回复 9# batman

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


finish有什么作用?

TOP

回复 9# batman


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

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

TOP

回复 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

TOP

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

QQ 20147578

TOP

回复 13# czjt1234


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

TOP

获取正在打开的网址

TOP

返回列表