Posted: Tue May 15, 2007 2:44 am
				
				Ahhhh....the good old days when I had time to code.  
 
You're welcome GeoTrail. Glad to see the oldies are still useful
			You're welcome GeoTrail. Glad to see the oldies are still useful
http://www.purebasic.com
https://www.purebasic.fr/english/
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
EndProcedureCode: 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
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")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!")
EndIfCode: 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