vb 英文版exif处理源代码，改中文版 续002

Function ChangeExif(strFileName As String, LstIndex As Long, NewVal1 As String, NewVal2 As String)
    ' This function is just a copy of the read function with a few commented changes
    
    'On Error Resume Next
    Dim I             As Long
    Dim tmpStr        As String
    Dim AppDataLength As Long
    Dim Offset2IFD    As Long
    
    Open strFileName For Binary Access Read Write As #5
    I = 3
    Seek #5, I
    Do
        tmpStr = Input(2, 5)
        Select Case Left$(Byte2Hex(tmpStr), 3)
        Case "FFE": Exit Do
        Case Else
            tmpStr = Input(2, 5)
            I = I + (Byte2Dec(tmpStr) - 2)
            Seek #5, I
        End Select
    Loop Until EOF(5)
    If EOF(5) Then Close #5: Exit Function
    
    AppDataLength = Byte2Dec(Input(2, 5)) - 2
    tmpStr = Input(6, 5) ' Waster
    strChunkData = Input(AppDataLength, 5)
    Offset2IFD = Byte2Dec(Rev(Mid$(strChunkData, 5, 4)))
    
    Dim NumofDirEntries     As Long
    Dim DirEntryInfo        As String
    Dim DataFormat          As Long
    Dim SpecialField        As Boolean
    Dim TagName             As String
    Dim SizeMultiplier      As Long
    Dim LenOfTagData        As Double
    Dim MoreChunkOffsets(2) As Long
    Dim ActiveOffset        As Byte
    
    Dim RawData             As String ' Temporary holds the converted format of a number/string
    
    Do
        NumofDirEntries = Byte2Dec(Rev(Mid$(strChunkData, Offset2IFD + 1, 2)))
        For I = 0 To NumofDirEntries - 1
            DirEntryInfo = Mid$(strChunkData, Offset2IFD + 3 + (I * 12), 12)
            
            Select Case ActiveOffset
            Case 0: TagName = GetTagName(Rev(Mid$(DirEntryInfo, 1, 2)), SpecialField)
            Case 1: TagName = GetTagNameGPS(Rev(Mid$(DirEntryInfo, 1, 2)), SpecialField)
            Case 2: TagName = GetTagNameInteroperability(Rev(Mid$(DirEntryInfo, 1, 2)), SpecialField)
            End Select
            DataFormat = Byte2Dec(Rev(Mid$(DirEntryInfo, 3, 2)))
            SizeMultiplier = Byte2Dec(Rev(Mid$(DirEntryInfo, 5, 4)))
            LenOfTagData = CLng(TypeOfTag(DataFormat)) * SizeMultiplier
            
            
            
            ' Check for a tag match
            If ListInfo(0, LstIndex) = Byte2Hex(Rev(Mid$(DirEntryInfo, 1, 2))) Then
                
                ' Convert the values into there correct formats to write
                RawData = ConvertData2FormatBackwards(DataFormat, NewVal1)
                Select Case DataFormat
                Case 5, 10: RawData = RawData & ConvertData2FormatBackwards(DataFormat, NewVal2) ' Change 2nd for rational
                End Select
                
                ' Write the new raw data
                If LenOfTagData <= 4 Then
                    Seek #5, Offset2IFD + 3 + (I * 12) + 20 + 2
                    Put #5, , RawData
                Else
                    tmpStr = ConvertData2Format(DataFormat, Mid$(strChunkData, Byte2Dec(Rev(Mid$(DirEntryInfo, 9, 4))) + 1, LenOfTagData))
                    Seek #5, Byte2Dec(Rev(Mid$(DirEntryInfo, 9, 4))) + 1 + 12 ' +12 for Tiff header
                    Put #5, , RawData
                End If
            End If
            
            
            
            If TagName = "Exif IFD" Then
                MoreChunkOffsets(0) = ConvertData2Format(DataFormat, Rev(Right$(Mid$(DirEntryInfo, 9, 4), LenOfTagData)))
            ElseIf TagName = "GPS IFD" Then
                MoreChunkOffsets(1) = ConvertData2Format(DataFormat, Rev(Right$(Mid$(DirEntryInfo, 9, 4), LenOfTagData)))
            ElseIf TagName = "Interoperability IFD" Then
                MoreChunkOffsets(2) = ConvertData2Format(DataFormat, Rev(Right$(Mid$(DirEntryInfo, 9, 4), LenOfTagData)))
            End If
        Next I
        
        If MoreChunkOffsets(0) <> 0 Then
            Offset2IFD = MoreChunkOffsets(0): MoreChunkOffsets(0) = 0: ActiveOffset = 0
        ElseIf MoreChunkOffsets(1) <> 0 Then
            Offset2IFD = MoreChunkOffsets(1): MoreChunkOffsets(1) = 0: ActiveOffset = 1
        ElseIf MoreChunkOffsets(2) <> 0 Then
            Offset2IFD = MoreChunkOffsets(2): MoreChunkOffsets(2) = 0: ActiveOffset = 2
        Else
            Exit Do
        End If
    Loop
    Close #5
