Dim Offset_to_IFD0Dim Offset_to_APP0Dim Offset_to_APP1Dim Offset_to_TIFFDim Offset_to_SOSDim Length_of_APP0Dim Length_of_APP1Dim Offset_to_Next_IFDDim IFDDirectoryIFDDirectory = Array(0)Dim Offset_to_ExifSubIFDDim ImageFileDim IsLoadedDim ExifTempExifTemp = Array(0)Const IFD_IDX_Tag_No = 0Const IFD_IDX_Tag_Name = 1Const IFD_IDX_Data_Format = 2Const IFD_IDX_Components = 3Const IFD_IDX_Value = 4Const IFD_IDX_Value_Desc = 5Const IFD_IDX_OffsetToValue = 6Function LookupExifTag(which)Dim itemFor Each item In ExifLookupIf ExifLookup(item) = which ThenLookupExifTag = itemExit FunctionEnd IfNextLookupExifTag = whichEnd FunctionFunction GetExifByName(ExifTag)If IsLoaded = False And ImageFile <> "" ThenLoadImage (ImageFile)ElseIf IsLoaded = False And ImageFile = "" ThenExit FunctionEnd IfDim iFor i = 0 To UBound(IFDDirectory) - 1If IFDDirectory(i)(IFD_IDX_Tag_Name) = ExifTag ThenGetExifByName = IFDDirectory(i)(IFD_IDX_Value)Exit ForEnd IfNextEnd FunctionSub LoadImage(picFile)If ImageFile = "" ThenImageFile = picFileIf ImageFile = "" ThenExit SubEnd IfEnd IfOpenJPGFile ImageFileIf InspectJPGFile = False ThenIsLoaded = FalseExit SubEnd IfIf IsIntel ThenOffset_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))ElseOffset_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_IFD0IsLoaded = TrueGetDirectoryEntries Offset_to_TIFF + Offset_to_IFD0MakeSenseOfMeaninglessValuesEnd SubFunction InspectJPGFile()Dim iIf ExifTemp(0) <> "FF" And ExifTemp(1) <> "D8" ThenInspectJPGFile = FalseElseFor i = 2 To UBound(ExifTemp) - 1If ExifTemp(i) = "FF" And ExifTemp(i + 1) = "E0" ThenOffset_to_APP0 = iExit ForEnd IfNextIf Offset_to_APP0 = 0 ThenInspectJPGFile = FalseEnd IfLength_of_APP0 = _HexToDec(ExifTemp(Offset_to_APP0 + 2)) * 256 + _HexToDec(ExifTemp(Offset_to_APP0 + 3))For i = 2 To UBound(ExifTemp) - 1If ExifTemp(i) = "FF" And ExifTemp(i + 1) = "E1" ThenOffset_to_APP1 = iExit ForEnd IfNextIf Offset_to_APP1 = 0 ThenInspectJPGFile = FalseEnd IfOffset_to_TIFF = Offset_to_APP1 + 10Length_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(Offset_to_APP1 + 5))) & _Chr(HexToDec(ExifTemp(Offset_to_APP1 + 6))) & Chr(HexToDec(ExifTemp(Offset_to_APP1 + 7))) <> "Exif" ThenInspectJPGFile = FalseExit FunctionEnd IfInspectJPGFile = TrueEnd IfEnd FunctionFunction IsIntel()If ExifTemp(Offset_to_TIFF) = "49" ThenIsIntel = TrueElseIsIntel = FalseEnd IfEnd FunctionFunction writeExifToJPG(ExifData, FileName)Dim FSO, FSO2, File, i'Const adTypeBinary = 1'Const adTypeText = 2'Const adSaveCreateOverWrite = 2If IsLoaded = False And ImageFile <> "" ThenLoadImage (ImageFile)ElseIf IsLoaded = False And ImageFile = "" ThenExit FunctionEnd If'Create Stream object'Dim BinaryStream'Set BinaryStream = CreateObject("ADODB.Stream")'Specify stream type - we want To save binary data.'BinaryStream.Type = adTypeBinary'Open the stream And write binary data To the object'BinaryStream.Open'BinaryStream.Write ByteArraySet FSO = CreateObject("Scripting.FileSystemObject")'Create text stream objectDim TextStreamSet TextStream = FSO.CreateTextFile(FileName & ".TMP")For i = 0 To (Offset_to_APP0 + 2 + Length_of_APP0 - 1)TextStream.Write Hex2Ascii(ExifTemp(i))NextTextStream.Write Hex2Ascii(ExifData)For i = (Offset_to_APP0 + 2 + Length_of_APP0) To UBound(ExifTemp)TextStream.Write Hex2Ascii(ExifTemp(i))NextSet FSO2 = Server.CreateObject("Scripting.FileSystemObject")If FSO2.FileExists(FileName) ThenSet File = FSO2.OpenTextFile(FileName, ForReading, False, TristateFalse)i = 0While Not File.AtEndOfStreamIf i > UBound(ExifTemp) Then'BinaryStream.Write File.Read(1)TextStream.Write File.Read(1)End Ifi = i + 1WendFile.CloseSet File = NothingElseResponse.Write ("File does not exist")End IfSet FSO2 = NothingSet FSO = Nothing'Save binary data To disk'BinaryStream.SaveToFile FileName & ".TMP", adSaveCreateOverWriteEnd Function