'Removes (regrettably) ADS file comments (right-click / properties) and 
'inserts the comment data directly into the JPG file as a JPG comment.
Option Explicit

Main

Sub Main
	Dim strComment, ws, fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	If WScript.Arguments.Count <> 1 Then
		MsgBox "Drop a JPG file on me to move the file comment into a JPG comment."
		Exit Sub
	End If
	If Not fs.FileExists(WScript.Arguments(0)) Then
		MsgBox "Drop a JPG file on me to move the file comment into a JPG comment."
		Exit Sub
	End If
	strComment = Trim(GetAdsComments(WScript.Arguments(0)))
	If strComment <> "" Then
		If CommandExists("exiv2.exe", "Usage") Then
			ws.Run "exiv2.exe -c """ & strComment & """ """ & WScript.Arguments(0) & """", 0, True
			'exiv2 -M "set Iptc.Application2.Caption String This is an IPTC caption!"  test.jpg
			'exiv2 -M "set Iptc.Application2.Headline String This is an IPTC headline!" test.jpg
			'exiv2 -M "set Exif.Photo.UserComment charset=Ascii New Exif comment" test.jpg
			'exiv2 -M "set Exif.Image.ImageDescription charset=Ascii New Exif comment" test.jpg
		ElseIf CommandExists("jhead.exe", "No files to process") Then
			ws.Run "jhead.exe -cl """ & strComment & """ """ & WScript.Arguments(0) & """", 0, True
		ElseIf CommandExists("exiftool.exe", "SYNOPSIS") Then
			ws.Run "exiftool -overwrite_original -comment=""" & strComment & """ """ & WScript.Arguments(0) & """", 0, True
		Else
			If MsgBox("You need one of the following tools in your %PATH%:" & vbCrLf _
				& "EXIV2 - http://www.exiv2.org/download.html" & vbCrLf _
				& "JHEAD - http://www.sentex.net/~mwandel/jhead/" & vbCrLf _
				& "EXIF TOOL - http://www.sno.phy.queensu.ca/~phil/exiftool/" & vbCrLf _
				& "Press OK to be taken to the EXIV2 download page.", vbOKCancel, "Program Dependency") = vbOk Then
				ws.Run "http://www.exiv2.org/download.html", 1, False
			End If
		End If
	Else
		'MsgBox "There weren't any file comments!"
	End If
End Sub

Function GetAdsComments(strFile)
Const FILE_NAME = 0
Dim shFile, strOut, intComment, sh, shFol, fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set sh = CreateObject("Shell.Application")
	Set shFol = sh.Namespace(fs.GetParentFolderName(strFile))
	strOut = ""
	'Find out what item holds the ADS "Comment" data (varies between OS)
	intComment = -1
	On Error Resume Next 'In case elements don't go as high as 37
	For intComment = 0 To 37
		If "Comment" = shFol.GetDetailsOf(shFol.Items, intComment) Then
			Exit For
		End If
	Next
	If intComment = -1 Then
		GetAdsComments = ""
		Exit Function
	End If
	'Iterate through the folder until we find our file
	For Each shFile in shFol.Items
		If fs.GetFileName(strFile) = shFol.GetDetailsOf(shFile, FILE_NAME) Then
			GetAdsComments = shFol.GetDetailsOf(shFile, intComment)
			Exit Function
		End If
	Next
	GetAdsComments = ""
End Function

Function CommandExists(strCommand, strProof)
'Returns true if a command line utility will run. 
'Enter the command and some text that appears in the command output.
Dim strData, app, ws, intMaxCount, intCount
	On Error Resume Next
	Set ws = CreateObject("Wscript.Shell")
	strData = ""
	intMaxCount = 10 'A one-second max time since each loop is 1/10 of a second
	intCount = 0
	Err.Clear
	Set app = ws.Exec(strCommand)
	If Err.Number = 0 Then
		Do While app.Status = 0
			WScript.Sleep 100
			intCount = intCount + 1 'Keep track of how many times we've waited.
			If intCount > intMaxCount Then Exit Do 'Don't get stuck waiting for user input.
		Loop
		strData = app.StdOut.ReadAll
		strData = strData & app.StdErr.ReadAll
	End If
	If strData = "" Then
		CommandExists = False
	Else
		If InStr(strData, strProof) = 0 Then
			CommandExists = False
		Else
			CommandExists = True
		End If
	End If
End Function
