Source code for rotatevideo.hta

```
Option Explicit
```
```
On Error GoTo 0
```
```
 
```
```
Const wshFailed   = 2
```
```
Const wshFinished = 1
```
```
Const wshRunning  = 0
```
```
 
```

Dim objFso, strFFMPEG, strVersion, wshShell

```
 
```
```
 
```
```
Sub window_onload()
```

	Dim intAnswer, intPosX, intPosY, strMsg, strParentFolder, strTitle

```
 
```
```
	strVersion = "1.00"
```
```
 
```
```
	On Error GoTo 0
```
```
 
```
```
	window.resizeTo 1800, 360
```

	intPosX = CInt( ( window.screen.width - 1800 ) / 2 )

```
	If intPosX < 0 Then intPosX = 0
```
```
	intPosY = intPosX
```
```
	window.moveTo intPosX, intPosY
```

	document.title = "RotateVideo, Version " & strVersion & " " & Chr( 169 ) & " 2021 Rob van der Woude"

	Set wshShell = CreateObject( "WScript.Shell" )

	Set objFso   = CreateObject( "Scripting.Filesystemobject" )

```
	strFFMPEG = ""
```
```
	If Not CheckFFMPEG( ) Then
```

		strParentFolder =  Replace( objFso.GetParentFolderName( self.location.pathname ), "/", "" )

		strMsg          = "Unable to locate FFMPEG.EXE." _

