Découper une vidéo avec ffmpeg

'2014 01 04
'2013 12 26
'Genere un fichier bat avec la commande nécessaire au découpage d'un fichier video avec ffmpeg

Dim objFSO 'Objet FSO pour l'accès au système de fichiers
Dim MyFile 'Représente un fichier
Dim objTextFile 'Représente le fichier texte qui contient les réponses
Dim Position
Dim ExtensionFichier
Dim NomFichierSansExtension
	
'Déclaration des constantes pour la lecture et l'ecriture dans les fichiers
Const ForReading = 1
Const ForWritting = 2
Const ForAppending = 8	

Dim DefaultMovieFilePath
Dim MovieFilePathToCut

'Création des objets
Set objFSO = CreateObject("Scripting.FileSystemObject")

CheminScriptActuel = Left(wscript.scriptfullname,Len(wscript.scriptfullname)-Len(wscript.scriptname)-1)
CheminFichierResultat = CheminScriptActuel & "\" & "Script_commandes_FFMpeg_decouper_fichier.bat"
CheminFichierResultat = InputBox("Entrez le chemin du fichier contenant le batch","Chemin du fichier de reponse",CheminFichierResultat)

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

'On ecrit dans le batch la lettre du lecteur qui contient le script
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 & """")

CheminRepertoireAExplorer = InputBox("Entrez le chemin du répertoire qui contient le fichier","Chemin du répertoire",CheminScriptActuel)

'On fait un objet qui représente le répertoire à explorer
Set objFolder = objFSO.GetFolder(CheminRepertoireAExplorer)

'Recherche d'un fichier video situé dans le répertoire qui contient ce script
DefaultMovieFilePath = "" 'Valeur par défaut
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") Or (Lcase(ExtensionFichier) = "mkv") Then
			DefaultMovieFilePath = MyFile.Path
			Exit For
		End If	

	End If

Next

'Chemin du fichier à découper
MovieFilePathToCut = InputBox("Chemin du fichier a decouper","Chemin du fichier",DefaultMovieFilePath)
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)
End If

	
'ffmpeg_2013_08_24.exe -i "P:\Videos\TV\A decouper\input.m2ts" -ss 01:19:24 -t 00:20:35 -c:v copy -c:a copy "P:\Videos\TV\A decouper\Output.m2ts"

PositionDepart = InputBox("Entrez la position de départ au format hh:mm:ss","Position de depart","00:00:00")
PositionFin = InputBox("L'heure de fin au format hh:mm:ss","Position de fin",PositionDepart)

'Calcul de la durée entre la position du début et la position de fin
NbrSecondes = DateDiff("s",PositionDepart,PositionFin) '& ":" & DateDiff("n",PositionDepart,PositionFin) & ":" & DateDiff("s",PositionDepart,PositionFin)
DateRef = "01/01/2010 00:00:00"
Duree = DateAdd("s",NbrSecondes,DateRef)

Duree = ConversionSecondesHHMMSS(Duree)


objTextFile.WriteLine("set fichiersource=""" & MovieFilePathToCut & """")
objTextFile.WriteLine("set fichiercible=""" & CheminRepertoireAExplorer & "\" & NomFichierSansExtension & "_Decoupe." & ExtensionFichier & """")

'objTextFile.WriteLine("ffmpeg_2013_08_24.exe -i """ & MovieFilePathToCut & """ -ss " & PositionDepart & " -t " & Duree & " -c:v copy -c:a copy """ & CheminRepertoireAExplorer & "\" & NomFichierSansExtension & "_Decoupe." & ExtensionFichier & """")
objTextFile.WriteLine("ffmpeg_2013_08_24.exe -i %fichiersource% -ss " & PositionDepart & " -t " & Duree & " -c:v copy -c:a copy %fichiercible%")

If PositionDepart <> "00:00:00" Then
	objTextFile.WriteLine("REM ffmpeg_2013_08_24.exe -i %fichiersource% -ss 00:00:01 -t " & PositionDepart & " -c:v copy -c:a copy """ & CheminRepertoireAExplorer & "\" & NomFichierSansExtension & "_Debut." & ExtensionFichier & """")
	objTextFile.WriteLine("REM DEL /F """ & MovieFilePathToCut & """")
End If
	
objTextFile.Close
Set objTextFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing

Wscript.echo "Script termine"

Public Function ConversionSecondesHHMMSS(ByVal CheminExecutable)

	Dim NbrHeures
	Dim NbrMinutes
	Dim NbrSecondes
	
	NbrHeures = DatePart("h",Duree)
	If Len(NbrHeures) < 2 Then NbrHeures = "0" & NbrHeures
	NbrMinutes = DatePart("n",Duree)
	If Len(NbrMinutes) < 2 Then NbrMinutes = "0" & NbrMinutes
	NbrSecondes = DatePart("s",Duree)
	If Len(NbrSecondes) < 2 Then NbrSecondes = "0" & NbrSecondes

	ConversionSecondesHHMMSS = NbrHeures & ":" & NbrMinutes & ":" & NbrSecondes
	'Wscript.echo "Duree : " & Duree
	'Duree = InputBox("Confirmez la durée entre la position de fin et la position du debut","Durée",Duree)

End Function

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