Re: Automation of IE and detection of popups using VBScript by Fosco
Fosco
Sat Jun 25 11:44:02 CDT 2005
"shadowHead"
PopUP Killer.vbs
' (don't remember the author >> www.google.com "PopUP Killer+vbs")
Dim gstrDataFile 'As String -- Name of text file containing bad window titles
Dim strEngine 'As String -- Used to tell the user what program is running the wscript.
gstrDataFile = FileNameLikeMine("txt")
If Not CreateObject("Scripting.FileSystemObject").FileExists(gstrDataFile) Then
String2File "----- Title Data File -----" & vbCrLf & "www.quellochevuoi" & vbCrLf & "about:blank" & vbCrLf,
gstrDataFile
strEngine = Wscript.FullName
strEngine = Mid(strEngine, InstRrev(strEngine, "\") + 1)
strEngine = Left(strEngine, Instr(strEngine, ".") - 1)
strEngine = Ucase(Left(strEngine, 1)) & Lcase(Mid(strEngine, 2))
MsgBox " This script will run until system shutdown killing windows whose titles are found in the ""Title Data
File"" at """ & gstrDataFile & """." & vbCrLf & vbCrLf & " If you need to stop this process, kill the """ &
strEngine & """ program with the Windows Task Manager (Ctrl-Alt-Del). Alternatively, you can stop the program by
deleting, renaming, or emptying the title data file." & vbCrLf & vbCrLf & " This dialog will only appear when there
is no title data file."
End If
While True
KillWindows
Wscript.Sleep 500
Wend
Sub KillWindows
Dim wsh 'As WScript.Shell
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Dim strData 'As String -- Entire contents of gstrDataFile
Dim strTitle 'As String -- Just one bad window title
Const ForReading = 1
Set fs = CreateObject("Scripting.FileSystemObject")
Set wsh = CreateObject("WScript.Shell")
On Error Resume Next
Err.Clear
Set ts = fs.OpenTextFile(gstrDataFile, ForReading, True)
If Err.Number = 0 Then
strData = ts.ReadAll
If Err.Number = 0 Then
'Read all title lines in data string
Do Until (Instr(strData, vbCrLf) = 0)
strTitle = Left(strData, Instr(strData, vbCrLf) - 1)
strData = Mid(strData, Instr(strData, vbCrLf) + 2)
If strTitle <> "" Then
If wsh.AppActivate(strTitle) Then
wsh.SendKeys "%{F4}"
WriteLog Now & " " & strTitle
End If
End If
Loop
'Grab last bit in case there was no ending CrLf
strTitle = strData
If strTitle <> "" Then
If wsh.AppActivate(strTitle) Then
wsh.SendKeys "%{F4}"
WriteLog Now & " " & strTitle
End If
End If
Else
ts.Close
Wscript.Quit 1
End If
Else
Wscript.Quit 1
End If
ts.Close
End Sub
Sub WriteLog(strText)
'Write to screen if script is run with CSCRIPT. Otherwise, write to a log file.
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForAppending = 8
If Lcase(Right(Wscript.FullName, 11)) = "cscript.exe" Then
Wscript.Echo strText
Else
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "log",
ForAppending, True)
ts.WriteLine strText
ts.Close
End If
End Sub
Function FileNameLikeMine(strFileExtension) 'As String
'Returns a file name the same as the script name except
'for the file extension.
Dim fs 'As Object
Dim strExtension 'As String
Set fs = CreateObject("Scripting.FileSystemObject")
strExtension = strFileExtension
If Len(strExtension) < 1 Then strExtension = "txt"
If strExtension = "." Then strExtension = "txt"
If Left(strExtension,1) = "." Then strExtension = Mid(strExtension, 2)
FileNameLikeMine = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & strExtension
End Function
Sub String2File(strData, strFileName)
'Writes a string to a file
Dim fs 'As Scripting.FileSystemObject
Dim ts 'As Scripting.TextStream
Const ForWriting = 2
Set fs = Wscript.CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(strFileName, ForWriting, True)
ts.Write(strData)
ts.Close
End Sub
--
Fosco