用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

上一个：用JPEG文件EXIF信息ASP版本（4）
下一个：一个统计当前在线用户的解决方案