' VLC Multithreaded Batch Transcoder for Windows Visual Basic Scripting Host
' Works nice for iPhone/iPod.  Probably good for PSP, 3gp compatible phones, and other portable media devices too.
'
' Version 1.1
'
' * Changelog, Todo, and license are at the end of the file.
'
' Acknowledgements:
' ----------
' Original code based on: http://episteme.arstechnica.com/eve/forums/a/tpc/f/12009443/m/516001349831
' Script discovered at:   http://wiki.videolan.org/Transcode
' This version by:        Taylor Veltrop (taylor@veltrop.com, http://taylor.veltrop.com/software.php#transcode)
'
' * Usage Notes: *
' ----------
' * At the very least you must set strVLCdirectory, strSource, and strTarget.  Put your movies in strSource, or a subdirectory of it.
' * If a file has already been transcoded and exists in the strTarget, it will be skipped.  So it is safe to one-time set your strSource to your bittorrent's completed directory or something similar.
' * VLC version 0.8.6i recommended.  Some later versions have some fatal bugs and crash with certian transcode settings. (namely h264) But, now I have been having problems with ogm and mkv in 0.8.6i, so more experimentation is needed.
' * If strTarget doesn't exist it will be created.  If a subdirectory of strSource doesn't exist in strTarget, this will also be created.
' * Set numThreads to the max number of vlc processes you want to run.  I suggest number of cpus(cores) minus one.  One thread is launched for each input file (up to the maximum numThreads).
' * I suggest that you dont set showInterface=False until you have settings that you know work (becuase it supresses error reporting)
' * Edit the video/audio resolution, bitrate, aspect ratio, and codecs in the strTranscode variable.
'
' Transcoder settings notes:
' ----------
' iphone resolution: 480x320 (1.5:1)
' iPod resolution:   320x240 (4:3)
' 320x240  -> iphone = 426.667x320
' 1280x720 -> iphone = 568.889x320, 480x270
' quicktime's iphone export does this: 4:3 input -> 480x324
' my favorite results for iphone:      4:3 input -> 426x320
'
' vcodec:
' 512,800,1024 mp4v has been recommended, change vb= in strTranscode to change the quality.
' I like vcodec=mp4v,vb=448 for animation.  A half hour show becomes about 100 megs.
' 256k,384k h264 video bitrate ok for animations (but h264 encoded with vlc DOESN'T WORK on the iphone...)
'
Dim strSource, strTarget, strVLCdirectory, strTranscode, strTargetFileExtension, strMux, enableSubdirectoryRecursion, numThreads, showInterface

'**********************************************
'''''''''''SET YOUR PARAMETERS HERE''''''''''''
strVLCdirectory             = "C:\Program Files\VLCDIRECTORY"
strSource                   = "C:\Documents and Settings\USERNAME\My Documents\Downloads\ENCODEME"
strTarget                   = "C:\Documents and Settings\USERNAME\My Documents\Downloads\ENCODEME\DONE"
strTranscode                = "width=426,height=320,canvas-aspect=1.5:1,vcodec=mp4v,vb=448,acodec=mp4a,ab=128,channels=2,audio-sync"  ' vb= is the quality setting
strTargetFileExtension      = "mp4"
strMux                      = "mp4" ' this is often the same as strTargetFileExtension, but not necessarily  
enableSubdirectoryRecursion = True  ' set to False to disable looking at subdirectories of strSource (except for the strTarget of course)
numThreads                  = 1     ' number of cpus minus one is recommended
showInterface               = True  ' True/False.  If set to false, you can check on it thru localhost:8080.  8080 + threadNumber - 1 for multiple threads
'''''''''''''''''''''''''''''''''''''''''''''''
'**********************************************

' *** Unless you want to play with the code, you do not need to look below this line ***
' ----------------------------------------------------------------------------------------------

' Need to initialize the objExecs with a dummy Exec() command becuase activex doesn't let us do it manually, and I need objExecs(i).Status = 1 to get the threads going.
Dim objShell, objExecs, strShow
Redim objExecs(numThreads - 1)
For i=LBound(objExecs) To UBound(objExecs)
    Set objShell = CreateObject("WScript.Shell")
    Set objExecs(i) = objShell.Exec("C:\WINDOWS\system32\rundll32") ' dummy command to initialize execution status of threads
    Set objShell = Nothing
