VBA и параметры графических файлов

[dizzy]

Задал вопрос на форуме по скриптингу для Инди. Однако народ не спешит отвечать и раз он не привязан к прогам, прошу совета здесь:

Можно ли как-нить не открывая графический файл (тиф) узнать о его параметрах (ширина и высота)?

Описание формата получил, смотрел. Вроде все прописано, к примеру с шириной так:
ImageWidth
Tag = 256 (100h)
Type = SHORT or LONG
Length = 1
Однако каким образом считать - так и не понял. В инструкции по VBA грят про три типа файлов: последовательный, произвольный и бинарный. Логика подсказывает что тиф относится к третьему типу. Открываем через Open "" For Binary (или Random?) As 1... Считываем получается через Get #1, n, myWidth... Однако n у нас по справке либо 3 либо 4 байта (Type = SHORT or LONG). И уж совсем не понятно как прописать что надо именно ImageWidth, а не что-то другое. Через Seek #1, k ? Возможно, но что тогда надо писать вместо k (256, 100h и "100h" - не канают)?

Конечно для кого-то я выгляжу глупо, но если есть желание че-нить прояснить в моей голове, то буду признателен.

 

[wOxxOm]

Ответ: VBA и параметры графических файлов

Никогда не пользуюсь командами открывания файлов в бейсике, поэтому могу помочь только так:

разбирайся - это в моем recentFiles используется для выдирания Exif превьюшек из TIF и PSD. Писал сам поэтому стиль такой (мне нравится). Все информация по тегам tif и psd в интернете через google на неофициальных сайтах. Два дня разбирался. Мне было не сложно.

Размер tif - лежит в IFD, очень просто получить, если посмотришь как у меня парсится IFD. В полном тексте макроса есть также выдиралка Exif для JPG, посмотри еще там

на входе эта функция берет handle открытого файла, хандл создается так:

hFile = CreateFile(file, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
      0, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, 0)

определения api функций см. в моем макросе ссылка или в winapi help

Function tiffThumb(ByVal hFile&) As String
   Dim buf() As Byte, nR&, i&
   tiffThumb = ""
   SetFilePointer hFile, 0, 0, 0
' now try to find photoshop private TAG 0x8649 in first IFD
   ReDim buf(0 To 9)
   If Not ReadFileSafe(hFile, buf(0), 10) Then Exit Function
   If Not CompareString(&H400, 0, buf(0), 2, "II", 2) = 2 Or _
        CompareString(&H400, 0, buf(0), 2, "MM", 2) = 2 Then GoTo BruteForce
   intel = (CompareString(&H400, 0, buf(0), 2, "II", 2) = 2)
   i = byte2long(buf, 4, intel) ' IFD0 offset
   If i < 8 Then Exit Function
   If i > 8 Then
      SetFilePointer hFile, i, 0, 0
      If Not ReadFileSafe(hFile, buf(8), 2) Then Exit Function
   End If
   tagsCnt = byte2word(buf, 8, intel) ' IFD0 tags number
   If tagsCnt > 1000 Or tagsCnt = 0 Then Exit Function
   bufSize = tagsCnt * 12: ReDim buf(0 To bufSize - 1)
   If Not ReadFileSafe(hFile, buf(0), bufSize) Then Exit Function
   pOffs& = 0
   For i = 0 To tagsCnt - 1
      If byte2word(buf, i * 12, intel) = &H8649& Then _
         pOffs = byte2long(buf, 8 + i * 12, intel): _
         pSize = byte2long(buf, 4 + i * 12, intel): _
         Exit For
      Next
   
   SetFilePointer hFile, pOffs, 0, 0 ' zero pOffs is also accepted
' now scan for JPEG signature brute-force
BruteForce:
   ReDim buf(0 To 65000)
   'SetFilePointer hFile, 0, 0, 0
   If Not ReadFileSafe(hFile, buf(0), 65000) Then Exit Function
   foundJPEG = False: i = -1
   Do
      i = i + 1: If i > 63000 Then Exit Do
      If buf(i) = &HFF Then _
         If buf(i + 1) = &HD8 Then _
            If buf(i + 2) = &HFF Then _
               If buf(i + 3) = &HE0 Or buf(i + 3) = &HE1 Then foundJPEG = True: Exit Do
      Loop
   If Not foundJPEG Then Exit Function
   
   j = i + byte2word(buf, 14) * byte2word(buf, 16)
   If j > 64000 Then Exit Function
   foundJPEG = False
   Do
      j = j + 1: If j > 64000 Then Exit Do
      If buf(j) = &HFF Then _
         If buf(j + 1) = &HD9 Then foundJPEG = True: Exit Do
      Loop
   If Not foundJPEG Then Exit Function
   
   tmp = Environ("temp"): If tmp = "" Then tmp = Environ("windir")
   tmp = addPathSlash(tmp) + "recent.jpg"
   hThumb = CreateFile(tmp, GENERIC_WRITE, 0, 0, CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY, 0)
   If hThumb = -1 Then Exit Function
   
   e = WriteFile(hThumb, buf(i), j - 1 + 1, nR, 0): CloseHandle hThumb
   If e = 0 Or nR <> j - 1 + 1 Then Exit Function
   tiffThumb = tmp
   End Function

Private Function byte2word(buf() As Byte, ByVal idx&, Optional ByVal intel As Boolean = False) As Long
   If intel Then byte2word = buf(idx) + CLng(buf(idx + 1)) * 256 _
            Else byte2word = CLng(buf(idx)) * 256 + buf(idx + 1)
   End Function
Private Function byte2long(buf() As Byte, ByVal idx&, Optional ByVal intel As Boolean = False) As Long
   Dim L&: If intel Then RtlMoveMemory L, buf(idx), 4: byte2long = L: Exit Function
   byte2long = CLng(buf(idx)) * 16777216 + CLng(buf(idx + 1)) * 65536 + CLng(buf(idx + 2)) * 256& + buf(idx + 3)
   End Function

Private Function ReadFileSafe(ByVal hFile&, ByRef buf As Byte, ByVal size&) As Boolean
   Dim nR&: ReadFileSafe = False
   If ReadFile(hFile, buf, size, nR, 0) = 0 Then Exit Function
   ReadFileSafe = (nR = size)
   End Function