Skip to content

Instantly share code, notes, and snippets.

@gioxx
Created January 30, 2017 09:31
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save gioxx/5f2835af08b3f2df61d76af56d877bd4 to your computer and use it in GitHub Desktop.
Il codice utilizzato per scaricare e trasformare la lista siti web malevoli (malwaredomainlist.com/hostslist/hosts.txt) in modulo HWS per AdBlock Plus (e compatibili).
' ABP X FILES HWS Maker 0.4 rev1
' GSolone - Ultima modifica: 09/01/17
'
' Lo script scarica la lista filtri più aggiornata disponibile su MalwareDomainList.com e la modifica per renderla integrabile all'interno di una lista filtri standard per Adblock Plus e compatibili, a prescindere dal browser utilizzato.
'
' STORICO MODIFICHE
' 0.4 rev1- ho aggiunto un riferimento allo spazio hosting GitHub (per far notare all'utente che sta utilizzando il giusto repository). Aggiornato anche versione di Adblock richiesta (2.8).
' 0.4 - ho modificato la posizione del file di lista (si passa su Github!).
' 0.3 - integrato il nuovo blocco che toglie dalla lista alcuni siti web non più infetti (Find and remove Healthy Websites), segnalati tramite ticket su noads.it / UserVoice e verificati. Viene prevista inoltre la possibilità di collegamento tramite Proxy (Connection through proxy) utilizzando le credenziali dell'utente corrente.
' 0.2 - modificato l'URL di riferimento della distribuzione lista, si comincia a lavorare su noads.it
' 0.1 rev3 - corretto il problema dell'ultima linea con il solo "##HTML *" che bloccava la navigazione su ogni sito web. Rimangono due righe vuote a termine file ma non è un problema. Corretto un problema di formattazione nel titolo della lista.
'
' Sviluppo: Giovanni F. -Gioxx- Solone (dev@gfsolone.com)
' Testato su: Windows 7 Pro Sp1
'
' LISTA HOST UTILIZZATA
HTTPDownload "http://www.malwaredomainlist.com/hostslist/hosts.txt"
' Non toccare nulla oltre questa riga!
' DO NOT touch anything below this line!
Sub HTTPDownload(myURL)
' Variables and constants definition
Dim i, objFile, objFSO, objHTTP, strFile, strMsg
Dim objWMIService, objProcess, colProcess
Const ForReading = 1, ForWriting = 2, ForAppending = 8
' Date and time
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objItem in colItems
dtmLocalTime = objItem.LocalDateTime
dtmMonth = Mid(dtmLocalTime, 5, 2)
dtmDay = Mid(dtmLocalTime, 7, 2)
dtmYear = Left(dtmLocalTime, 4)
dtmHour = Mid(dtmLocalTime, 9, 2)
dtmMinutes = Mid(dtmLocalTime, 11, 2)
dtmSeconds = Mid(dtmLocalTime, 13, 2)
Next
update = dtmYear & dtmMonth & dtmDay & dtmHour & dtmMinutes
lastmodified = dtmDay & "-" & dtmMonth & "-" & dtmYear
' debug Wscript.Echo update
' 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")
Set WshShell = WScript.CreateObject("Wscript.Shell")
strApplicationData = WshShell.ExpandEnvironmentStrings("%TEMP%")
'FILE DEST. - Sblocca la stringa qui di seguito per scrivere nella cartella temporanea quando necessario
' e commenta quella successiva che scrive invece su Dropbox!
'strFile = strApplicationData + "\hws_xfiles.txt"
strFile = "C:\GitHub\xfiles\siteblock.txt"
'Nuova posizione dal 12/2016, era strFile = "C:\Dropbox\Public\abpxfiles\siteblock.txt"
' Create an HTTP object
Set objHTTP = CreateObject( "WinHttp.WinHttpRequest.5.1" )
' Connection through proxy (remove comment in the line below)
'objHttp.setProxy 2, "proxy.contoso.com:8080", ""
' Download from the specified URL
objHTTP.Open "GET", myURL, False
objHTTP.Send
if LenB( objHTTP.ResponseBody ) < 500 Then
MsgBox "Errore durante il download della lista host ..." & chr(13) & "Lista non trovata o sito web momentaneamente non funzionante." & chr(13) & "Lista non creata"
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 6, header of MalwareDomainList.com Hosts List
For i = 1 To 6
DeleteLine strFile, "", 1, 0
Next
' Find and remove 127.0.0.1 from each line
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "127.0.0.1 ", "")
Set objFile = objFSO.OpenTextFile(strFile, ForWriting)
objFile.WriteLine strNewText
objFile.Close
' Find and remove Healthy Websites
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
strText = objFile.ReadAll
objFile.Close
strNewText = Replace(strText, "www.angolotesti.it", "")
strNewText = Replace(strNewText, "www.secondome.com", "")
strNewText = Replace(strNewText, "ms11.net", "")
Set objFile = objFSO.OpenTextFile(strFile, ForWriting)
objFile.WriteLine strNewText
objFile.Close
' Remove empty lines at the end of file!
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
Do Until objFile.AtEndOfStream
strLine = objFile.Readline
strLine = Trim(strLine)
If Len(strLine) > 0 Then
strNewContents = strNewContents & strLine & vbCrLf
End If
Loop
objFile.Close
Set objFile = objFSO.OpenTextFile(strFile, ForWriting)
objFile.Write strNewContents
objFile.Close
' Append "##HTML *" for each line
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading, True)
Set tmpFile= objFSO.OpenTextFile(strFile & ".tmp", ForWriting, True)
Do While Not objFile.AtEndofStream
url = objFile.ReadLine
url = url & "##HTML *"
tmpFile.WriteLine url
Loop
objFile.Close
tmpFile.Close
objFSO.DeleteFile(strFile)
objFSO.MoveFile strFile&".tmp", strFile
' Add list header (ABP X Files HWS)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
strContents = objFile.ReadAll
objFile.Close
strFirstLine = "[Adblock Plus 2.8]" & vbCrLf & "! Version: " & update & vbCrLf & "! Title: X Files: HWS Harmful WebSites" & vbCrLf & "! Harmful WebSites blocca siti web potenzialmente dannosi per la vostra navigazione" & vbCrLf & "! Last modified: " & lastmodified & vbCrLf & "! Expires: 3 days" & vbCrLf & "! Homepage: http://noads.it" & vbCrLf & "! Home: http://noads.it" & vbCrLf & "! Blog: http://gioxx.org/tag/x-files" & vbCrLf & "! Hosting lista: GitHub.com" & vbCrLf & "! "
strNewContents = strFirstLine & vbCrLf & strContents
Set objFile = objFSO.OpenTextFile(strFile, ForWriting)
objFile.WriteLine strNewContents
objFile.Close
' Open the file (verification process)
CreateObject("WScript.Shell").Run strFile
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