'-- returns formatted string data from an IFD entry ---
Private Sub GetStringData(sJPEG_Header As String, IFD As tIDF, OffsetStart As Long, CurrPosition As Long)
Dim vData As String, x As Variant, sFmt As String
Dim PixOrder, i As Integer
'extract the data
If IFD.Length * DataLen(IFD.Format) > 4 Then 'IFD data contains offset to real data
vData = Mid(sJPEG_Header, OffsetStart + IFD.Data, IFD.Length * DataLen(IFD.Format))
Else 'IFD record contains the data itself
vData = Mid(sJPEG_Header, CurrPosition + 8, 4)
End If
'check the data format and do some conversions if necessary
Select Case IFD.Format
Case enFormat.asciiString 'string
IFD.StringData = vData
Case enFormat.unsignedRationale 'unsigned rational
Select Case IFD.ID
Case enTAG.ApertureValue, enTAG.MaxApertureValue
'convert to aperture ratio value
x = UnsignedRational(vData, IFD.Data)
IFD.StringData = Format(Sqr(2) ^ IFD.Data, "0.0")
Case enTAG.FNumber
x = UnsignedRational(vData, IFD.Data)
IFD.StringData = Format(IFD.Data, "0.0")
Case enTAG.FocalPlaneXResolution, enTAG.FocalPlaneYResolution, enTAG.XResolution, enTAG.YResolution, enTAG.FocalLength, enTAG.SubjectDistance
x = UnsignedRational(vData, IFD.Data)
IFD.StringData = Format(IFD.Data, "0.0")
Case enTAG.Exposuretime
x = UnsignedRational(vData, IFD.Data)
IFD.StringData = Format(1 / IFD.Data, "0")
Case Else
If IFD.Length < 2 Then
IFD.StringData = UnsignedRational(vData, IFD.Data)
Else
For i = 1 To IFD.Length
Call UnsignedRational(Mid(vData, (i - 1) * 8 + 1, 4), x)
IFD.StringData = "/" + IFD.StringData + Format(x, "0.000")
Next
IFD.StringData = Mid(IFD.StringData, 2)
End If
End Select
Case enFormat.signedRationale 'signed rational
Select Case IFD.ID
Case enTAG.ShutterSpeedValue
'convert to shutter speed value
x = SignedRational(vData, IFD.Data)
IFD.StringData = Format(2 ^ IFD.Data, "0")
Case enTAG.ExposureBiasValue
x = SignedRational(vData, IFD.Data)
IFD.StringData = Format(IFD.Data, "0.0")
Case Else
If IFD.Length < 2 Then
IFD.StringData = SignedRational(vData, IFD.Data)
Else
For i = 1 To IFD.Length
Call SignedRational(Mid(vData, (i - 1) * 8 + 1, 4), x)
IFD.StringData = "/" + IFD.StringData + Format(x, "0.000")
Next
IFD.StringData = Mid(IFD.StringData, 2)
End If
End Select
Case enFormat.undefined 'undefined
Select Case IFD.ID
Case enTAG.MakerNote
IFD.StringData = ExtractTextOnly(vData)
Case enTAG.ComponentsConfiguration
PixOrder = Array("", "Y", "Cb", "Cr", "R", "G", "B")
For i = 1 To 4
IFD.StringData = IFD.StringData + PixOrder(Asc(Mid(vData, i, 1)))
Next i
Case enTAG.FileSource, enTAG.SceneType
IFD.StringData = CStr(BVal(vData, 1, DataLen(IFD.Format), m_Intel))
Case enTAG.ExifVersion, enTAG.FlashPixVersion
IFD.StringData = CStr(Val(Left(vData, 2))) + "." + Right(vData, 2)
Case Else
IFD.StringData = vData
End Select
Case enFormat.signedByte, enFormat.signedLong, enFormat.signedShort 'signed byte, short & long
IFD.StringData = CStr(BValS(vData, 1, DataLen(IFD.Format), m_Intel))
Case Else 'all other data types
IFD.StringData = CStr(BVal(vData, 1, DataLen(IFD.Format), m_Intel))
End Select
IFD.StringData = Replace(IFD.StringData, Chr(0), "") 'remove null characters
'try to read description of data from the ini file
vData = GetProfileString(m_IniFile, IFD.Name, IFD.StringData)
sFmt = GetProfileString(m_IniFile, IFD.Name, "Format")
'if description is found, use it instead of raw data
If vData <> "" Then IFD.StringData = vData
If sFmt <> "" Then IFD.StringData = Replace(sFmt, "@X", IFD.StringData)
End Sub
'--- Parses a single EXIF directory record (IFD), returns an offset to the next IFD ---
Private Function ParseIDF(sJPEG_Header As String, HeaderStart As Long, Offset As Long, ClosingTag As enTAG) As Long
Dim lPos As Long, NoOfRecs As Long, i As Integer, u
lPos = HeaderStart + Offset 'get the starting offset position
NoOfRecs = BVal(sJPEG_Header, lPos, 2, m_Intel) 'get the No of records in the IFD
u = UBound(IFD)
ReDim Preserve IFD(u + NoOfRecs) 'redimension the IFD array
lPos = lPos + 2
'begin retrieving the tags
For i = u + 1 To u + NoOfRecs
IFD(i).ID = BVal(sJPEG_Header, lPos, 2, m_Intel) 'first 2 bytes contain the tag ID
IFD(i).Format = BVal(sJPEG_Header, lPos + 2, 2, m_Intel) 'next 2 bytes contain the tag data format
IFD(i).Length = BVal(sJPEG_Header, lPos + 4, 4, m_Intel) 'next 4 bytes contain the No of data components
IFD(i).Data = BVal(sJPEG_Header, lPos + 8, 4, m_Intel) 'next 4 bytes contain the data or an offset to the data
IFD(i).Name = GetTagName(IFD(i).ID) 'retrieve the tag name in human readable format
Call GetStringData(sJPEG_Header, IFD(i), HeaderStart, lPos) 'retrieve the data as a string
lPos = lPos + 12 'get the offset to the next tag
If IFD(i).ID = ClosingTag Then
ParseIDF = Val(IFD(i).StringData) 'return offset to the next sub IFD
End If
Next
End Function
'======== byte hadling functions ==========
'--- returns calculated unsigned value of a byte sequence ---
Private Function BVal(sData As String, start As Long, ByVal Length As Integer, m_Intel As Boolean) As Variant
Dim i As Long, st As Long, en As Long, step As Integer, n As Long
If Not m_Intel Then 'Motorola byte alignment
st = start + Length - 1
en = start
step = -1
Else 'Intel byte alignment
st = start
en = start + Length - 1
step = 1
End If
For i = st To en Step step
BVal = BVal + Asc(Mid(sData, i, 1)) * 256 ^ n
n = n + 1
Next
End Function
'--- returns calculated signed value of a byte sequence ---
Private Function BValS(sData As String, start As Long, ByVal Length As Integer, m_Intel As Boolean) As Variant
Dim dn As Variant
dn = 2 ^ (8 * Length - 1)
BValS = BVal(sData, start, Length, m_Intel)
If BValS > (dn - 1) Then BValS = Not (BValS - dn)
End Function
'--- returns a string containing an unsigned rational value in the format Numerator/Denumerator;
'- also calculates its numeric value
Private Function UnsignedRational(ByVal vData As String, ByRef NumValue As Variant) As String
Dim Num As Double, Denum As Double, Rational As Double
Num = BVal(vData, 1, 4, m_Intel)
Denum = BVal(vData, 5, 4, m_Intel)
If Denum <> 0 Then NumValue = Num / Denum
UnsignedRational = CStr(Num) + "/" + CStr(Denum)
End Function
'--- returns a string containing a signed rational value in the format Numerator/Denumerator;
'- also calculates its numeric value
Private Function SignedRational(ByVal vData As String, ByRef NumValue As Variant) As String
Dim Num As Double, Denum As Double, Rational As Double
Num = BValS(vData, 1, 4, m_Intel)
Denum = BValS(vData, 5, 4, m_Intel)
If Denum <> 0 Then NumValue = Num / Denum
SignedRational = CStr(Num) + "/" + CStr(Denum)
End Function
'--- Reads and returns a string from a file on the disk ---
Private Function ReadFile(ByVal sFilePath As String, Optional iLen = 0) As String
Dim F As Long
Dim S As String
On Error Resume Next
If FileLen(sFilePath) < 1 Then
ReadFile = ""
Else
F = FreeFile
Open sFilePath For Binary Access Read As #F
If iLen = 0 Then S = Space$(LOF(F)) Else S = Space$(iLen)
Get #F, , S
Close #F
ReadFile = S
S = ""
End If
End Function
'--- Reads a value from an .INI file ---
Private Function GetProfileString(ByVal sFile As String, ByVal sSection As String, ByVal sKey As String, Optional ByVal DefaultValue = "") As String
Dim sTmp As String, x As Long
Const StringSize = 1024
sTmp = Space$(StringSize)
x = GetPrivateProfileString(sSection, sKey, "", sTmp, StringSize, sFile)
sTmp = Trim$(sTmp)
sTmp = Left(sTmp, Len(sTmp) - 1)
If sTmp = "" Then sTmp = DefaultValue
GetProfileString = sTmp
End Function
'--- Returns only the ascii characters from a byte sequence ---
Private Function ExtractTextOnly(S As String) As String
Dim i As Integer, l As Integer, c As String * 1
l = Len(S)
For i = 1 To l
c = Mid(S, i, 1)
If Asc(c) > 31 And Asc(c) < 128 Then ExtractTextOnly = ExtractTextOnly + c
Next i
End Function
