Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for rotatevideo.hta

(view source code of rotatevideo.hta as plain text)

  1. <!doctype html>
  2. <html lang="en">
  3. <head>
  4.  
  5. <title>RotateVideo, Version 1.0.0</title>
  6.  
  7. <meta http-equiv="X-UA-Compatible" content="IE=10">
  8.  
  9. <style>
  10. body
  11. {
  12. 	background-color: gray;
  13. 	color: white;
  14. 	font-family: 'Segoe UI';
  15. 	font-size: 18pt;
  16. 	margin: 50px;
  17. }
  18.  
  19. input[type=button]
  20. {
  21. 	font-size: 150%;
  22. 	height: 2em;
  23. 	width: 20em;
  24. }
  25.  
  26. input[type=file]
  27. {
  28. 	font-size: 100%;
  29. }
  30.  
  31. option
  32. {
  33. 	font-size: 100%;
  34. 	text-align: right;
  35. }
  36.  
  37. td
  38. {
  39. 	padding: 10px 25px;
  40. }
  1. </style>
  2.  
  3. <HTA:APPLICATION
  4.   APPLICATIONNAME="Rotate Video"
  5.   ID="RotateVideo"
  6.   VERSION="1.00"
  7.   BORDER="none"
  8.   INNERBORDER="no"
  9.   SYSMENU="no"
  10.   MAXIMIZEBUTTON="no"
  11.   SCROLL="auto"
  12.   SINGLEINSTANCE="yes"
  13.   CONTEXTMENU="no"/>
  14.  
  15. <script language="VBScript">
  1. Option Explicit
  2. On Error GoTo 0
  3.  
  4. Const wshFailed   = 2
  5. Const wshFinished = 1
  6. Const wshRunning  = 0
  7.  
  8. Dim objFso, strFFMPEG, strVersion, wshShell
  9.  
  10.  
  11. Sub window_onload()
  12. 	Dim intAnswer, intPosX, intPosY, strMsg, strParentFolder, strTitle
  13.  
  14. 	strVersion = "1.00"
  15.  
  16. 	On Error GoTo 0
  17.  
  18. 	window.resizeTo 1800, 360
  19. 	intPosX = CInt( ( window.screen.width - 1800 ) / 2 )
  20. 	If intPosX < 0 Then intPosX = 0
  21. 	intPosY = intPosX
  22. 	window.moveTo intPosX, intPosY
  23. 	document.title = "RotateVideo, Version " & strVersion & " " & Chr( 169 ) & " 2021 Rob van der Woude"
  24. 	Set wshShell = CreateObject( "WScript.Shell" )
  25. 	Set objFso   = CreateObject( "Scripting.Filesystemobject" )
  26. 	strFFMPEG = ""
  27. 	If Not CheckFFMPEG( ) Then
  28. 		strParentFolder =  Replace( objFso.GetParentFolderName( self.location.pathname ), "/", "" )
  29. 		strMsg          = "Unable to locate FFMPEG.EXE." _
  30. 		                & vbCrLf & vbCrLf _
  31. 		                & "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." _
  32. 		                & vbCrLf & vbCrLf _
  33. 		                & "Do you want to open the FFMPEG download page in your default browser now?"
  34. 		strTitle        = "Missing FFMPEG"
  35. 		intAnswer       = MsgBox( strMsg, vbYesNoCancel, strTitle )
  36. 		If intAnswer = vbYes Then
  37. 			wshShell.Run "https://www.gyan.dev/ffmpeg/builds/", 0, False
  38. 			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."
  39. 		ElseIf intAnswer = vbCancel Then
  40. 			AbortProgram
  41. 		End If
  42. 	End If
  43. End Sub
  44.  
  45.  
  46. Sub AbortProgram( )
  47. 	self.close
  48. End Sub
  49.  
  50.  
  51. Function CheckFFMPEG( )
  52. 	CheckFFMPEG = False
  53. 	Dim arrPATH, i
  54. 	arrPATH = Split( Replace( objFso.GetParentFolderName( self.location.pathname ) & ";" & wshShell.Environment.Item( "PATH" ), "/", "" ), ";" )
  55. 	For i = 0 To UBound( arrPATH )
  56. 		strFFMPEG = objFso.BuildPath( arrPATH(i), "ffmpeg.exe" )
  57. 		If objFso.FileExists( strFFMPEG ) Then
  58. 			CheckFFMPEG = True
  59. 			Exit For
  60. 		End If
  61. 	Next
  62. End Function
  63.  
  64.  
  65. Sub showHelp( )
  66. 	Dim strHelpText ' Do not add more text, as it might be truncated by MsgBox limitations
  67. 	strHelpText = "RotateVideo.hta,  Version " & strVersion & vbCrLf _
  68. 	            & "Rotate a video in 90 degrees steps and save it in MP4 format" & vbCrLf & vbCrLf _
  69. 	            & "USAGE:" & vbCrLf & vbCrLf _
  70. 	            & "* Select a video file by clicking the ""Browse"" button" & vbCrLf _
  71. 	            & "* Select the required rotation from the dropdown list" & vbCrLf _
  72. 	            & "* Click the ""Start Conversion"" button" & vbCrLf & vbCrLf _
  73. 	            & "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 _
  74. 	            & "Regardless of the input video format, the converted/rotated video will always be in MP4 format" & vbCrLf & vbCrLf _
  75. 	            & "REQUIREMENTS:" & vbCrLf & vbCrLf _
  76. 	            & "This HTA is just a front-end to FFMPEG.EXE which performs the actual rotation/conversion." & vbCrLf _
  77. 	            & "FFMPEG.EXE must be located in HTA's directory, or in a directory in the PATH." & vbCrLf & vbCrLf _
  78. 	            & "FFMPEG can be downloaded at https://www.gyan.dev/ffmpeg/builds/" & vbCrLf & vbCrLf _
  79. 	            & "If at startup this HTA cannot find FFMPEG.EXE, you will be prompted to open its download URL." & vbCrLf & vbCrLf _
  80. 	            & "CREDITS:" & vbCrLf & vbCrLf _
  81. 	            & "FFMPEG command to rotate video:" & vbCrLf _
  82. 	            & "https://stackoverflow.com/a/9570992"
  83. 	MsgBox strHelpText, vbOKOnly, "Help for RotateVideo.hta Version " & strVersion
  84. End Sub
  85.  
  86.  
  87. Sub StartConversion( )
  88. 	Dim arrVideoTypes
  89. 	Dim blnValidType
  90. 	Dim i, intAnswer, intRotation
  91. 	Dim strCommand, strRotated, strTranspose, strVideoInputType, strVideoInputFile, strVideoOutputFile
  92.  
  93. 	strVideoInputFile = document.getElementById( "VideoFile" ).value
  94.  
  95. 	strVideoInputType = objFso.GetExtensionName( strVideoInputFile )
  96. 	blnValidType      = False
  97. 	arrVideoTypes     = Split( "mov;mp4", ";" ) ' may be extended, but must be tested for each video type
  98. 	For i = 0 To UBound( arrVideoTypes )
  99. 		If UCase( arrVideoTypes(i) ) = UCase( strVideoInputType ) Then
  100. 			blnValidType = True
  101. 			Exit For
  102. 		End If
  103. 	Next
  104.  
  105. 	If Not blnValidType Or Trim( strVideoInputFile ) = "" Or Not objFso.FileExists( strVideoInputFile ) Then
  106. 		intAnswer = MsgBox( "Missing or invalid video file specification", vbRetryCancel, "Specify File" )
  107. 		If intAnswer = vbCancel Then
  108. 			AbortProgram
  109. 			Exit Sub
  110. 		End If
  111. 	End If
  112.  
  113. 	intRotation = CInt( document.getElementById( "Rotation" ).value )
  114. 	Select Case intRotation
  115. 		Case 90:
  116. 			strTranspose = "-vf transpose=1"
  117. 			strRotated   = ".rotated90byffmpeg"
  118. 		Case 180:
  119. 			strTranspose = "-vf transpose=2,transpose=2"
  120. 			strRotated   = ".rotated180byffmpeg"
  121. 		Case 270:
  122. 			strTranspose = "-vf transpose=2"
  123. 			strRotated   = ".rotated270byffmpeg"
  124. 		Case Else:
  125. 			strTranspose = ""
  126. 			strRotated   = "convertedbyffmpeg"
  127. 	End Select
  128.  
  129. 	With objFso
  130. 		strVideoOutputFile = .BuildPath( .GetParentFolderName( strVideoInputFile ), .GetBaseName( strVideoInputFile ) & strRotated & ".mp4" )
  131. 	End With
  132.  
  133. 	If objFso.FileExists( strVideoOutputFile ) Then
  134. 		intAnswer = MsgBox( "Target file """ & 	strVideoOutputFile & """ already exists, do you want to delete it?", vbYesNoCancel + vbExclamation, "Existing File" )
  135. 		If intAnswer = vbYes Then
  136. 			objFso.DeleteFile strVideoOutputFile, True
  137. 			If objFso.FileExists( strVideoOutputFile ) Then
  138. 				MsgBox "Unable to delete the target file """ & strVideoOutputFile & """, try removing or renaming it manually", vbOKOnly, "Manual Intervention Required"
  139. 				Exit Sub
  140. 			End If
  141. 		ElseIf intAnswer = vbCancel Then
  142. 			AbortProgram
  143. 			Exit Sub
  144. 		Else
  145. 			MsgBox "Rename or remove the target file """ & strVideoOutputFile & """ manually and try again", vbOKOnly, "Manual Intervention Required"
  146. 			Exit Sub
  147. 		End If
  148. 	End If
  149.  
  150. 	strCommand = """" & strFFMPEG & """ -i """ & strVideoInputFile & """ " & strTranspose & " """ & strVideoOutputFile & """"
  151. 	wshShell.Run strCommand, 1, True
  152.  
  153. 	If objFso.FileExists( strVideoOutputFile ) Then
  154. 		wshShell.Run """" & strVideoOutputFile & """", 0, False
  155. 		MsgBox "Converted video file saved as """ & strVideoOutputFile & """", vbOKonly, "Converted Video Saved"
  156. 	Else
  157. 		intAnswer = MsgBox( "Something went wrong, do you want to retry?", vbYesNoCancel + vbCritical, "Error" )
  158. 		If intAnswer = vbYes Then
  159. 			strCommand = "CMD.EXE /K " & strCommand
  160. 			wshShell.Run strCommand, 1, True
  161. 			If objFso.FileExists( strVideoOutputFile ) Then
  162. 				wshShell.Run """" & strVideoOutputFile & """", 0, False
  163. 			Else
  164. 				MsgBox "Something went wrong, check FFMPEG's console output to find the cause", vbOK + vbCritical, "Error"
  165. 			End If
  166. 		ElseIf intAnswer = vbCancel Then
  167. 			AbortProgram
  168. 		End If
  169. 	End If
  170. End Sub
  171.  
  172.  
  173. Sub window_onunload()
  174. 	On Error Resume Next
  175. 	Set wshShell = Nothing
  176. 	Set objFso   = Nothing
  177. 	On Error GoTo 0
  178. End Sub
  1. </script>
  2. </head>
  3.  
  4. <body onhelp="ShowHelp()">
  5.  
  6. <table>
  7. <tr>
  8. 	<td>Video file:</td>
  9. 	<td><input type="file" name="VideoFile" id="VideoFile" size="80" accept="video/*" /></td>
  10. 	<td>Rotate <select name="Rotation" id="Rotation" size="1">
  11. 		<option value="0">0</option>
  12. 		<option value="90">90</option>
  13. 		<option value="180">180</option>
  14. 		<option value="270">270</option>
  15. 		</select> degrees clockwise</td>
  16. </tr>
  17. <tr>
  18. 	<td>&nbsp;</td>
  19. 	<td>&nbsp;</td>
  20. 	<td>&nbsp;</td>
  21. </tr>
  22. <tr>
  23. 	<td>&nbsp;</td>
  24. 	<td style="text-align: right"><input type="button" name="StartButton" id="StartButton" value="Start Conversion" onclick="vbscript:StartConversion( );" /></td>
  25. 	<td>&nbsp;</td>
  26. </tr>
  27. </table<
  28. <!--{{InsertControlsHere}} - Do not remove this line-->
  29.  
  30. </body>
  31. </html>

page last uploaded: 2021-01-27, 16:12