• 当前位置:首页>>ASP教程>>ASP综合技巧>>用JPEG文件EXIF信息ASP版本(3)
  • 用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版本(2)
    下一篇:用JPEG文件EXIF信息ASP版本(4)