用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
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