Next
If showInterface Then 
    strShow = " "
Else
    'strShow = " -I dummy --quiet " ' this is good, but I get stupid error messages related to the vlc compiler, which don't end up effecting the output file
    'strShow = " -I rc --quiet "    ' useful in the future?
    strShow = " -I http "           ' this one is completely quiet, and we can still check on it via http
End If

Call RecurseDir(strSource, strTarget)

Sub RecurseDir(strSource, strTarget)
	Dim strTempSource, strTempTarget, i, strOldName, strNewName, objFSO, strPort
	Set objFSO = CreateObject("Scripting.FileSystemObject")
	Set strTempSource = objFSO.GetFolder(strSource)
    
	' Error handling for destination
	If Not objFSO.FolderExists(strTarget) Then
		objFSO.CreateFolder(strTarget)
	End If

	Set strTempTarget = objFSO.GetFolder(strTarget)

	' Loop thru the files in the directory
	For each file in strTempSource.files
		strOldName = strSource & "\" & file.name
		strNewName = strTempTarget & "\" & Mid(file.name, 1, InstrRev(file.name, ".")) & strTargetFileExtension

		' if the file hasn't already been encoded do this block
		If Not objFSO.FileExists(strNewName) Then
            ' This next block finds our next free thread, if all threads are busy we wait and check on them once per second
			Do While 1=1
			    For i=LBound(objExecs) To UBound(objExecs)  ' scan threads
			        If objExecs(i).Status = 1 Then Exit For
			    Next
			    If i = numThreads Then ' maxed out, so wait
			        WScript.Sleep 1000
			    Else 
			        Exit Do ' a free thread must exist, lets go
			    End If
			Loop
			
			If showInterface Then
			    strPort = " "
			Else
			    strPort = " --http-host localhost:" &  CStr(8080 + i) & " "
			End If 
			
			' Finally, encode using the selected thread
			Set objShell = CreateObject("WScript.Shell")
		    objShell.CurrentDirectory = strVLCdirectory
			Select Case Right(strOldName, 3) 
				Case "avi","mkv","mpg","mpeg","divx","xvid","mov","3gp","dat","ogm","asf","wmv","flv"
					Set objExecs(i) = objShell.Exec("vlc " & strShow & strPort & " file://""" & strOldName & """ :sout=#transcode{" & strTranscode & "}:duplicate{dst=std{access=file,mux=" & strMux & ",dst=""" & strNewName & """}} vlc://quit")
			End Select 
			Set objShell = Nothing
		End If
	Next
	
	' Recurse
	If enableSubdirectoryRecursion Then
	    For each subdir in strTempSource.subfolders
	        If Not subdir.path = strTarget Then ' Error handling: don't recurse into our completed directory!
  	            call RecurseDir(subdir.path, strTempTarget & "\" & subdir.name)
  	        End If
	    Next
	End If
End Sub

'
' Changelog:
' ----------
' 1.1 Multithreading management
'     Lots of comments, documentation
'     Silent mode through http interface
'     Improved error handling
' 1.0 Initial release
'     Various improvements to script found at http://wiki.videolan.org/Transcode: 
'       cleaned up
'       iphone support
'       multithreading
'       better user configurable options
'       freed user from need to edit any code
'       freed user from command line
'
' Todo:
' ----------
' Figure out cropping and aspect ratio output better, add easily editable settings for this.
'   -> ?? width=426,canvas-height=320 (and no canvas-aspect or height flags)  Need to experiment with that more...
'
' License:
' ----------
' Copyright (c) 2008, Taylor Veltrop
' All rights reserved.
' Redistribution and use in source and binary forms, with or without modification, are 
' permitted provided that the following conditions are met:
'    * Redistributions of source code must retain the above copyright notice, this list 
'      of conditions and the following disclaimer.
'    * Redistributions in binary form must reproduce the above copyright notice, this 
'      list of conditions and the following disclaimer in the documentation and/or other 
'      materials provided with the distribution.
'    * Neither the name of the developer nor the names of its contributors may be used to 
'      endorse or promote products derived from this software without specific prior written 
'      permission.
'
' THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY 
' EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 
' MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL 
' THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 
' SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT 
' OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
' INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 
' LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 
' OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
'