Read and Write a Hexdecimal .tiff File Using VBA

[rickyfong]

I would like to read a TIFfle to ACCESS, and store its content as hexdecimal like below to further other process..., how can I achieve this change and storage?? Thanks a lot!!


0000: 49 49 2A 00 4E 00 00 00 80 3F E0 50 38 24 16 0D
0010: 07 84 42 61 50 B8 64 36 1D 0F 88 44 62 51 38 A4
0020: 56 2D 17 8C 46 63 51 B8 E4 76 3D 1F 90 48 64 52
0030: 39 24 96 4D 18 80 80 00 60 00 00 00 01 00 00 00
0040: 60 00 00 00 01 00 00 00 08 00 08 00 08 00 0F 00
0050: FE 00 04 00 01 00 00 00 00 00 00 00 00 01 03 00
0060: 01 00 00 00 11 00 00 00 01 01 03 00 01 00 00 00
0070: 0F 00 00 00 02 01 03 00 03 00 00 00 48 00 00 00
0080: 03 01 03 00 01 00 00 00 05 00 00 00 06 01 03 00

[rickyfong]

After a few days investigation, I got some ideas but lacking of concept and technique to find out the resoluation value inside the TIFF file structure.

In the previously VBA code, it could read out the TIFF pixal width (tagID 257) and pixal height (tagID 258) but not the file real width and height. The key conversion factor is the resoluation value which is stored in the tagID 282 accoding to some reading. In fact, for reading tagID 257 and 258 is simple, as their data type are all long whereas the tagID 282 is rational.

