' ------------------------------------------------------------------------------------
'         			TransfertStereoPic.vbs
' This script will transfert pictures and video from a pair of digital cameras.
' When connected to the computer each camera has a unique ID that the script is using
' to distinguish the left camera from the right camera. Replace the two first "Const"
' with the actual values for your cameras.
' To determine the ID, plug the cameras and run the script once. You should get a
' message saying "Number of camera(s) found = 2". If not check the connexions ant the
' cameras settings. If ok, you will see two lines with the ID at the end. Copy the
' ID in the script for the left and right camera IDs.
' The user is prompted for a target folder and the pictures are copied there appending
' a _L or _R to the filenames. The script will also try to place the right picture
' after the left one in the album (or the left before the right one) by trying to
' locate a picture in the album with the same number (so the two cameras should be in
' sync when numbering their pictures).
' Optionnaly the pictures can be automatically erased from the cameras (set the
' "bDeletePicAfterTransfer" constant to "True".
'
' Notes:
' 1) Windows XP SP1 needed and the WIAAut.dll DLL is required (to use the WIA
'    Automation Layer), see:
' http://msdn.microsoft.com/library/default.asp?url=/library/en-us/wiaaut/wia/wiax/overviews/gettingstartedsamples.asp
' 2) Some cameras have to be set in the USB / PTP mode (see your camera manual).
' 3) To have a constant ID, you will generally have to plug each camera in the same
'    USB port each time.
' 4) All camera do not support deleting the pictures inside the camera, you will get
'    a warning message and will have to erase the picture from the camera.
' ------------------------------------------------------------------------------------

option explicit

' Kodak CX6200
'const LeftCamID  = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0020"
'const RightCamID = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0019"

' Sony DSC-V1
const LeftCamID  = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0033"
const RightCamID = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0032"


'const RightCamID = "{6BDD1FC6-810F-11D0-BEC7-08002BE2092F}\0010"

Const bDeletePicAfterTransfer = False
Const sAppendLeft  = "_L"	' text to append to the left picture file (img001.jpg --> img001_L.jpg)
Const sAppendRight = "_R"	' and to the right picture
Const sDefaultOffset = "50,0"	' If defined, will set the "Offset" Custom field to the specified value for the right picture

Dim devMngr
Dim s, alb, sOutputPath, pic
Dim devL, devR 'As Device

App.ClearTrace
set devMngr = CreateObject( "WIA.DeviceManager" )


' List all available devices by Name and DeviceID
Dim i, n 'As Integer
n = devMngr.DeviceInfos.Count
App.Trace "Number of camera(s) found = " & n, -1, TRACE_INFORMATION
set devL = Nothing
set devR = Nothing
For i = 1 to devMngr.DeviceInfos.Count
  app.Trace " Camera " & i & ":" & vbTab & devMngr.DeviceInfos(i).Properties("Name").Value & vbTab & "ID: " & devMngr.DeviceInfos(i).DeviceID, &hff0000
  if devMngr.DeviceInfos(i).DeviceID = LeftCamID then
    set devL = devMngr.DeviceInfos(i).Connect
    App.Trace "Left camera found !", -1, TRACE_ARROW
  elseif devMngr.DeviceInfos(i).DeviceID = RightCamID then
    set devR = devMngr.DeviceInfos(i).Connect
    App.Trace "Right camera found !", -1, TRACE_ARROW
  end if
Next

if devL is Nothing and devR is Nothing then
  app.Trace "No camera found, check connexion and script configuration", 255, TRACE_ERROR
else

  set alb = app.GetCurrentAlbum
  ' Use the album folder as the default output folder
  sOutputPath = alb.ExpandMacro( Nothing, "%Af" )
  s = "Select the output folder (default is the album folder)"
  if bDeletePicAfterTransfer then s = s & vbCRLF & vbCRLF & "CAUTION: Pictures will be removed from the camera!"
  sOutputPath = app.GetFilename( s, 2, sOutputPath, "", 0 )
  if sOutputPath <> "" then
    if not devL is Nothing then TransfertPic devL, sAppendLeft,  True
    if not devR is Nothing then TransfertPic devR, sAppendRight, False
  end if

  app.Trace "Done !!!", -1, TRACE_OK
