'Displays JPG comment. Assuming desired tool is available, returns first of:
'1 - Operating System Comment (right-click / properties / summary / comments)
'2 - JPG Comment
'3 - IPTC Caption
'4 - IPTC Headline
'5 - EXIF User Comment
'6 - EXIF Image Description
Option Explicit

Main

Sub Main
Dim fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	If WScript.Arguments.Count <> 1 Then
		MsgBox "Drop a JPG file on me to display the comment."
		Exit Sub
	End If
	If Not fs.FileExists(WScript.Arguments(0)) Then
		MsgBox "Drop a JPG file on me to display the comment."
		Exit Sub
	End If
	MsgBox GetComments(WScript.Arguments(0))
End Sub

Function GetComments(strFile)
Dim strComments
	strComments = GetAdsComments(strFile)
	If strComments = "" Then
		If CommandExists("exiv2.exe", "Usage") Then
			strComments = GetExiv2Comments(strFile)
			If strComments = "" Then
				strComments = GetExiv2Description(strFile)
			End If
		ElseIf CommandExists("jhead.exe", "No files to process") Then
			strComments = GetJHeadComments(strFile)
		ElseIf CommandExists("exiftool.exe", "SYNOPSIS") Then
			strComments = GetExifToolComments(strFile)
		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
	End If
	GetComments = strComments
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

Function GetExiv2Comments(strFile)
Dim strData, app, ws, intMaxCount, intCount
	On Error Resume Next
	Set ws = CreateObject("Wscript.Shell")
	strData = ""
	intMaxCount = 20 'A two-second max time since each loop is 1/10 of a second
	intCount = 0
	Err.Clear
	Set app = ws.Exec("exiv2.exe -pc """ & strFile & """")
	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
		GetExiv2Comments = Trim(app.StdOut.ReadAll)
	Else
		GetExiv2Comments = ""
	End If
End Function

Function GetExiv2Description(strFile)
Dim strData, app, ws, intMaxCount, intCount
	On Error Resume Next
	Set ws = CreateObject("Wscript.Shell")
	strData = ""
	intMaxCount = 20 'A two-second max time since each loop is 1/10 of a second
	intCount = 0
	Err.Clear
	strData = ""
	Set app = ws.Exec("exiv2.exe -pa """ & strFile & """")
	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 = Trim(app.StdOut.ReadAll)
		If InStr(1, strData, "Iptc.Application2.Caption", vbTextCompare) <> 0 Then
			strData = Mid(strData, InStr(1, strData, "Iptc.Application2.Caption", vbTextCompare))
			strData = Mid(strData, 61)
			strData = Left(strData, InStr(strData, vbCrLf))
		ElseIf InStr(1, strData, "Iptc.Application2.Headline", vbTextCompare) <> 0 Then
			strData = Mid(strData, InStr(1, strData, "Iptc.Application2.Headline", vbTextCompare))
			strData = Mid(strData, 61)
			strData = Left(strData, InStr(strData, vbCrLf))
		ElseIf InStr(1, strData, "Exif.Photo.UserComment", vbTextCompare) <> 0 Then
			strData = Mid(strData, InStr(1, strData, "Exif.Photo.UserComment", vbTextCompare))
			strData = Mid(strData, 61)
			strData = Left(strData, InStr(strData, vbCrLf))
		ElseIf InStr(1, strData, "Exif.Image.ImageDescription", vbTextCompare) <> 0 Then
			strData = Mid(strData, InStr(1, strData, "Exif.Image.ImageDescription", vbTextCompare))
			strData = Mid(strData, 61)
			strData = Left(strData, InStr(strData, vbCrLf))		
		End If
	End If
	GetExiv2Description = strData
End Function

Function GetExifToolComments(strFile)
Dim strData, app, ws, intMaxCount, intCount
	On Error Resume Next
	Set ws = CreateObject("Wscript.Shell")
	strData = ""
	intMaxCount = 20 'A two-second max time since each loop is 1/10 of a second
	intCount = 0
	Err.Clear
	Set app = ws.Exec("exiftool.exe -comment """ & strFile & """")
	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 = Trim(app.StdOut.ReadAll)
		If strData <> "" Then
			If InStr(strData, ":") <> 0 Then
				If (Len(strData) - InStr(strData, ":")) > 1 Then
					strData = Trim(Mid(strData, InStr(strData, ":") + 1))
				End If
			End If
		End If
	Else
		strData = ""
	End If
	GetExifToolComments = strData
End Function

Function GetJHeadComments(strFile)
Const TemporaryFolder = 2
Const ForReading = 1
Dim ws, strTemp, strData, fs
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set ws = CreateObject("Wscript.Shell")
	strTemp = fs.BuildPath(fs.GetSpecialFolder(TemporaryFolder), fs.GetBaseName(WScript.ScriptName) & ".tmp")
	ws.Run "jhead.exe -cs """ & strTemp & """ """ & strFile & """", 0, True
	strData = ""
	strData = Trim(fs.OpenTextFile(strTemp, ForReading, True).ReadAll)
	On Error Resume Next
	If fs.FileExists(strTemp) Then fs.DeleteFile strTemp
	GetJHeadComments = strData
End Function

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