According to TIFF file structure, rational data type consists of 2 sets of 4 HEX data location as the numerator (http://en.wikipedia.org/wiki/Numerator) and denominator (http://en.wikipedia.org/wiki/Denominator), and the record of tagID 282 only store the starting position of the first HEX positions instead of storing the values as 257 and 258.

TIF structure mentioned that 4 HEX data comprised of one numerator such as 04 05 1A 1C, however, it seems the follwing VBA read a pair and changed it to decimal data type, cause for TAGID as 257 or 258, VBA Get#1 once, and can read out a pair of HEX data locaton, and display as a decimal data type such as 9235 for TAGID257 and 4380 for TAGID 258....

FOR instance:
TagID = 011A
VAlueoffset = 38 (HEX value for first storage location)

In 38 location, the HEX values are 60 00 00 00 as one numerator, the docment mentioned that the whole 60000000 = 96 in decimal type, which is the result that I would want.....


My problem is I can read out the data, but I don't know whether is HEXdecimal, decimal or binary values. And I also checked that no values come closed to the resoluation value that is given.


Sub mmm()
Dim strFile As String '文件名
Dim strFileType As String 'TIF标记
Dim iffsetIFD As Long '第一个IFD的偏移量
Dim iCountDE As Integer 'DE的数量
Dim lWidth As Long '图像宽度
Dim lHeight As Long '图像高度
Dim TTID As Integer
Dim T1 As Long
Dim T99 As String
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
Dim temp3 As Long
Dim temp4 As Integer
Dim TEMP5 As Long
Dim TEMP6 As Long
Dim g1 As Integer
Dim G2 As Integer
Dim g3 As Integer
Dim g4 As Integer
Dim g5 As Integer
Dim g6 As Integer
Dim g7 As Integer
Dim g8 As Integer
Dim g9 As Integer
strFile = "C:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType '获取TIF标记
If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1 '版本号废弃
Get #1, , iffsetIFD '获取第一个IFD的偏移量
Seek #1, iffsetIFD + 1 '设置下一个读出位置为第一个IFD的偏移量
Get #1, , iCountDE '获取第一个IFD中DE的数量
MsgBox iffsetIFD
'For i = 1 To iCountDE
For i = 1 To 21
Get #1, , TTID '获取属性的标签编号
If TTID = 256 Then '如果是图像宽
Get #1, , Temp1 '废弃
Get #1, , Temp2 '废弃
Get #1, , temp3 '废弃
'
'Get #1, , lWidth
k = k + 1
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
ElseIf TTID = 257 Then '如果是图像高
Get #1, , Temp1 '废弃
Get #1, , Temp2 '废弃
Get #1, , temp3 '废弃
'Get #1, , lHeight
k = k + 1
'c
ElseIf TTID = 282 Then '如果是图像高
Get #1, , Temp1 '废弃
Get #1, , Temp2 '废弃
Get #1, , temp4
MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp4
Seek #1, temp4
T1 = temp4
Get #1, , g1 '废弃
Get #1, , G2 '废弃
Get #1, , g3 '废弃
Get #1, , g4 '废弃
Get #1, , g5 '废弃
Get #1, , g6 '废弃
Get #1, , g7 '废弃
Get #1, , g8 '废弃
'MsgBox TTID & " " & Hex(T1) & "= " & Hex(g1) & " " & Hex(G2) & " " & Hex(g3) & " " & Hex(g4) & " " & Hex(g5) & " " & Hex(g6) & " " & Hex(g7) & " " & Hex(g8)
MsgBox TTID & " " & T1 & "= " & g1 & " " & G2 & " " & g3 & " " & g4 & " " & g5 & " " & g6 & " " & g7 & " " & g8
Else '否则这些数据废弃
Get #1, , Temp1
Get #1, , Temp2
Get #1, , temp3
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
End If
'If k = 2 Then Exit For
Next i
Close #1
MsgBox "width：" & lWidth & vbCrLf & "height：" & lHeight & TID & T99

End Sub

[SamT]

Ricky,

I combined your two threads about Hexadecimal .tiff files into this thread because they both deal with the same subject matter.

Much of the help you may get will be from people from all over the world. Since western European and USA fonts are the de-facto standard, can you repost your code using one of these more common fonts for the code comments? I think it will make it easier for us to help you. All the actual code presents itself correctly on my poor Browser, but the comments are not readable to me.

[rickyfong]

HERE comes the code with command in English! Thanks a lot!!

Please find also a TIFF file structure for your reference!!

http://cool.conservation-us.org/bytopic/imaging/std/tiff5.html (http://cool.conservation-us.org/bytopic/imaging/std/tiff5.html)


Sub mmm()
Dim strFile As String ' filename
Dim strFileType As String 'TIF mark
Dim iffsetIFD As Long ' first IFD location (IFD = Index file directory)
Dim iCountDE As Integer ' total number of DE (Directory entry)
Dim lWidth As Long 'width
Dim lHeight As Long 'heigth
Dim TTID As Integer
Dim T1 As Long
Dim T99 As String
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
Dim temp3 As Long
Dim temp4 As Integer
Dim TEMP5 As Long
Dim TEMP6 As Long
Dim g1 As Integer
Dim G2 As Integer
Dim g3 As Integer
Dim g4 As Integer
Dim g5 As Integer
Dim g6 As Integer
Dim g7 As Integer
Dim g8 As Integer
Dim g9 As Integer
strFile = "C:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType ' get TIF mark
If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1 ' get TIF version
Get #1, , iffsetIFD ' get first IFD location
Seek #1, iffsetIFD + 1 'find next IDF location
Get #1, , iCountDE get the total number of DE
MsgBox iffsetIFD
For i = 1 To iCountDE
Get #1, , TTID 'Get DE
If TTID = 256 Then ' if width
Get #1, , Temp1 'no used
Get #1, , Temp2 'no used
Get #1, , lWidth
k = k + 1
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
ElseIf TTID = 257 Then ' if heigth
Get #1, , Temp1 ' no used
Get #1, , Temp2 ' no used
Get #1, , lHeight
k = k + 1

ElseIf TTID = 282 Then ' if is Xresolution
Get #1, , Temp1 'no used
Get #1, , Temp2 'no used
Get #1, , temp4 ' read the rational first location
MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp4
Seek #1, temp4
T1 = temp4
Get #1, , g1 '
Get #1, , G2 '
Get #1, , g3 '
Get #1, , g4 '
Get #1, , g5 '
Get #1, , g6 '
Get #1, , g7 '
Get #1, , g8 '
MsgBox TTID & " " & T1 & "= " & g1 & " " & G2 & " " & g3 & " " & g4 & " " & g5 & " " & g6 & " " & g7 & " " & g8
Else ' else no used
Get #1, , Temp1
Get #1, , Temp2
Get #1, , temp3
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
End If
'If k = 2 Then Exit For
Next i
Close #1
MsgBox "Width：" & lWidth & vbCrLf & "Heigth：" & lHeight

End Sub

[arronlee]

Hi, rickyfong.
Using code to deal with the related Tiff reading programs is to complicated forme. I wonder whether there are some professnal manual tools can help with it? I am testing about the related projects these days. Do you have any ideas about it? Or any good suggestion? Thanks in advance.



Best regards,
Arron

[tsuru]

Hi, rickyfong.




Sub mmm()
Dim strFile As String ' filename
Dim strFileType As String 'TIF mark
Dim iffsetIFD As Long ' first IFD location (IFD = Index file directory)
Dim iCountDE As Integer ' total number of DE (Directory entry)
Dim lWidth As Long 'width
Dim lHeight As Long 'heigth
Dim TTID As Integer
Dim T1 As Long
Dim T99 As String
Dim Temp1 As Integer, Temp2 As Long, i As Integer, k As Integer
Dim temp3 As Long
Dim temp4 As Integer
Dim TEMP5 As Long
Dim TEMP6 As Long
Dim g1 As Byte
Dim g2 As Byte
Dim g3 As Byte
Dim g4 As Byte
Dim g5 As Byte
Dim g6 As Byte
Dim g7 As Byte
Dim g8 As Byte
Dim g9 As Byte
strFile = "C:\1.05-1.25.tif"
Open strFile For Binary As #1
strFileType = String(2, 0)
Get #1, , strFileType ' get TIF mark
If strFileType <> "II" And strFileType <> "MM" Then Close #1: Exit Sub
Get #1, , Temp1 ' get TIF version
Get #1, , iffsetIFD ' get first IFD location
Seek #1, iffsetIFD + 1 'find next IDF location
Get #1, , iCountDE get the total number of DE
MsgBox iffsetIFD
For i = 1 To iCountDE
Get #1, , TTID 'Get DE
If TTID = 256 Then ' if width
Get #1, , Temp1 'no used
Get #1, , Temp2 'no used
Get #1, , lWidth
k = k + 1
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
ElseIf TTID = 257 Then ' if heigth
Get #1, , Temp1 ' no used
Get #1, , Temp2 ' no used
Get #1, , lHeight
k = k + 1

ElseIf TTID = 282 Then ' if is Xresolution
Get #1, , Temp1 'no used
Get #1, , Temp2 'no used
Get #1, , temp4 ' read the rational first location
MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp4
Seek #1, temp4 + 1
T1 = temp4
Get #1, , g1 '
Get #1, , g2 '
Get #1, , g3 '
Get #1, , g4 '
Get #1, , g5 '
Get #1, , g6 '
Get #1, , g7 '
Get #1, , g8 '
MsgBox TTID & " " & T1 & "= " & g1 & " " & g2 & " " & g3 & " " & g4 & " " & g5 & " " & g6 & " " & g7 & " " & g8
MsgBox "Xresolution: " & _
CLng("&H" & Right("0" & Hex(g4), 2) & Right("0" & Hex(g3), 2) & Right("0" & Hex(g2), 2) & Right("0" & Hex(g1), 2)) / CLng("&H" & Right("0" & Hex(g8), 2) & Right("0" & Hex(g7), 2) & Right("0" & Hex(g6), 2) & Right("0" & Hex(g5), 2)) & _
"dpi"
Else ' else no used
Get #1, , Temp1
Get #1, , Temp2
Get #1, , temp3
'MsgBox i & " " & TTID & " " & Temp1 & " " & Temp2 & " " & temp3
End If
'If k = 2 Then Exit For
Next i
Close #1
MsgBox "Width：" & lWidth & vbCrLf & "Heigth：" & lHeight

End Sub