Dim offset_to_ifd0
Dim offset_to_app0
Dim Offset_to_app1
Dim Offset_to_tiff
Dim Offset_to_sos
Dim length_of_app0
Dim Length_of_app1
Dim offset_to_next_ifd
Dim ifddirectory
ifddirectory = Array (0)
Dim offset_to_exifsubifd
Dim imagefile
Dim IsLoaded
Dim exiftemp
exiftemp = Array (0)
Const IFD_IDX_TAG_NO = 0
Const IFD_IDX_TAG_NAME = 1
Const IFD_IDX_DATA_FORMAT = 2
Const IFD_IDX_COMPONENTS = 3
Const IFD_IDX_VALUE = 4
Const IFD_IDX_VALUE_DESC = 5
Const IFD_IDX_OFFSETTOVALUE = 6
Function Lookupexiftag (which)
Dim item
For each item in Exiflookup
If Exiflookup (item) = which then
Lookupexiftag = Item
Exit function
End If
Next
Lookupexiftag = which
End Function
Function Getexifbyname (Exiftag)
If IsLoaded = False and ImageFile <> "" Then
LoadImage (ImageFile)
ElseIf IsLoaded = False and ImageFile = "" Then
Exit Function
End If
Dim I
For i = 0 to UBound (ifddirectory)-1
If ifddirectory (i) (ifd_idx_tag_name) = Exiftag Then
Getexifbyname = Ifddirectory (i) (Ifd_idx_value)
Exit for
End If
Next
End Function
Sub LoadImage (Picfile)
If imagefile = "" Then
ImageFile = Picfile
If imagefile = "" Then
Exit Sub
End If
End If
Openjpgfile ImageFile
If inspectjpgfile = False Then
IsLoaded = False
Exit Sub
End If
If Isintel Then
Offset_to_ifd0 = _
Hextodec (Exiftemp (Offset_to_app1 + 17)) * 256 * 256 * 256 + _
Hextodec (exiftemp (Offset_to_app1 + 16)) * 256 * 256 + _
Hextodec (exiftemp (Offset_to_app1 + 15)) * 256 + _
Hextodec (Exiftemp (OFFSET_TO_APP1 + 14))
Else
Offset_to_ifd0 = _
Hextodec (Exiftemp (OFFSET_TO_APP1 + 14)) * 256 * 256 * 256 + _
Hextodec (exiftemp (Offset_to_app1 + 15)) * 256 * 256 + _
Hextodec (exiftemp (Offset_to_app1 + 16)) * 256 + _
Hextodec (Exiftemp (Offset_to_app1 + 17))
End If
' Debug.Print ' Offset_to_ifd0: "& offset_to_ifd0
IsLoaded = True
Getdirectoryentries Offset_to_tiff + offset_to_ifd0
Makesenseofmeaninglessvalues
End Sub
Function Inspectjpgfile ()
Dim I
If exiftemp (0) <> "FF" and Exiftemp (1) <> "D8" Then
Inspectjpgfile = False
Else
For i = 2 to UBound (exiftemp)-1
If exiftemp (i) = "FF" and exiftemp (i + 1) = "E0" Then
Offset_to_app0 = i
Exit for
End If
Next
If offset_to_app0 = 0 Then
Inspectjpgfile = False
End If
Length_of_app0 = _
Hextodec (Exiftemp (offset_to_app0 + 2)) * 256 + _
Hextodec (Exiftemp (offset_to_app0 + 3))
For i = 2 to UBound (exiftemp)-1
If exiftemp (i) = "FF" and exiftemp (i + 1) = "E1" Then
OFFSET_TO_APP1 = i
Exit for
End If
Next
If offset_to_app1 = 0 Then
Inspectjpgfile = False
End If
Offset_to_tiff = Offset_to_app1 + 10
Length_of_app1 = _
Hextodec (Exiftemp (OFFSET_TO_APP1 + 2)) * 256 + _
Hextodec (Exiftemp (OFFSET_TO_APP1 + 3))
If Chr (Hextodec (exiftemp (Offset_to_app1 + 4))) & Chr (Hextodec (exiftemp + 5))) & _
Chr (Hextodec (exiftemp (OFFSET_TO_APP1 + 6))) & Chr (Hextodec (exiftemp + 7))) <> "Exif" Offset_to_app1
Inspectjpgfile = False
Exit Function
End If
Inspectjpgfile = True
End If
End Function
Function Isintel ()
If exiftemp (Offset_to_tiff) = "Then"
Isintel = True
Else
Isintel = False
End If
End Function
Function writeexiftojpg (Exifdata, FileName)
Dim FSO, FSO2, File, I
' Const Adtypeb