'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