用JPEG文件EXIF信息ASP版本（3）

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(Offset_to_APP1 + 5))) & _
Chr(HexToDec(ExifTemp(Offset_to_APP1 + 6))) & Chr(HexToDec(ExifTemp(Offset_to_APP1 + 7))) <> "Exif" Then
InspectJPGFile = False
Exit Function
End If

InspectJPGFile = True
End If

End Function

Function IsIntel()
If ExifTemp(Offset_to_TIFF) = "49" Then
IsIntel = True
Else
IsIntel = False
End If
End Function

Function writeExifToJPG(ExifData, FileName)
Dim FSO, FSO2, File, i
‘’Const adTypeBinary = 1
‘’Const adTypeText = 2
‘’Const adSaveCreateOverWrite = 2

If IsLoaded = False And ImageFile <> "" Then
LoadImage (ImageFile)
ElseIf IsLoaded = False And ImageFile = "" Then
Exit Function
End 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 ByteArray
Set FSO = CreateObject("Scripting.FileSystemObject")

‘’Create text stream object
Dim TextStream
Set TextStream = FSO.CreateTextFile(FileName & ".TMP")

For i = 0 To (Offset_to_APP0 + 2 + Length_of_APP0 - 1)
TextStream.Write Hex2Ascii(ExifTemp(i))
Next

TextStream.Write Hex2Ascii(ExifData)

For i = (Offset_to_APP0 + 2 + Length_of_APP0) To UBound(ExifTemp)
TextStream.Write Hex2Ascii(ExifTemp(i))
Next

Set FSO2 = Server.CreateObject("Scripting.FileSystemObject")
If FSO2.FileExists(FileName) Then
Set File = FSO2.OpenTextFile(FileName, ForReading, False, TristateFalse)
i = 0
While Not File.AtEndOfStream
if i > UBound(ExifTemp) then
‘’BinaryStream.Write File.Read(1)
TextStream.Write File.Read(1)
end if
i = i + 1
Wend
File.Close

Set File = Nothing
Else
Response.Write("File does not exist")
End If
Set FSO2 = Nothing
Set FSO = Nothing

‘’Save binary data To disk
‘’BinaryStream.SaveToFile FileName & ".TMP", adSaveCreateOverWrite

End Function

原文转自：http://www.ltesting.net