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
EndProcedure
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
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!")
EndIf
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