Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Riporto qui il codice sorgente della versione 0.2 del downloader VBS per generare i filtri del vecchio Simple Adblock per Internet Explorer. Vedi https://xfiles.noads.it per maggiori informazioni.
' ABP X FILES per Internet Explorer & Simple AdBlock
' AUTOMATED FILTER DOWNLOADER 0.2
'
' Lo script chiude tutte le finestre di Internet Explorer aperte, aggiorna la lista filtri ABP X Files per Simple AdBlock e avvia una nuova sessione di Internet Explorer con i nuovi filtri già in funzione, in completa autonomia! Basato su lista stabile.
'
' Sviluppo: Claudio Cantalupo
' Modifiche: Giovanni F. -Gioxx- Solone (dev@gfsolone.com)
' Testato su: Internet Explorer 9 su Windows 7 Pro Sp1
'
' Non toccare nulla oltre questa riga!
' Do not touch anything below this line!
HTTPDownload "http://noads.it/filtri.txt"
Sub HTTPDownload(myURL)
' Variables and constants definition
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Dim objWMIService, objProcess, colProcess
Dim strComputer, strProcessKill
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Kill Internet Explorer, if open
strComputer = "."
strProcessKill = "'iexplore.exe'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = " & strProcessKill )
For Each objProcess in colProcess
objProcess.Terminate()
Next
WSCript.Echo strProcessKill & " terminato, cerco e aggiorno la versione di ABP X Files ... "
' Create a File System Object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
' Check if the specified target file or folder exists, and build the fully qualified path of the target file
Set objShell = CreateObject("Wscript.Shell")
Set objProcess = objShell.Environment("Process")
strApplicationData = objProcess("APPDATA")
strFile = strApplicationData + "\..\LocalLow\Simple Adblock\filter_personal.txt"
' Create an HTTP object
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
' Download from the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
if LenB( objHTTP.ResponseBody ) < 500 Then
MsgBox "Errore durante il download di ABP X Files ..." & chr(13) & "Lista non trovata o sito web momentaneamente non funzionante." & chr(13) & "I filtri non sono stati aggiornati."
Exit Sub
End If
' Create or open the target file
Set objFile = objFSO.OpenTextFile( strFile, ForWriting, True )
' Write the downloaded byte stream to the target file
For i = 1 To LenB( objHTTP.ResponseBody )
objFile.Write Chr( AscB( MidB( objHTTP.ResponseBody, i, 1 ) ) )
Next
' Close the target file
objFile.Close()
' Remove line 1 to 8, credits of ABP X Files by gfsolone.Com
For i = 1 To 8
DeleteLine strFile, "", 1, 0
Next
' Finally, open Windows Internet Explorer with a new version of ABP X Files!
Set oIE = CreateObject("InternetExplorer.Application")
oIE.Visible = True
oIE.Navigate "http://gfsolone.com/abp-xfiles/latest-abpxfilesie"
End Sub
Sub Run(ByVal sFile)
' Variables definition
Dim shell
Set shell = CreateObject( "WScript.Shell" )
shell.Run Chr(34) & sFile & Chr(34), 1, false
Set shell = Nothing
End Sub
Sub DeleteLine(strFile, strKey, LineNumber, CheckCase)
'Use strFile = "c:\file.txt" (Full path to text file)
'Use strKey = "John Doe" (Lines containing this text string to be deleted)
'Use strKey = "" (To not use keyword search)
'Use LineNumber = "1" (Enter specific line number to delete)
'Use LineNumber = "0" (To ignore line numbers)
'Use CheckCase = "1" (For case sensitive search )
'Use CheckCase = "0" (To ignore upper/lower case characters)
Const ForReading=1:Const ForWriting=2
Dim objFSO,objFile,Count,strLine,strLineCase,strNewFile
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFile=objFSO.OpenTextFile(strFile,ForReading)
Do Until objFile.AtEndOfStream
strLine=objFile.Readline
If CheckCase=0 then strLineCase=ucase(strLine):strKey=ucase(strKey)
If LineNumber=objFile.Line-1 or LineNumber=0 then
If instr(strLine,strKey) or instr(strLineCase,strkey) or strKey="" then
strNewFile=strNewFile
Else
strNewFile=strNewFile&strLine&vbcrlf
End If
Else
strNewFile=strNewFile&strLine&vbcrlf
End If
Loop
objFile.Close
Set objFSO=CreateObject("Scripting.FileSystemObject")
Set objFile=objFSO.OpenTextFile(strFile,ForWriting)
objFile.Write strNewFile
objFile.Close
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.