FileObscurator

'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 <cmd> <params>"""
		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