Assembler des vidéos avec ffmpeg

'Version du 11 aout 2014
'Ajout de la commande pour aller dans le lecteur qui contient les vidéos à convertir
'Ajout de la suppression du premier fichier avi

Option Explicit

Dim objFSO, objTextFile, objFolder, MyFile, ExtensionFichier, CheminScriptActuel, CheminRepertoireAExplorer, Position
Dim NomScriptBat, CheminScriptBat, NomFichierListeFichiers, CheminListeFichiers, NomScriptSansExtension, NomFichierSansExtension
	
'Déclaration des constantes pour la lecture et l'ecriture dans les fichiers
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8	

CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1)

'ExtensionFichier = ""
Position = InStrRev(wscript.scriptname,".")
'ExtensionFichier = Mid(MyFile.Name,Position+1)
NomScriptSansExtension = Left(wscript.scriptname,Position-1)
NomScriptBat = NomScriptSansExtension & "_Script.bat"
NomFichierListeFichiers = NomScriptSansExtension & "_Liste_Fichiers.txt"

CheminScriptBat = CheminScriptActuel & "\" & NomScriptBat
CheminListeFichiers = CheminScriptActuel & "\" & NomFichierListeFichiers
CheminRepertoireAExplorer = InputBox("Entrez le chemin du répertoire","Chemin du répertoire",CheminScriptActuel)
'CheminScriptBat = InputBox("Entrez le chemin du fichier contenant le resultat","Chemin du fichier de reponse",CheminScriptBat)

'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)
Set objTextFile = objFSO.OpenTextFile(CheminScriptBat, ForWritting, True)

If Left(CheminScriptActuel, 2) = "\\" Then
	Wscript.echo "Attention : Les chemmins réseau ne sont pas traité correctement."
Else
	objTextFile.WriteLine(Left(CheminScriptActuel, 1) & ":")
End If

objTextFile.WriteLine("Cd """ & CheminScriptActuel & """")
objTextFile.WriteLine("ffmpeg_2013_08_24.exe -f concat -i """ & NomFichierListeFichiers & """ -c copy """ & NomScriptSansExtension & "_Resultat.mp4""")
objTextFile.Close
Set objTextFile = Nothing

Set objTextFile = objFSO.OpenTextFile(CheminListeFichiers, ForWritting, True)

For Each MyFile In objFolder.Files

	ExtensionFichier = ""
	Position = InStrRev(MyFile.Name,".")

	If (Position > 0) And (Position < Len(MyFile.Name)) Then
		ExtensionFichier = Mid(MyFile.Name,Position+1)
		NomFichierSansExtension = Left(MyFile.Name,Position-1)
		If (Lcase(ExtensionFichier) = "avi") Or (Lcase(ExtensionFichier) = "mp4") Or (Lcase(ExtensionFichier) = "flv") Or (Lcase(ExtensionFichier) = "m2ts") Or (Lcase(ExtensionFichier) = "mt2s") Or (Lcase(ExtensionFichier) = "ts" Or (Lcase(ExtensionFichier) = "mpg")) Or (Lcase(ExtensionFichier) = "mpeg") Then
			objTextFile.WriteLine("file '" & MyFile.Path & "'")
		End If	

	End If

Next

objTextFile.Close
Set objTextFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

Wscript.echo "Terminé !"

Public Function LancerExecutableWScriptShellRun(ByVal CheminExecutable, ByVal Arguments, ByVal ModeExecution, ByVal AttendreExecutable)

	'Version du 30 septembre 2009 : Retour d un eventuel message d erreur
	'Ex Version du 04 avril 2008
	'Ex Version du 26 mars 2008
	'Ex Version du 5 mars 2008

	'LancerExecutableWScriptShellRun ne retourne rien si il n y a pas eu de probleme, sinon retourne un message d erreur

	'Valeurs de ModeExecution :
	' 0 : Cache et active une autre fenetre
	' 1 : active la fenêtre de l executable et l affiche normalement
	' 2 : active et minimise la fenetre
	' 3 : active et maximise la fenetre
	' 4 : ne touche pas a la fenetre active, affiche a la taille la plus recente
	' 5 : active la fenetre active, affiche a la taille la plus recente
	' 6 :
	' 7 : ne touche pas a la fenetre active, minimise la fenetre
	' 8
	' 9
	' 10

	'Valeurs de AttendreExecutable
	' True
	' False

	Dim Commande
	Dim ObjShell
	Dim NumeroErreur
	Dim VariableBidon

	LancerExecutableWScriptShellRun = "" 'Valeur par defaut

	Select Case Cstr(ModeExecution)
		Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "10"
			VariableBidon = 2
		Case Else
			ModeExecution = 1
	End Select

	Select Case AttendreExecutable
		Case True
			VariableBidon = 2
		Case False
			VariableBidon = 2
		Case Else
			AttendreExecutable = True
	End Select

	Commande = CheminExecutable

	If Len(Arguments) > 0 Then
		Commande = Commande & " """ & Arguments & """"
		'Commande = """" & Commande & " """ & Arguments & """" & """"
		'MsgBox Commande
	End If

	'Creation de l'objet Shell
	Err.Clear
	On Error Resume Next
	Set ObjShell = WScript.CreateObject("WScript.Shell")
	NumeroErreur = Err.number
	On Error Goto 0
	If NumeroErreur = 0 Then

		'object.Run(strCommand, [intWindowStyle], [bWaitOnReturn])
		'1 pour activer la fenêtre et l'afficher normalement
		'Commande = "%windir%\notepad.exe" 'Préparation de la ligne de commande a éxecuter
		Err.Clear
		On Error Resume Next
		ObjShell.Run Commande, ModeExecution, AttendreExecutable
		NumeroErreur = Err.number
		On Error Goto 0
		If NumeroErreur = 0 Then
			LancerExecutableWScriptShellRun = ""
		End If

		'Destruction de l'objet Shell
		Set ObjShell = Nothing
	Else
		LancerExecutableWScriptShellRun = "Impossible de lancer la commande """ & Commande & """ car l appel de la fonction WScript.Shell ne fonctionne pas"
	End If 'If NumeroErreur = 0 Then

End Function