mozilla:abpxfiles:vbs:hwsmaker
This is an old revision of the document!
HWS Maker
Work in progress …
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.
- HWS-Maker_0.1.vbs
' ABP X FILES HWS Maker 0.1 ' GSolone - Ultima modifica: 20130808 ' ' 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 ' - ' ' 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" ' 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 ' 1- 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 ' 2- 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 ' 3- Then 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 ' 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 - Blocca siti web potenzialmente dannosi per la vostra navigazione" & vbCrLf & "! Last modified: " & lastmodified & vbCrLf & "! Expires: 3 days" & vbCrLf & "! Homepage: http://mozilla.gfsolone.com" & 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.1375957410.txt.gz · Last modified: 2013/08/08 12:23 by gfsadministrator