End FunctionFunction ConvertData2FormatBackwards(DataFormat As Long, InValue As String) As String
    ' This function mostly converts the number to hex, then groups of 2 hex's to a character
    
    Dim I As Long ' Counter
    Dim tmpInt As Integer
    Dim tmpLng As Long
    Dim tmpSng As Single
    Dim tmpDbl As Double
    Dim tmpStr1 As String, tmpStr2 As String ' Converter helpers
    Dim tmpStr4 As String * 4
    Dim tmpStr8 As String * 8
    'Dim tmpCur1 As Currency, tmpCur2 As Currency ' holds a big slow whole value
    
    Select Case DataFormat
    Case 1 ' Unsigned Byte
        ConvertData2FormatBackwards = Chr$("&H" & Right$(Hex(Val(InValue)), 2))
        
    Case 2, 7: ConvertData2FormatBackwards = InValue
        
    Case 3 ' Unsigned Short
        tmpStr1 = Hex(Val(InValue))
        tmpStr1 = "000" & tmpStr1                            ' make sure the length is at least 2 bytes
        For I = Len(tmpStr1) - 1 To Len(tmpStr1) - 3 Step -2 ' get the last 2 bytes backwards
            ConvertData2FormatBackwards = ConvertData2FormatBackwards & Chr$("&H" & Mid$(tmpStr1, I, 2))
        Next I
        
    Case 4, 5 ' Unsigned Long
        tmpStr1 = Hex(Val(InValue))
        tmpStr1 = "0000000" & tmpStr1                        ' make sure the length is at least 4 bytes
        For I = Len(tmpStr1) - 1 To Len(tmpStr1) - 7 Step -2 ' get the last 4 bytes backwards
            ConvertData2FormatBackwards = ConvertData2FormatBackwards & Chr$("&H" & Mid$(tmpStr1, I, 2))
        Next I
        
    Case 6 ' Signed Byte
        tmpLng = Val(InValue)
        If tmpLng < 0 Then tmpStr2 = (tmpLng Xor -256) Else tmpStr2 = tmpLng ' use the correct bit arrangment for converting
        ConvertData2FormatBackwards = ConvertData2FormatBackwards(1, tmpStr2)
        
    Case 8 ' Signed Short
        tmpLng = Val(InValue)
        If tmpLng < 0 Then tmpStr2 = (tmpLng Xor -65536) Else tmpStr2 = tmpLng
        ConvertData2FormatBackwards = ConvertData2FormatBackwards(3, tmpStr2)
        
    Case 9, 10 ' Signed Long - this one is not properly tested
        'tmpCur2 = -4294967296#
        tmpLng = (2 ^ 30)
        If Val(InValue) < 0 Then
            tmpDbl = Val(InValue) Xor tmpLng       ' 30 bits   ' Stops overflow problems with xor
            If tmpDbl > tmpLng Then
                tmpDbl = tmpDbl Xor tmpLng         ' 31 bits
                If tmpDbl > tmpLng Then
                    tmpDbl = tmpDbl Xor tmpLng     ' 31.5 bits
                    If tmpDbl > tmpLng Then
                        tmpDbl = tmpDbl Xor tmpLng ' 32 bits
                    End If
                End If
            End If
        Else
            tmpStr2 = Val(InValue)
        End If
        tmpStr1 = Hex(Val(tmpStr2))
        tmpStr1 = "0000000" & tmpStr1                        ' make sure the length is at least 4 bytes
        For I = Len(tmpStr1) - 1 To Len(tmpStr1) - 7 Step -2 ' get the last 4 bytes backwards
            ConvertData2FormatBackwards = ConvertData2FormatBackwards & Chr$("&H" & Mid$(tmpStr1, I, 2))
        Next I
        'Stop
        
    Case 11 ' Single Float
        tmpSng = CSng(InValue)
        CopyMemory tmpStr4, tmpSng, 4 ' *** Probably will crash the program - need a bit of help here
        ConvertData2FormatBackwards = tmpStr4
        
    Case 12 ' Double Float
        tmpDbl = CDbl(InValue)
        CopyMemory tmpStr8, tmpDbl, 8 ' *** Probably will crash the program
        ConvertData2FormatBackwards = tmpStr8
    End Select
End Function