Read/Write Exif dates

[Sparkie]

Ahhhh....the good old days when I had time to code.

You're welcome GeoTrail. Glad to see the oldies are still useful

[Stefou]

Thank you for this code !

With it, i make one i need. For rotation of my pictures.
return 0 if there is can not get exif
return 1 for ok
return 6 for rotation right 90
return 8 for rotation left 90

Code: Select all

Procedure GetRotationExif(jpg$)
  If  OpenFile(0, jpg$)
  ;--> Byte 0 of EXIF begins after JPEG header
  FileSeek(0,12)
  ;--> Bytes 0-1 is word order 18761 ($4949) is Intel and 19789 ($4D4D) is Motorola
  byteOrder = ReadWord(0)
  ;--> For now I only handle Little Endian
  If byteOrder = $4949
    ; --> Bytes 2-3 is TIFF format, it's always 42 ($2A). If not, give up.
    tifFormat = ReadWord(0)
    ;--> This is always $2A. If not, give up.
    If tifFormat = $2A
      ;--> Bytes 4-7 is starting offset for IFD (Image File Directory)
      ifd1 = ReadLong(0)
      ;--> Move to start of IFD
      FileSeek(0,ifd1 + 12)
      ;--> First 2 bytes of IFD is number of field entries
      nFields = ReadWord(0)
      ;--> Loop through all fields to find Date/Time stamp
      For i = 1 To nFields
        ;--> Bytes 0-1 contain the Tag for the field.
        currentTag = ReadWord(0) &$FFFF
        Select currentTag
          Case 274 ;orientation
            FileSeek(0,Loc(0) + 6)
            orientation= ReadWord(0)
            ReadWord(0)
          Default
            num_champ+1
            ;--> Move to next field. Each field is 12 bytes.
            ;--> currentTag (2 bytes) is current Loc(0) so we add 10
            FileSeek(0,Loc(0) + 10)
        EndSelect
      Next i
      CloseFile(0)
      exifResult = orientation
    Else
      ;--> Wrong format, display Unavailable
      exifResult = 0
    EndIf
  Else
    ;--> Wrong byte order, display Unavailable
    exifResult = 0
  EndIf
Else
  ;--> Impossible de lire le fichier
  exifResult = 0
EndIf
  ProcedureReturn exifResult
EndProcedure

[CONVERT]

The Sparkie's code works, but only for jpg coming from camera (Panasonic Lumix), not from jpg rotated by Microsoft Viewer in W7.
In the last case, byteOrder = $4D4D instead of $4949.

Thanks to oryaaaaa in http://www.purebasic.fr/english/viewtop ... 12&t=47673

I extracted from his code xchEndianW and xchEndianL procedures, and I use them
according to byteOrder = $4949 or not.

So, the following code works for jpg from camera AND from jpg rotated by Microsoft.

Do not ask me any explanation, I strictly understand nothing, but it works...

Code: Select all

EnableExplicit

#Exif_DT_Modified   = $132  ; 306 
#Exif_Sub           = $8769 ; 34665 
#Exif_DT_Taken      = $9003 ; 36867 
#Exif_DT_Digitized  = $9004 ; 36868 
#EXIFHeader         = 12
#JFIFHeader         = 30
#ModifiedDate       = 0 
#TakenDate          = 1 
#DigitizedDate      = 2

Procedure.w xchEndianW(e.w) 
  ProcedureReturn (e & $FF) << 8 + (e >> 8) & $FF 
EndProcedure 

Procedure.l xchEndianL(e.l) 
  ProcedureReturn (e & $FF) << 24 + (e & $FF00) << 8 + (e >> 8) & $FF00 + (e >> 24) & $FF 
EndProcedure

