mozilla:abpxfiles:vbs:stablemaker
This is an old revision of the document!
Table of Contents
Stable Maker
Work in progress …
Sourcecode
In versione 0.1 già perfettamente funzionante, è ciò che permette di trasformare la lista di “Staging” esportata dal Firefox che genera i filtri di X Files in Stable per il pubblico. La lavora e la sposta in cartella Dropbox dove poi tutti i browser potranno collegarsi per l'aggiornamento.
- Stable-Maker_0.1.vbs
' ABP X FILES Stable Maker 0.1 ' GSolone - Ultima modifica: 20130905 rev0 ' ' Lo script modifica la lista filtri esportata dall'Adblock Plus di Staging e la modifica per inserire le informazioni di rilascio, quindi la copia all'interno della cartella pubblica di Dropbox dove tutti i client puntano per l'aggiornamento. ' ' STORICO MODIFICHE ' 0.1 rev0- stadio iniziale di sviluppo. ' ' Sviluppo: Giovanni F. -Gioxx- Solone (dev@gfsolone.com) ' Testato su: Windows 7 Pro Sp1 ' ' Non toccare nulla oltre questa riga! ' DO NOT touch anything below this line! ' Variables and constants definition Dim i, objFile, objFSO, 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: show $datetime 'Wscript.Echo update ' Expand Environment ' Create const's to spare time and place Dim WshS Set WshS = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") usrProfile = WshS.ExpandEnvironmentStrings("%UserProfile%") strFile = usrProfile & "\Desktop\filtri.txt" ' DEBUG: Message to prove my string contains the path to my profile 'cartellaProfilo = usrProfile 'Msgbox strFile, 0, "Percorso lista" ' Staging filtri.txt is on my Desktop? Set objFSO = CreateObject("Scripting.FileSystemObject") If objFSO.FileExists(strFile) Then Else MsgBox "Non ho trovato il file filtri.txt sul Desktop. Lo hai esportato da Firefox?",16,"" Wscript.Quit End If ' Remove line 1 to 2, default header of Adblock Plus export For i = 1 To 2 DeleteLine strFile, "", 1, 0 Next ' Add list header (ABP X Files Stable) 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: ABP X Files" & vbCrLf & "! X Files migliora la tua navigazione quotidiana!" & 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 ' 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 ' Move updated X Files to Dropbox (and overwrite old file) ' (from %UserProfile%\Desktop\filtri.txt to C:\Dropbox\Public\abpxfiles\filtri.txt) Const OverwriteExisting = TRUE Set objFSO = CreateObject("Scripting.FileSystemObject") strDropbox = "C:\Dropbox\Public\abpxfiles\" If objFSO.FileExists(strFile) Then objFSO.CopyFile strFile, strDropbox, OverwriteExisting Else MsgBox "Non sono riuscito a muovere il file dei filtri. Verifica che i puntamenti siano corretti",48,"" End If ' Open the file (verification process) and delete "Staging X Files" strDropboxFile = "C:\Dropbox\Public\abpxfiles\filtri.txt" CreateObject("WScript.Shell").Run strDropboxFile objFSO.DeleteFile strFile, True 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
Non ci sono ancora vecchie versioni di questo script.
mozilla/abpxfiles/vbs/stablemaker.1378389506.txt.gz · Last modified: 2013/09/05 15:58 by gfsadministrator