Rob van der Woude's Scripting Pages
Powered by GeSHi

Source code for resizevideo.hta

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

  1. <!doctype html>
  2. <html lang="en">
  3. <head>
  4.  
  5. <title>ResizeVideo, 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. input[type=number]
  32. {
  33. 	font-size: 100%;
  34. }
  35.  
  36. option
  37. {
  38. 	font-size: 100%;
  39. 	text-align: right;
  40. }
  41.  
  42. td
  43. {
  44. 	padding: 10px 25px;
  45. 	width: 50%;
  46. }
  47.  
  48. .Center
  49. {
  50. 	text-align: center;
  51. }
  1. </style>
  2.  
  3. <HTA:APPLICATION
  4.   APPLICATIONNAME="Resize Video"
  5.   ID="ResizeVideo"
  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 arrPATH
  9. Dim intCurrentHeight, intCurrentWidth, intMaxWidth, intMinWidth
  10. Dim objFso, wshShell
  11. Dim strFFMPEG, strFFPROBE, strVersion, strVideoInputFile, strVideoOutputFile
  12.  
  13.  
  14. Sub window_onload()
  15. 	Dim intAnswer, intPosX, intPosY, strMsg, strParentFolder, strTitle
  16.  
  17. 	strVersion = "1.00"
  18.  
  19. 	On Error GoTo 0
  20.  
  21. 	window.resizeTo 1200, 540
  22. 	intPosX = CInt( ( window.screen.width - 1200 ) / 2 )
  23. 	If intPosX < 0 Then intPosX = 0
  24. 	intPosY = 100
  25. 	window.moveTo intPosX, intPosY
  26. 	document.title = "ResizeVideo, Version " & strVersion & " " & Chr( 169 ) & " 2021 Rob van der Woude"
  27. 	Set wshShell = CreateObject( "WScript.Shell" )
  28. 	Set objFso   = CreateObject( "Scripting.Filesystemobject" )
  29. 	arrPATH      = Split( Replace( objFso.GetParentFolderName( self.location.pathname ) & ";" & wshShell.Environment.Item( "PATH" ), "/", "" ), ";" )
  30. 	strFFMPEG    = ""
  31. 	intMinWidth  = 320
  32. 	intMaxWidth  = 8192
  33. 	If Not CheckFFMPEG( ) Then
  34. 		strParentFolder =  Replace( objFso.GetParentFolderName( self.location.pathname ), "/", "" )
  35. 		strMsg          = "Unable to locate FFMPEG.EXE." _
  36. 		                & vbCrLf & vbCrLf _
  37. 		                & "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." _
  38. 		                & vbCrLf & vbCrLf _
  39. 		                & "Do you want to open the FFMPEG download page in your default browser now?"
  40. 		strTitle        = "Missing FFMPEG"
  41. 		intAnswer       = MsgBox( strMsg, vbYesNoCancel, strTitle )
  42. 		If intAnswer = vbYes Then
  43. 			wshShell.Run "https://www.gyan.dev/ffmpeg/builds/", 0, False
  44. 			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."
  45. 		ElseIf intAnswer = vbCancel Then
  46. 			AbortProgram
  47. 		End If
  48. 	End If
  49. End Sub
  50.  
  51.  
  52. Sub AbortProgram( )
  53. 	self.close
  54. End Sub
  55.  
  56.  
  57. Function CheckFFMPEG( )
  58. 	CheckFFMPEG = False
  59. 	Dim i
  60. 	For i = 0 To UBound( arrPATH )
  61. 		strFFMPEG = objFso.BuildPath( arrPATH(i), "ffmpeg.exe" )
  62. 		If objFso.FileExists( strFFMPEG ) Then
  63. 			CheckFFMPEG = True
  64. 			Exit For
  65. 		End If
  66. 	Next
  67. End Function
  68.  
  69.  
  70. Function CheckFFPROBE( )
  71. 	CheckFFPROBE = False
  72. 	Dim i
  73. 	For i = 0 To UBound( arrPATH )
  74. 		strFFPROBE = objFso.BuildPath( arrPATH(i), "ffprobe.exe" )
  75. 		If objFso.FileExists( strFFPROBE ) Then
  76. 			CheckFFPROBE = True
  77. 			Exit For
  78. 		End If
  79. 	Next
  80. End Function
  81.  
  82.  
  83. Sub GetCurrentWidth( )
  84. 	intCurrentWidth = 0
  85. 	strVideoInputFile = document.getElementById( "VideoFile" ).value
  86. 	If CheckFFPROBE Then
  87. 		Dim objExec, strFFProbeCommand, strResult
  88. 		strFFProbeCommand = """" & strFFPROBE & """ -v error -select_streams v:0 -show_entries stream=width,height -of csv=s=x:p=0 """ & strVideoInputFile & """"
  89. 		Set objExec = wshShell.Exec( strFFProbeCommand )
  90. 		strResult   = objExec.StdOut.ReadAll( )
  91. 		Set objExec = Nothing
  92. 		If InStr( strResult, "x" ) Then
  93. 			intCurrentWidth  = CInt( Mid( strResult, 1, InStr( strResult, "x" ) - 1 ) )
  94. 			intCurrentHeight = CInt( Mid( strResult,    InStr( strResult, "x" ) + 1 ) )
  95. 		End If
  96. 	Else
  97. 		Dim objDir, objFile, objShell
  98. 		Set objShell = CreateObject( "Shell.Application" )
  99. 		Set objDir   = objShell.Namespace( objFso.GetDriveName( strVideoInputFile ) )
  100. 		For Each objFile In objDir.Items
  101. 			If objFile.Path = strVideoInputFile Then
  102. 				intCurrentHeight = CInt( objDir.GetDetailsOf( objFile, 314 ) )
  103. 				intCurrentWidth  = CInt( objDir.GetDetailsOf( objFile, 316 ) )
  104.  
  105. 			End If
  106. 		Next
  107. 	End If
  108. 	Set objDir   = Nothing
  109. 	Set objShell = Nothing
  110. 	document.getElementById( "CurrentWidth" ).value = intCurrentWidth
  111. 	intMaxWidth = intCurrentWidth
  112. End Sub
  113.  
  114.  
  115. Function Min( varA, varB )
  116. 	If varA > varB Then
  117. 		Min = varB
  118. 	Else
  119. 		Min = varA
  120. 	End If
  121. End Function
  122.  
  123.  
  124. Sub ShowHelp( )
  125. 	Dim strHelpText
  126. 	' Do not add more text, as it might be truncated by MsgBox limitations
  127. 	strHelpText = "ResizeVideo.hta,  Version " & strVersion & vbCrLf _
  128. 	            & "Resize a video and save it in MP4 format" & vbCrLf & vbCrLf _
  129. 	            & "USAGE:" & vbCrLf & vbCrLf _
  130. 	            & "* Select a video file by clicking the ""Browse"" button" & vbCrLf _
  131. 	            & "* Fill in the required new width" & vbCrLf _
  132. 	            & "* Click the ""Start Conversion"" button" & vbCrLf & vbCrLf _
  133. 	            & "The resized video file will be saved in the same directory where the selected video file is located, with "".resized**x**byffmpeg"" appended to its name, where **x** is the new width and height." & vbCrLf & vbCrLf _
  134. 	            & "Regardless of the input video format, the resized video will always be in MP4 format" & vbCrLf & vbCrLf _
  135. 	            & "REQUIREMENTS:" & vbCrLf & vbCrLf _
  136. 	            & "This HTA is just a front-end to FFMPEG which performs the resizing. It also uses FFPROBE if available." & vbCrLf _
  137. 	            & "FFMPEG and FFPROBE must both be located in the HTA's directory, or in a directory in the PATH." & vbCrLf & vbCrLf _
  138. 	            & "FFMPEG and FFPROBE can be downloaded at https://www.gyan.dev/ffmpeg/builds/" & vbCrLf & vbCrLf _
  139. 	            & "If at startup this HTA cannot find FFMPEG, you will be prompted to open its download URL." & vbCrLf & vbCrLf _
  140. 	            & "CREDITS:" & vbCrLf & vbCrLf _
  141. 	            & "Commands to probe and resize video:" & vbCrLf _
  142. 	            & "https://ottverse.com/change-resolution-resize-scale-video-using-ffmpeg/"
  143. 	MsgBox strHelpText, vbOKOnly, "Help for ResizeVideo.hta Version " & strVersion
  144. End Sub
  145.  
  146.  
  147. Sub StartConversion( )
  148. 	Dim arrVideoTypes
  149. 	Dim blnValidType
  150. 	Dim i, intAnswer, intWidth
  151. 	Dim strCommand, strConverted, strResize, strVideoInputType
  152.  
  153. 	strVideoInputFile = document.getElementById( "VideoFile" ).value
  154.  
  155. 	strVideoInputType = objFso.GetExtensionName( strVideoInputFile )
  156. 	blnValidType      = False
  157. 	arrVideoTypes     = Split( "mov;mp4", ";" ) ' may be extended, but must be tested for each video type
  158. 	For i = 0 To UBound( arrVideoTypes )
  159. 		If UCase( arrVideoTypes(i) ) = UCase( strVideoInputType ) Then
  160. 			blnValidType = True
  161. 			Exit For
  162. 		End If
  163. 	Next
  164.  
  165. 	If Not blnValidType Or Trim( strVideoInputFile ) = "" Or Not objFso.FileExists( strVideoInputFile ) Then
  166. 		intAnswer = MsgBox( "Missing or invalid video file specification", vbRetryCancel, "Specify File" )
  167. 		If intAnswer = vbCancel Then
  168. 			AbortProgram
  169. 			Exit Sub
  170. 		End If
  171. 	End If
  172.  
  173. 	intWidth = CInt( document.getElementById( "NewWidth" ).value )
  174. 	If intWidth = intCurrentWidth Then
  175. 		strConverted = ".convertedbyffmpeg"
  176. 		strResize    = ""
  177. 	Else
  178. 		' "scale='min(320,iw)':'min(240,ih)'"
  179. 		strConverted = ".resized" & intWidth & "x" & CInt( intCurrentHeight * intWidth / intCurrentWidth ) & "byffmpeg"
  180. 		strResize    = "-vf scale=" & intWidth & ":" & CInt( intCurrentHeight * intWidth / intCurrentWidth )
  181. 	End If
  182.  
  183. 	With objFso
  184. 		strVideoOutputFile = .BuildPath( .GetParentFolderName( strVideoInputFile ), .GetBaseName( strVideoInputFile ) & strConverted & ".mp4" )
  185. 	End With
  186.  
  187. 	If objFso.FileExists( strVideoOutputFile ) Then
  188. 		intAnswer = MsgBox( "Target file """ & 	strVideoOutputFile & """ already exists, do you want to delete it?", vbYesNoCancel + vbExclamation, "Existing File" )
  189. 		If intAnswer = vbYes Then
  190. 			objFso.DeleteFile strVideoOutputFile, True
  191. 			If objFso.FileExists( strVideoOutputFile ) Then
  192. 				MsgBox "Unable to delete the target file """ & strVideoOutputFile & """, try removing or renaming it manually", vbOKOnly, "Manual Intervention Required"
  193. 				Exit Sub
  194. 			End If
  195. 		ElseIf intAnswer = vbCancel Then
  196. 			AbortProgram
  197. 			Exit Sub
  198. 		Else
  199. 			MsgBox "Rename or remove the target file """ & strVideoOutputFile & """ manually and try again", vbOKOnly, "Manual Intervention Required"
  200. 			Exit Sub
  201. 		End If
  202. 	End If
  203.  
  204. 	strCommand = """" & strFFMPEG & """ -i """ & strVideoInputFile & """ " & strResize & " -preset slow -crf 18 """ & strVideoOutputFile & """"
  205. 	wshShell.Run strCommand, 1, True
  206.  
  207. 	If objFso.FileExists( strVideoOutputFile ) Then
  208. 		wshShell.Run """" & strVideoOutputFile & """", 0, False
  209. 		MsgBox "Converted video file saved as """ & strVideoOutputFile & """", vbOKonly, "Converted Video Saved"
  210. 	Else
  211. 		intAnswer = MsgBox( "Something went wrong, do you want to retry?", vbYesNoCancel + vbCritical, "Error" )
  212. 		If intAnswer = vbYes Then
  213. 			strCommand = "CMD.EXE /K " & strCommand
  214. 			wshShell.Run strCommand, 1, True
  215. 			If objFso.FileExists( strVideoOutputFile ) Then
  216. 				wshShell.Run """" & strVideoOutputFile & """", 0, False
  217. 			Else
  218. 				MsgBox "Something went wrong, check FFMPEG's console output to find the cause", vbOK + vbCritical, "Error"
  219. 			End If
  220. 		ElseIf intAnswer = vbCancel Then
  221. 			AbortProgram
  222. 		End If
  223. 	End If
  224. End Sub
  225.  
  226.  
  227. Sub ValidateWidth( )
  228. 	Dim objRE, strInput
  229. 	strInput = Trim( document.getElementById( "NewWidth" ).value )
  230. 	If strInput <> "" Then
  231. 		Set objRE = New RegExp
  232. 		objRE.Global  = True
  233. 		objRE.Pattern = "[^\d]+"
  234. 		If objRE.Test( strInput ) Then
  235. 			strInput = objRE.Replace( strInput, "" )
  236. 		End If
  237. 		Set objRE = Nothing
  238. 		If Len( strInput ) > Len( CStr( intMaxWidth ) ) Then strInput = Left( strInput, Len( CStr( intMaxWidth ) ) )
  239. 		If CLng( strInput ) > intMaxWidth Then
  240. 			strInput = CStr( intMaxWidth )
  241. 			document.getElementById( "NewWidth" ).value = intMaxWidth
  242. 		End If
  243. 		' New dimensions must be within boundaries, and if scale equals 1 and input video is MP4 then nothing will be done
  244. 		document.GetElementById( "StartButton" ).disabled = ( ( CLng( strInput ) < intMinWidth ) Or ( CLng( strInput ) > intMaxWidth ) Or ( ( CLng( strInput ) = intMaxWidth ) And ( LCase( objFso.GetExtensionName( strVideoInputFile ) ) = "mp4" ) ) )
  245. 	End If
  246. 	document.getElementById( "NewWidth" ).value = strInput
  247. 	If strInput = "" Then
  248. 		document.getElementById( "NewHeight" ).value = ""
  249. 	ElseIf intCurrentWidth > 0 And intCurrentHeight > 0 Then
  250. 		document.getElementById( "NewHeight" ).value = CLng( strInput ) * intCurrentHeight / intCurrentWidth
  251. 	End If
  252. End Sub
  253.  
  254.  
  255. Sub window_onunload()
  256. 	On Error Resume Next
  257. 	Set wshShell = Nothing
  258. 	Set objFso   = Nothing
  259. 	On Error GoTo 0
  260. End Sub
  1. </script>
  2. </head>
  3.  
  4. <body onhelp="ShowHelp()">
  5.  
  6. <table>
  7. <tr>
  8. 	<td>Video file:</td>
  9. 	<td>&nbsp;</td>
  10. </tr>
  11. <tr>
  12. 	<td colspan="2"><input type="file" name="VideoFile" id="VideoFile" size="80" accept="video/*" onchange="vbscript:GetCurrentWidth( );" /></td>
  13. </tr>
  14. <tr>
  15. 	<td colspan="2">&nbsp;</td>
  16. </tr>
  17. <tr>
  18. 	<td class="Center">Current width: <input type="number" name="CurrentWidth" id="CurrentWidth" size="5" readonly /></td>
  19. 	<td class="Center">Resize to: <input type=number name="NewWidth" id="NewWidth" size="5" onkeyup="vbscript:ValidateWidth( );" onpaste="vbscript:ValidateWidth( );" />x<input type=number name="NewHeight" id="NewHeight" size="5" readonly /></td>
  20. </tr>
  21. <tr>
  22. 	<td colspan="2">&nbsp;</td>
  23. </tr>
  24. <tr>
  25. 	<td colspan="2" class="Center"><input type="button" name="StartButton" id="StartButton" value="Start Conversion" onclick="vbscript:StartConversion( );" disabled /></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