Procedure.s GetExifDateTime(Pjpg$)
  Dim exifDate$(2)
  Define wh, output$, offset, byteOrder, tifFormat, ifd1, nFields, i, currentTag
  Define fieldType, fieldLength, currentloc, fieldValue
  Define ExifLoc, tag, currLoc, datLoc
  
  wh = ReadFile(#PB_Any, Pjpg$)
  If wh = 0
    output$ = "Error open " + Pjpg$ 
    ProcedureReturn output$
  EndIf
  
  If Lof(wh) < 100
    output$ = "Error file too little " + Pjpg$ 
    ProcedureReturn output$
  EndIf
  
  FileSeek(wh,6)
  Select ReadLong(wh)
      Case $66697845 ;"Exif"
          offset = #EXIFHeader
          ;report("Header type: EXIF")
      Case $4649464A ;"JFIF"
          offset = #JFIFHeader
          ;report("Header type: JFIF")
  Default
      output$ = "Error: No headertype could be identified in " + Pjpg$
      CloseFile(wh)
      ProcedureReturn output$
  EndSelect
  
  
  ; --> Byte 0 of EXIF begins after JPEG header 
  FileSeek(wh,offset)
  
  ; --> Bytes 0-1 is byte order 18761 ($4949) is Intel and 19789 ($4D4D) is Motorola 
  byteOrder = ReadWord(wh) 
  If byteOrder = $4949 Or byteOrder = $4D4D

    If byteOrder = $4949
      ; --> Bytes 2-3 is TIFF format, it's always 42 ($2A). If not, give up. 
      tifFormat = ReadWord(wh) 
    Else
      tifFormat = xchEndianW(ReadWord(wh))
    EndIf

    If tifFormat = $2A 

      If byteOrder = $4949
        ; --> Bytes 4-7 is starting offset for IFD (Image File Directory) 
        ifd1 = ReadLong(wh) 
      Else
        ifd1 = xchEndianL(ReadLong(wh))
      EndIf

      ; --> Move to start of IFD 
      FileSeek(wh,ifd1 + offset) 

      If byteOrder = $4949      
        ; --> First 2 bytes of IFD is number of field entries 
        nFields = ReadWord(wh) 
      Else
        nFields = xchEndianW(ReadWord(wh))
      EndIf

      ; --> Loop through all fields to find Date/Time stamp 
      ;date_time = #False 
      For i = 1 To nFields 

        If byteOrder = $4949 
          ; --> Bytes 0-1 contain the Tag for the field. 
          currentTag = ReadWord(wh) &$FFFF 
        Else
          currentTag = xchEndianW(ReadWord(wh)) &$FFFF
        EndIf

        Select currentTag 
          Case #Exif_DT_Modified 

            If byteOrder = $4949
              ; --> Bytes 2-3 contain the field Type. 
              ; --> We know this will be 2 (ASCII) For Date/Time 
              fieldType = ReadWord(wh) 
            Else
              fieldType = xchEndianW(ReadWord(wh))
            EndIf

            ; --> Bytes 4-7 contain the  Length of the field. 
            fieldLength = ReadLong(wh) 
            currentloc = Loc(wh) 

            If byteOrder = $4949
              ; --> Bytes 8-11 contain a pointer to ASCII Date/Time 
              fieldValue = ReadLong(wh)
            Else
              fieldValue = xchEndianL(ReadLong(wh))
            EndIf

            ; --> Move to that pointer 
            FileSeek(wh,fieldValue + offset) 
            ; --> This is the start point of Dat/Time ASCII string 
            exifDate$(#ModifiedDate) = ReadString(wh) 
            ;allDate$ = "Modified:" + #TAB$ + exifDate$(#ModifiedDate) 
            FileSeek(wh,currentloc+4) 

          Case #Exif_Sub 
            FileSeek(wh,Loc(wh) + 6) 

            If byteOrder = $4949
              ExifLoc = ReadLong(wh)
            Else
              ExifLoc = xchEndianL(ReadLong(wh))
            EndIf 

            FileSeek(wh,ExifLoc + offset + 2) 
            Repeat

              If byteOrder = $4949 
                tag = ReadWord(wh) &$FFFF
              Else
                tag = xchEndianW(ReadWord(wh)) &$FFFF
              EndIf

              If tag = #Exif_DT_Taken
                currLoc = Loc(wh)
                FileSeek(wh,Loc(wh) + 6)

                If byteOrder = $4949
                  datLoc = ReadLong(wh)
                Else
                  datLoc = xchEndianL(ReadLong(wh))
                EndIf

                FileSeek(wh,datLoc + offset)
                exifDate$(#TakenDate) = ReadString(wh)
                ;allDate$ + #CRLF$ + "Taken:" + #TAB$ + exifDate$(#TakenDate)
                FileSeek(wh,currLoc + 10)
              EndIf
              If tag = #Exif_DT_Digitized
                currLoc = Loc(wh)
                FileSeek(wh,Loc(wh) + 6)

                If byteOrder = $4949
                  datLoc = ReadLong(wh)
                Else
                  datLoc = xchEndianL(ReadLong(wh))
                EndIf

                FileSeek(wh,datLoc + offset)
                FileSeek(wh,currLoc + 10)
              EndIf
              If tag <> #Exif_DT_Taken And tag <> #Exif_DT_Digitized
                FileSeek(wh,Loc(wh) + 10)
              EndIf
            Until tag = 0
          Default
            ; --> Move to next field. Each field is 12 bytes.
            ; --> currentTag (2 bytes) is current Loc() so we add 10
            FileSeek(wh,Loc(wh)+10)
        EndSelect
      Next i
    Else
      output$ = "Error Invalid file format " + Pjpg$
    EndIf
  Else
    output$ = "Error Invalid file format (2) " + Pjpg$
  EndIf
  CloseFile(wh)
  
  If exifDate$(#TakenDate) ; Or exifDate$(#ModifiedDate)
      output$ = exifDate$(#TakenDate)   
  EndIf
  
  ProcedureReturn Trim(output$)
  
EndProcedure

; MessageRequester("08/09/2012 14:08",GetExifDateTime("IMGP0373.JPG"),0) ; rotation by Microsoft Viewer

; MessageRequester("2012:09:15 12:50:52",GetExifDateTime("IMGP0374.JPG"),0) ; direct from camera

[Phantomas]

Some updates (like correct CloseFile() call) and EnableExplicit support for Stefou code:

Code: Select all

; Return 0 If there is can Not get exif
; Return 1 For ok
; Return 6 For rotation right 90
; Return 8 For rotation left 90

EnableExplicit

#image_file = 0

Procedure GetRotationExif(jpg.s)
  If ReadFile(#image_file, jpg)
    ;--> Byte 0 of EXIF begins after JPEG header
    FileSeek(#image_file, 12)
    ;--> Bytes 0-1 is word order 18761 ($4949) is Intel and 19789 ($4D4D) is Motorola
    Protected byteOrder.i = ReadWord(#image_file)
    ;--> For now I only handle Little Endian
    If byteOrder = $4949
      ; --> Bytes 2-3 is TIFF format, it's always 42 ($2A). If not, give up.
      Protected tifFormat.i = ReadWord(#image_file)
      ;--> This is always $2A. If not, give up.
      If tifFormat = $2A
        ;--> Bytes 4-7 is starting offset for IFD (Image File Directory)
        Protected ifd1.i = ReadLong(#image_file)
        ;--> Move to start of IFD
        FileSeek(#image_file, ifd1 + 12)
        ;--> First 2 bytes of IFD is number of field entries
        Protected nFields.i = ReadWord(#image_file)
        ;--> Loop through all fields to find Date/Time stamp
        Protected i.i
        For i = 1 To nFields
          ;--> Bytes 0-1 contain the Tag for the field.
          Protected currentTag.i = ReadWord(#image_file) & $FFFF
          Select currentTag
            Case 274 ;orientation
              FileSeek(#image_file, Loc(#image_file) + 6)
              Protected orientation.i = ReadWord(#image_file)
              ReadWord(#image_file)
            Default
              Protected num_champ.i
              num_champ + 1
              ;--> Move to next field. Each field is 12 bytes.
              ;--> currentTag (2 bytes) is current Loc(0) so we add 10
              FileSeek(#image_file, Loc(#image_file) + 10)
          EndSelect
        Next i
        Protected.i exifResult = orientation
      Else
        ;--> Wrong format, display Unavailable
        exifResult = 0
      EndIf
    Else
      ;--> Wrong byte order, display Unavailable
      exifResult = 0
    EndIf
    CloseFile(#image_file)
  Else
    ;--> Impossible de lire le fichier
    exifResult = 0
  EndIf
  ProcedureReturn exifResult
EndProcedure

Debug GetRotationExif("image.jpg")

[AndrewM]

I have also been trying to read exif tags for some time and have found a similar project in the DotNet world. The compiled application works on 2010-2012 model Fuji, Panasonic and Pentax photos. The source code is quite short and it should be simple to port to PureBasic. The source code is here.
http://www.codeproject.com/Articles/272 ... ction-libr

[AndrewM]

I have been extracting Exif tags using code similar to the code above but my code does not work for XMP data and I don't think the above code handles it either. XMP data is a small XML file embedded in the jpeg header. If I use a photo editor to geotag my photos, it writes the coordinates into the embedded XMP metadata rather than as exif tags. To get GPS coordinates from XMP meta data, I have written this small test program. It relies on XMP data being in plain text within a jpeg file. I am sure that there is a more formal way of doing this but at this time I just need results and a rude hack will do.

Code: Select all

Pattern$ = "Photos(*.jpg)"
Pattern = 0    ; use the first of the three possible patterns as standard
File$ = OpenFileRequester("Please choose file to load", StandardFile$, Pattern$, Pattern)

;declare variables
x.s
i.l
dmx.s ;Degrees with decimal minutes x coord
dmy.s
t2start.l; tag start
t1start.l
tagLats.s = "<exif:GPSLatitude>"
tagLate.s =  "</exif:GPSLatitude>"
tagLongs.s = "<exif:GPSLongitude>"
tagLonge.s="</exif:GPSLongitude>"
eleLength.l ; element length

If ReadFile (0,File$)
    While Eof(0) = 0         ; loop as long the 'end of file' isn't reached or till we have the information we need
        x=ReadString(0)      ; display line by line in the debug window
        i.l = FindString(x,tagLats,#PB_String_CaseSensitive)  
        j.l = FindString(x,tagLongs,#PB_String_CaseSensitive)
        If i 
            t1start=FindString(x,tagLats) + Len(tagLats)
            t2start=FindString(x,tagLate)
            eleLength= t2start - t1start
            If eleLength > 0 
                dmx = Mid(x,t1start,eleLength)
            Else
                dmx = "No closing tag"
                
            EndIf      
            If (Len(dmx) >0 And Len(dmy)>0)
                Break
            EndIf
        EndIf
        If j
            t1start=FindString(x,tagLongs) + Len(tagLongs)
            t2start=FindString(x,tagLonge)
            eleLength= t2start - t1start
            If eleLength > 0 
                dmy = Mid(x,t1start,eleLength)
            Else
                dmy = "No closing tag"
            EndIf  
            If (Len(dmx) >0 And Len(dmy)>0)
                Break
            EndIf
        EndIf
    Wend
    CloseFile(0)               ; close the previously opened file
    MessageRequester("XMP coords", "Coords for file: " + File$+ Chr(10) +"Latitude "+dmx+Chr(10)+"Longitude "+dmy, 0)
Else
    MessageRequester("Information","Couldn't open the file!")
EndIf

[AndrewM]

I can't find any open and readable code on the net that can read XMP data from Jpegs so I wrote something. I am not sure how robust it is, but as long and the encoding of the xmp data is in plain text, the code should work. The code below is also an example of how to use a PureBasic DLL in ms-access. Enjoy.

PS Why would I want to use a DLL to add functionality to ms-access when the code below can be easily rewritten in native VBA? The short answer is that the equivalent code in VBA does not work. VBA does not handle unicode very well so I cannot search for unicode strings. There are numerous other areas where doing something in PB is way easier than doing it in ms-access and creating DLLs may provide a means for extending ms-access. As my work is data centric, it makes sense for me to continue using ms-access and just adding occasional DLLs. Testing algorithms is often easier in PB as well even if I do create final code in VBA.

One little known issue. So far I have to hard code the file location of the DLL in the declare function statement. This is bad as it limits portability of the database. There is a potential solution copy the dll files in as text files and save the code as a string in a module, then write the whole lot out to recreate the DLL at runtime, if the DLL is not present. This would let me create a Lib directory under the directory with the ms-access project, write the files out when required and then hopefully get around the DLL path issue.

Code: Select all

;XMP GPS Coords Reader
; Code for a windows DLL that can read XMP GPS coordinates from a jpeg photo.  
;Written by Andrew Mitchell 2014- use at your own risk
;Public Domain
;Tested in ms-access 2010
;To call the DLL from ms-access, create a standard module and paste in the following code.
;===Start VBA===
; Option Compare Database
; Option Explicit
; 
; Public Declare Function GPSLongitude Lib "D:\Temp\2013\Access\xmpCoords.dll" (ByVal filename As String) As Double
; Public Declare Function GPSLatitude Lib "D:\Temp\2013\Access\xmpCoords.dll" (ByVal filename As String) As Double
; 
; Public Sub smp()
; 
;     Dim x As Double, y As String
;     x = GPSLongitude("D:\HelicopterLandingAerialViewClose.jpg")
;     y = GPSLatitude("D:\HelicopterLandingAerialViewClose.jpg")
;     Debug.Print y
;    Debug.Print x
;    
; End Sub 
;===End VBA===
; 
; The following code needs To be compiled To a DLL on the x86 compiler As ascii.


Global  GPSLatitude.d
Global GPSLongitude.d

#TESTDLL = 0

CompilerIf #TESTDLL = 0
    
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows
        
        ; These 4 procedures are Windows specific
        ;
        
        ; This procedure is called once, when the program loads the library
        ; for the first time. All init stuffs can be done here (but not DirectX init)
        ;
        ProcedureDLL AttachProcess(Instance)
        EndProcedure
        
        
        ; Called when the program release (free) the DLL
        ;
        ProcedureDLL DetachProcess(Instance)
        EndProcedure
        
        
        ; Both are called when a thread in a program call or release (free) the DLL
        ;
        ProcedureDLL AttachThread(Instance)
        EndProcedure
        
        ProcedureDLL DetachThread(Instance)
        EndProcedure
        
    CompilerEndIf
    
    
    ProcedureDLL.d GPSLongitude (FileName.s)  
        ;Declare variables
        x.s
        i.l
        dmx.s
        dmy.s
        t2start.l
        t1start.l
        tagLats.s = "<exif:GPSLatitude>"
        tagLate.s =  "</exif:GPSLatitude>"
        tagLongs.s = "<exif:GPSLongitude>"
        tagLonge.s="</exif:GPSLongitude>"
        eleLength.l 
        decimadegrees.d
        z.l ; position of divider
        degrees.d
        minutes.s
        hemisphere.s
        
        If ReadFile (0,FileName)
            While Eof(0) = 0         ; loop as long the 'end of file' isn't reached or till we have the information we need
                x=ReadString(0)      ; display line by line in the debug window  
                j.l = FindString(x,tagLongs,#PB_String_CaseSensitive)
                If j
                    t1start=j + Len(tagLongs)
                    t2start=FindString(x,tagLonge)
                    eleLength= t2start - t1start
                    If eleLength > 0 
                        dmy = Mid(x,t1start,eleLength)
                        hemisphere = Right(dmy, 1)
                        z=FindString(dmy,",")
                        degrees=ValD(Mid(dmy,1,z-1))
                        minutes = Mid(dmy,z+1)     ; c
                        minutes=Left(minutes,Len(minutes)-1)      ;strip trailing letter
                        decimadegrees=degrees+ValD(minutes)/60
                        If hemisphere = "W"
                            decimadegrees = decimadegrees *-1
                        EndIf
                        Break
                    Else
                        dmy = "No closing tag"
                    EndIf  
                EndIf
            Wend
        Else
            MessageRequester("Information","Couldn't open the file!"+FileName)
        EndIf
        CloseFile(0)               ; close the previously opened file
        ProcedureReturn decimadegrees
    EndProcedure
    
    ProcedureDLL.d GPSLatitude (FileName.s)  
        ;Declare variables
        x.s ;
        j.l ;
        dmx.s
        t2start.l
        t1start.l
        tagLats.s = "<exif:GPSLatitude>"
        tagLate.s =  "</exif:GPSLatitude>"
        eleLength.l 
        decimadegrees.d
        z.l ; position of divider
        degrees.d
        minutes.s
        hemisphere.s
        
        If ReadFile (0,FileName)
            While Eof(0) = 0         ; loop as long the 'end of file' isn't reached or till we have the information we need
                x=ReadString(0)      ; display line by line in the debug window  
                j = FindString(x,tagLats,#PB_String_CaseSensitive)
                If j
                    t1start=j +Len(tagLats)
                    t2start=FindString(x,tagLate)
                    eleLength= t2start - t1start
                    If eleLength > 0 
                        dmx = Mid(x,t1start,eleLength)
                        hemisphere =  Right(dmx,1)   
                        MessageRequester("S",hemisphere)
                        z=FindString(dmx,",")
                        degrees=ValD(Mid(dmx,1,z-1))
                        minutes = Mid(dmx,z+1)     ; c
                        minutes=Left(minutes,Len(minutes)-1)      ;strip trailing letter
                        decimadegrees=degrees+ValD(minutes)/60
                        If hemisphere = "S" 
                            decimadegrees = decimadegrees *-1
                        EndIf
                        Break
                    Else
                        dmx= "No closing tag"
                    EndIf  
                EndIf
            Wend
        Else
            MessageRequester("Information","Couldn't open the file!"+FileName)
        EndIf
        CloseFile(0)               ; close the previously opened file
        ProcedureReturn decimadegrees
    EndProcedure
    
CompilerEndIf

[CONVERT]

Very interesting. Thanks.