'2013 april 15th version : Second version : add a check test for the input file 'Source file on \\brasilsat\im\Data_Center\Procedures\Scripting\VbScript\FileObscurator 'Put the FileObscurator.vbs on the folder with files to process. 'In the same folder, put or create a text file named InputNamesToChange.txt with source/target tab separated words 'Example 'Paul Anonymous1 'Luc Anonymous2 ' 'An output Folder will be created with modified files. 'Next just double click on FileObscurator.vbs 'Note : 'files with .vbs extension and InputNamesToChange.txt file are not process by the script. ' 'Regards Dim objFSO 'Objet FSO pour l'accès au système de fichiers Dim MyFile 'Représente un fichier Dim objTextOuputFile 'Représente le fichier texte qui contient les réponses 'Déclaration des constantes pour la lecture et l'ecriture dans les fichiers Const ForReading = 1 Const ForWritting = 2 Const ForAppending = 8 Call DetectExeType() CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1) CheminFichierInput = CheminScriptActuel & "\" & "InputNamesToChange.txt" CheminRepertoireDeSortie = CheminScriptActuel & "\" & "Output" CheminRepertoireAExplorer = InputBox("Entrez le chemin du répertoire a explorer","Chemin du répertoire",CheminScriptActuel) 'Création des objets Set objFSO = CreateObject("Scripting.FileSystemObject") 'On fait un objet qui représente le répertoire à explorer Set objFolder = objFSO.GetFolder(CheminRepertoireAExplorer) 'Création éventuelle du répertoire de sortie If objFSO.FolderExists(CheminRepertoireDeSortie) = False Then Call objFSO.CreateFolder(CheminRepertoireDeSortie) End If 'If objFSO.FolderExists(CheminRepertoireDeSortie) = False Then 'Chargement des mots à remplacer Dim MyWordstoChange() Dim LineCount LineCount = 0 Set objTextWordToChange = objFSO.OpenTextFile(CheminFichierInput, ForReading, True) Do Until objTextWordToChange.AtEndOfStream 'Pour toutes les lignes du fichier MaLigne = objTextWordToChange.Readline 'Lecture de la ligne 'Wscript.Echo MaLigne If Len(MaLigne) > 0 Then 'Check we have 2 parameters in the line : ArrayWithMyLine = Split(MaLigne, vbTab) If IsArray(ArrayWithMyLine) = False Then Wscript.Echo "Error in line " & LineCount + 1 & " on file " & CheminFichierInput & " : there is no 2 parameters separated by a tabulation " Wscript.Quit End If If Ubound(ArrayWithMyLine) <> 1 Then Wscript.Echo "Error in line " & LineCount + 1 & " on file " & CheminFichierInput & " : we haven't 2 parameters but " & Ubound(ArrayWithMyLine) + 1 Wscript.Quit End If Err.Clear On Error Resume Next 'Wscript.Echo "1 : " & ArrayWithMyLine(0) 'Wscript.Echo "2 : " & ArrayWithMyLine(1) NumeroErreur = Err.number On Error Goto 0 If NumeroErreur = 0 Then 'If there is no error ReDim Preserve MyWordstoChange(LineCount) MyWordstoChange(LineCount) = MaLigne Else Wscript.Echo "Error in line " & LineCount + 1 & " on file " & CheminFichierInput & " (" & MaLigne & ")" End If Else Wscript.Echo "Error in line " & LineCount + 1 & " on file " & CheminFichierInput & " : Line empty." Wscript.Quit End If 'If Len(MaLigne) > 0 Then LineCount = LineCount + 1 Loop objTextWordToChange.Close Set objTextWordToChange = Nothing ''Check Array with words to change 'For Each OneLine In MyWordstoChange 'Wscript.Echo OneLine 'Next 'Pour tous les fichiers du répertoire For Each MyFile In objFolder.Files 'Si ce n'est pas un .vbs If (Lcase(ExtensionFichier(MyFile.Name)) <> "vbs") And (MyFile.Name <> "InputNamesToChange.txt") Then CheminFichierResultat = CheminRepertoireDeSortie & "\" & MyFile.Name Set objTextInputFile = objFSO.OpenTextFile(MyFile.Path, ForReading, True) Set objTextOuputFile = objFSO.OpenTextFile(CheminFichierResultat, ForWritting, True) 'Pour toutes les lignes du fichier Do Until objTextInputFile.AtEndOfStream MaLigne = objTextInputFile.Readline 'Lecture de la ligne 'Change some words For Each OneLine In MyWordstoChange ArrayWithMyLine = Split(OneLine, vbTab) 'Wscript.Echo "1 : " & ArrayWithMyLine(0) 'Wscript.Echo "2 : " & ArrayWithMyLine(1) 'Wscript.Echo "I Seek " & ArrayWithMyLine(0) & " to change with " & ArrayWithMyLine(1) & " on line '" & MaLigne & "'" 'MaLigne = Replace(Lcase(MaLigne), Lcase(ArrayWithMyLine(0)), Lcase(ArrayWithMyLine(1))) MaLigne = Replace(MaLigne, Lcase(ArrayWithMyLine(0)), Lcase(ArrayWithMyLine(1)), 1, -1, 1) 'Wscript.Echo "Result : " & MaLigne Next 'Wscript.Echo MaLigne objTextOuputFile.WriteLine(MaLigne) Loop objTextInputFile.Close Set objTextInputFile = Nothing objTextOuputFile.Close Set objTextOuputFile = Nothing End If Next Set objFolder = Nothing Set objFSO = Nothing Msgbox "Finish !" Public Function ExtensionFichier(ByVal CheminFichier) 'Retourne l'extension du fichier Dim Position ExtensionFichier = "" Position = InStrRev(CheminFichier,".") If (Position > 0) And (Position < Len(CheminFichier)) Then ExtensionFichier = Mid(CheminFichier,Position+1) End If End Function Sub DetectExeType() 'Version du 10 juillet 2008 Dim ScriptHost Dim ShellObject Dim CurrentPathExt Dim EnvObject Dim RegCScript Dim RegPopupType ' This is used to set the pop-up box flags. ' I couldn't find the pre-defined names RegPopupType = 32 + 4 On Error Resume Next ScriptHost = WScript.FullName ScriptHost = Right(ScriptHost, Len(ScriptHost) - InStrRev(ScriptHost, "\")) If (UCase(ScriptHost) = "WSCRIPT.EXE") Then WScript.Echo ("This script does not work with WScript.") ' Create a pop-up box and ask if they want to register cscript as the default host. Set ShellObject = WScript.CreateObject("WScript.Shell") ' -1 is the time to wait. 0 means wait forever. RegCScript = ShellObject.PopUp("Would you like to register CScript as your default host for VBscript?", 0, "Register CScript", RegPopupType) If (Err.Number <> 0) Then ReportError () WScript.Echo "To run this script using CScript, type: ""CScript.exe " & WScript.ScriptName & """" WScript.Quit (GENERAL_FAILURE) WScript.Quit (Err.Number) End If ' Check to see if the user pressed yes or no. Yes is 6, no is 7 If (RegCScript = 6) Then ShellObject.RegWrite "HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ" ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\CScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ" ' Check if PathExt already existed CurrentPathExt = ShellObject.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT") If Err.Number = &H80070002 Then Err.Clear Set EnvObject = ShellObject.Environment("PROCESS") CurrentPathExt = EnvObject.Item("PATHEXT") End If ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PATHEXT", CurrentPathExt & ";.VBS", "REG_SZ" If (Err.Number <> 0) Then ReportError () WScript.Echo "Error Trying to write the registry settings!" WScript.Quit (Err.Number) Else WScript.Echo "Successfully registered CScript" End If Else WScript.Echo "To run this script type: ""CScript.Exe adsutil.vbs """ End If Dim ProcString Dim ArgIndex Dim ArgObj Dim Result ProcString = "Cscript //nologo " & WScript.ScriptFullName Set ArgObj = WScript.Arguments For ArgIndex = 0 To ArgCount - 1 ProcString = ProcString & " " & Args(ArgIndex) Next 'Now, run the original executable under CScript.exe Result = ShellObject.Run(ProcString, 0, True) WScript.Quit (Result) End If End Sub