Work in progress …

In versione 0.1 già perfettamente funzionante, è ciò che ha permesso (insieme all'ottima lista host di MalwareDomainList.com) di dare il via al rilascio ufficiale delle prime versioni di ABP X Files HWS, il modulo “Harmful WebSites” per la protezione della navigazione e per evitare che si vada a finire in siti web potenzialmente dannosi per il proprio PC.

HWS-Maker_0.1.vbs

' ABP X FILES HWS Maker 0.1
' GSolone - Ultima modifica: 20130808 rev3
'
' 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.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.
'
' 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%") 
     'strFile = strApplicationData + "\hws_xfiles.txt"
	 strFile = "C:\Dropbox\Public\abpxfiles\siteblock.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 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
 
	' 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.0]" & vbCrLf & "! Version: " & update & vbCrLf & "! Title: X Files: HWS Harmful WebSites" & vbCrLf & "! Last modified: " & lastmodified & vbCrLf & "! Expires: 3 days" & vbCrLf & "! Homepage: http://mozilla.gfsolone.com" & vbCrLf & "! Harmful WebSites blocca siti web potenzialmente dannosi per la vostra navigazione" & vbCrLf & "! Blog: http://gioxx.org/tag/x-files" & 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