end if

' ------------------------------------------------------------------------------------
' Transfer pictures and videos from one camera
' ------------------------------------------------------------------------------------
sub TransfertPic( byref dev, sCamID, bIsLeftCam )
  'App.Trace "Items:", -1, TRACE_INFORMATION
  
  if dev.Properties.Exists("Pictures Taken") then
    app.Trace "Pictures to transfert = " &  dev.Properties("Pictures Taken").Value, -1, TRACE_INFORMATION
  end if
  
  Dim img, itm, sName, sExt, sDate, sFileName
  For Each itm In dev.Items
    sDate = ""
    sExt = ""
    If itm.Properties.Exists("Item Name") Then
      sName = itm.Properties("Item Name").Value
      If itm.Properties.Exists("Item Time Stamp") Then
        Dim v 'As Vector

        Set v = itm.Properties("Item Time Stamp").Value
        If v.Count = 8 Then
            sDate = v.Date
        End If
      End If

      If itm.Properties.Exists("Filename extension") Then
        sExt = lcase(itm.Properties("Filename extension").value)
        ' Test for common picture and video file types
        if sExt = "jpg" or sExt = "tif" or sExt = "mov" or sExt = "mpg" or sExt = "avi" Then
          sFileName = sName & sCamID & "." & sExt
          if alb.GetPictureByFilename( sFileName ) is Nothing then
            sFileName = sOutputPath & "\" & sFileName 
            app.Trace "  transfering picture " & sName & "." & sExt & "  " & vbTab & "(taken " & sDate & ")   --->   " & sFileName
            Set Img = Itm.Transfer
	    Img.SaveFile sFileName
	    set pic = alb.AddPicture( sFileName )
	    FindOtherPic pic, sCamID, bIsLeftCam
	    if bDeletePicAfterTransfer then
	      For i = 1 to Dev.Items.Count
		If dev.Items(i).ItemID = itm.ItemID Then
		  'Some Cameras do not support deleting pictures
		  On Error Resume Next
		  dev.Items.Remove i
		  If Err.Number <> 0 Then
		    app.Trace "Error while deleting picture: " & Err.Description, -1, TRACE_ERROR
		    Err.Clear
		  End If
		  On Error Goto 0
		  Exit For
		End If
	      Next	    
	    end if
	    if not bIsLeftCam and sDefaultOffset <> "" then
	      pic.SetCustomField "Offset", sDefaultOffset
	    end if
	  else
	    app.Trace "Picture '" & sFileName & "' already in album!", -1, TRACE_WARNING
	  end if
        end if
      end if
    else
      ''App.Trace "Unnamed item..."
    end if
  Next
  alb.Redraw
end sub

' ------------------------------------------------------------------------------------
' Try to place the new picture to the corresponding one in the pair
' Assumes that pictures are named iii_nnnn.jpg. The function will try to find another
' picture in the album with the same nnnn value.
' ------------------------------------------------------------------------------------
Function FindOtherPic( byref picRef, sCamID, bIsLeftCam )
  Dim sFile, i, n, pic
  FindOtherPic = False
  sFile = mid( alb.ExpandMacro( picRef, "%BF" ), 4, 5 )
  'app.trace sFile
  n = alb.nbPicture
  for i = 0 to n-1
    set pic = alb.GetPicture( i )
    if sFile = mid( alb.ExpandMacro( pic, "%BF" ), 4, 5 ) and pic.num <> picRef.num then
      app.Trace "    moving picture next to corresponding picture in pair"
      alb.MovePicture picRef, pic.num, not bIsleftCam
      FindOtherPic = True
      exit for
    end if  
  next  
end function