```
		                & vbCrLf & vbCrLf _
```

		                & "Make sure it is available, and located either in this program's parent folder (""" & Replace( objFso.GetParentFolderName( self.location.pathname ), "/", "" ) & """) or in a directory listed in the PATH." _

```
		                & vbCrLf & vbCrLf _
```

		                & "Do you want to open the FFMPEG download page in your default browser now?"

```
		strTitle        = "Missing FFMPEG"
```

		intAnswer       = MsgBox( strMsg, vbYesNoCancel, strTitle )

```
		If intAnswer = vbYes Then
```

			wshShell.Run "https://www.gyan.dev/ffmpeg/builds/", 0, False

			MsgBox "Download and install the FFMPEG package and make sure FFMPEG.EXE is located either in this program's parent folder (""" & Replace( objFso.GetParentFolderName( self.location.pathname ), "/", "" ) & """ or in a directory listed in the PATH."

```
		ElseIf intAnswer = vbCancel Then
```
```
			AbortProgram
```
```
		End If
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub AbortProgram( )
```
```
	self.close
```
```
End Sub
```
```
 
```
```
 
```
```
Function CheckFFMPEG( )
```
```
	CheckFFMPEG = False
```
```
	Dim arrPATH, i
```

	arrPATH = Split( Replace( objFso.GetParentFolderName( self.location.pathname ) & ";" & wshShell.Environment.Item( "PATH" ), "/", "" ), ";" )

```
	For i = 0 To UBound( arrPATH )
```

		strFFMPEG = objFso.BuildPath( arrPATH(i), "ffmpeg.exe" )

		If objFso.FileExists( strFFMPEG ) Then

```
			CheckFFMPEG = True
```
```
			Exit For
```
```
		End If
```
```
	Next
```
```
End Function
```
```
 
```
```
 
```
```
Sub showHelp( )
```

	Dim strHelpText ' Do not add more text, as it might be truncated by MsgBox limitations

	strHelpText = "RotateVideo.hta,  Version " & strVersion & vbCrLf _

	            & "Rotate a video in 90 degrees steps and save it in MP4 format" & vbCrLf & vbCrLf _

	            & "USAGE:" & vbCrLf & vbCrLf _

	            & "* Select a video file by clicking the ""Browse"" button" & vbCrLf _

	            & "* Select the required rotation from the dropdown list" & vbCrLf _

	            & "* Click the ""Start Conversion"" button" & vbCrLf & vbCrLf _

	            & "The converted/rotated video file will be saved in the same directory where the selected video file is located, with "".convertedbyffmpeg"" or "".rotated**byffmpeg"" appended to its name, where ** is the clockwise rotation in degrees." & vbCrLf & vbCrLf _

	            & "Regardless of the input video format, the converted/rotated video will always be in MP4 format" & vbCrLf & vbCrLf _

	            & "REQUIREMENTS:" & vbCrLf & vbCrLf _

	            & "This HTA is just a front-end to FFMPEG.EXE which performs the actual rotation/conversion." & vbCrLf _

	            & "FFMPEG.EXE must be located in HTA's directory, or in a directory in the PATH." & vbCrLf & vbCrLf _

	            & "FFMPEG can be downloaded at https://www.gyan.dev/ffmpeg/builds/" & vbCrLf & vbCrLf _

	            & "If at startup this HTA cannot find FFMPEG.EXE, you will be prompted to open its download URL." & vbCrLf & vbCrLf _

	            & "CREDITS:" & vbCrLf & vbCrLf _

	            & "FFMPEG command to rotate video:" & vbCrLf _

	            & "https://stackoverflow.com/a/9570992"

	MsgBox strHelpText, vbOKOnly, "Help for RotateVideo.hta Version " & strVersion

```
End Sub
```
```
 
```
```
 
```
```
Sub StartConversion( )
```
```
	Dim arrVideoTypes
```
```
	Dim blnValidType
```
```
	Dim i, intAnswer, intRotation
```

	Dim strCommand, strRotated, strTranspose, strVideoInputType, strVideoInputFile, strVideoOutputFile

```
 
```

	strVideoInputFile = document.getElementById( "VideoFile" ).value

```
 
```

	strVideoInputType = objFso.GetExtensionName( strVideoInputFile )

```
	blnValidType      = False
```

	arrVideoTypes     = Split( "mov;mp4", ";" ) ' may be extended, but must be tested for each video type

```
	For i = 0 To UBound( arrVideoTypes )
```

		If UCase( arrVideoTypes(i) ) = UCase( strVideoInputType ) Then

```
			blnValidType = True
```
```
			Exit For
```
```
		End If
```
```
	Next
```
```
 
```

	If Not blnValidType Or Trim( strVideoInputFile ) = "" Or Not objFso.FileExists( strVideoInputFile ) Then

		intAnswer = MsgBox( "Missing or invalid video file specification", vbRetryCancel, "Specify File" )

```
		If intAnswer = vbCancel Then
```
```
			AbortProgram
```
```
			Exit Sub
```
```
		End If
```
```
	End If
```
```
 
```

	intRotation = CInt( document.getElementById( "Rotation" ).value )

```
	Select Case intRotation
```
```
		Case 90:
```
```
			strTranspose = "-vf transpose=1"
```
```
			strRotated   = ".rotated90byffmpeg"
```
```
		Case 180:
```

			strTranspose = "-vf transpose=2,transpose=2"

```
			strRotated   = ".rotated180byffmpeg"
```
```
		Case 270:
```
```
			strTranspose = "-vf transpose=2"
```
```
			strRotated   = ".rotated270byffmpeg"
```
```
		Case Else:
```
```
			strTranspose = ""
```
```
			strRotated   = "convertedbyffmpeg"
```
```
	End Select
```
```
 
```
```
	With objFso
```

		strVideoOutputFile = .BuildPath( .GetParentFolderName( strVideoInputFile ), .GetBaseName( strVideoInputFile ) & strRotated & ".mp4" )

```
	End With
```
```
 
```

	If objFso.FileExists( strVideoOutputFile ) Then

		intAnswer = MsgBox( "Target file """ & 	strVideoOutputFile & """ already exists, do you want to delete it?", vbYesNoCancel + vbExclamation, "Existing File" )

```
		If intAnswer = vbYes Then
```

			objFso.DeleteFile strVideoOutputFile, True

			If objFso.FileExists( strVideoOutputFile ) Then

				MsgBox "Unable to delete the target file """ & strVideoOutputFile & """, try removing or renaming it manually", vbOKOnly, "Manual Intervention Required"

```
				Exit Sub
```
```
			End If
```
```
		ElseIf intAnswer = vbCancel Then
```
```
			AbortProgram
```
```
			Exit Sub
```
```
		Else
```

			MsgBox "Rename or remove the target file """ & strVideoOutputFile & """ manually and try again", vbOKOnly, "Manual Intervention Required"

```
			Exit Sub
```
```
		End If
```
```
	End If
```
```
 
```

	strCommand = """" & strFFMPEG & """ -i """ & strVideoInputFile & """ " & strTranspose & " """ & strVideoOutputFile & """"

```
	wshShell.Run strCommand, 1, True
```
```
 
```

	If objFso.FileExists( strVideoOutputFile ) Then

		wshShell.Run """" & strVideoOutputFile & """", 0, False

		MsgBox "Converted video file saved as """ & strVideoOutputFile & """", vbOKonly, "Converted Video Saved"

```
	Else
```

		intAnswer = MsgBox( "Something went wrong, do you want to retry?", vbYesNoCancel + vbCritical, "Error" )

```
		If intAnswer = vbYes Then
```

			strCommand = "CMD.EXE /K " & strCommand

```
			wshShell.Run strCommand, 1, True
```

			If objFso.FileExists( strVideoOutputFile ) Then

				wshShell.Run """" & strVideoOutputFile & """", 0, False

```
			Else
```

				MsgBox "Something went wrong, check FFMPEG's console output to find the cause", vbOK + vbCritical, "Error"

```
			End If
```
```
		ElseIf intAnswer = vbCancel Then
```
```
			AbortProgram
```
```
		End If
```
```
	End If
```
```
End Sub
```
```
 
```
```
 
```
```
Sub window_onunload()
```
```
	On Error Resume Next
```
```
	Set wshShell = Nothing
```
```
	Set objFso   = Nothing
```
```
	On Error GoTo 0
```
```
End Sub
```