http://paulgrant.ca/code_image_details_gps.html
Тривиальные изменения в этом скрипте могут привести к выводу любых данных EXIF.
'PAULGRANT.CA 2011
Option Explicit
'On Error Resume Next
Const ForWriting = 2
Const FileCreate = True
Const TristateTrue = -1 'Unicode
Const SecondsToWait = 10
Const YesNo = 4
Const IconQuestion = 32
Dim WshShell, iCode, sCurrentFolderName, sOutputFileName
Dim oFS, oFolder, oTS, oImg, oFile
Dim iPos, sExt, sString
Set WshShell = WScript.CreateObject("WScript.Shell")
iCode = WshShell.Popup("Continue?", SecondsToWait, "Run This Script?", YesNo + IconQuestion)
If (iCode <> 6) Then
WScript.Quit 1
End If
sCurrentFolderName = WshShell.CurrentDirectory
sOutputFileName = sCurrentFolderName & "\output.txt"
Set oFS = WScript.CreateObject("Scripting.FileSystemObject")
Set oFolder = oFS.GetFolder(sCurrentFolderName)
Set oTS = oFS.OpenTextFile(sOutputFileName, ForWriting, FileCreate, TristateTrue)
Set oImg = WScript.CreateObject("WIA.ImageFile")
For Each oFile In oFolder.Files
iPos = InStrRev(oFile.Name, ".")
sExt = Mid(oFile.Name, iPos)
If (LCase(sExt) = ".jpg") Then
sString = DoImage(oFile.Name)
WScript.Echo sString
If (sString <> "") Then
oTS.WriteLine sString
End If
End If
Next
oTS.Close
WScript.Echo "Done"
'FUNCTIONS
Function DoImage(sFileName)
Dim i, j, v, s, sOutput, sPropertyName
sOutput = ""
oImg.LoadFile sFileName
'This handles no attribs added by cybernard
if oImg.Properties.count=0 then
' Do something about it
wscript.echo "File:"&sFileName&" has no attributes"
End if
'End of cybernard add
For i = 1 to oImg.Properties.Count
sPropertyName = oImg.Properties(i).Name
WScript.Echo "Prop:"&sPropertyName&" "&oImg.Properties(i).Value
If InStr(sPropertyName, "Gps") > 0 Then
s = sPropertyName & "(" & oImg.Properties(i).PropertyID & ") = "
If oImg.Properties(i).IsVector Then
s = s & "[vector]"
Set v = oImg.Properties(i).Value
If sPropertyName = "GpsLatitude" Then
s = s & FormatCoords(v, oImg.Properties("GpsLatitudeRef").Value)
ElseIf sPropertyName = "GpsLongitude" Then
s = s & FormatCoords(v, oImg.Properties("GpsLongitudeRef").Value)
Else
For j = 1 To v.Count
s = s & v(j) & " "
Next
End If
Else
s = s & oImg.Properties(i).Value
End If
sOutput = sOutput & s & vbCrLf
End If
Next
DoImage = sOutput
End Function
Function FormatCoords(v,sRef)
'On Error Resume Next
Dim sCoords
sCoords = v(1) & Chr(176) & v(2) & Chr(39) & v(3) & Chr(34) & sRef
FormatCoords = sCoords
End Function
'End.