User Tools

Site Tools


mozilla:abpxfiles:vbs:hwsmaker

This is an old revision of the document!


HWS Maker

Righe di debug sparse un po' ovunque, sicuramente una marea di errori dovuti alla mia inesperienza e auto-formazione sulla programmazione in VBScript e (quasi certamente) molteplici modi di farlo con la metà delle righe di codice, eppure lo script che vedete qui di sopra si occupa ad oggi di scaricare la lista filtri da MalwareDomainList, rimuovere tutta la prima parte di informazioni, pulire ogni riga dal suo 127.0.0.1 e inserire i dettagli di aggiornamento, scadenza e non solo, quindi caricare nella cartella pubblica del mio Dropbox la nuova versione della lista finalmente compatibile che tutti voi potrete scaricare (o lasciar scaricare a Adblock) senza il minimo sforzo :-)

Vedi l'articolo completo su http://gioxx.org/2013/11/11/xfiles-hws-compile
Se stai cercando “suo fratello” Stable Maker (per ABP X Files) dai un'occhiata a questa pagina.

Sourcecode

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.

Facendo clic sul nome dello script “HWS-Maker_XX.vbs” si potrà effettuare il download dello script sul proprio PC.

HWS-Maker_0.2.vbs
' ABP X FILES HWS Maker 0.2
' 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.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%") 
     '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 & "! 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 & "! "
	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

Archivio versioni

Qui di seguito la versione 0.1

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
mozilla/abpxfiles/vbs/hwsmaker.1384022459.txt.gz · Last modified: 2013/11/09 19:40 by gfsadministrator