練習帳@blog

これからは写真中心で行きたい

Exif.cls

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Exif"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private ExifData() As Byte
Private IFDcount As Integer 'IFDデータの個数
Private GPScount As Integer 'GPSデータの個数
Private SubIFDcount As Integer 'SubIFDデータの個数
Private IFDdata() As New IFD 'IFDデータ用　IFDオブジェクト
Private GPSdata() As New IFD 'GPSデータ用　IFDオブジェクト
Private SubIFDdata() As New IFD 'SubIFDデータ用　IFDオブジェクト
Private tagName As Object



Public IFDtagData As Object
Public GPStagData As Object
Public SubIFDtagData As Object


Public Function OpenExif(filename As String) As Boolean
Dim ExifHedder() As Byte
Dim APP1Size As Long
Dim ExifMark As String
Dim IFDstart As Long
Dim SubIFDstart As Long
Dim GPSstart As Long
Dim III As Integer
Dim IFDtagData2 As Object
Dim temp
Dim Byte2Str As New ByteExchange
Dim Byte2StrNE As New ByteExchange
Dim IFDnum As Long
Byte2StrNE.endian = "MM"
Dim TagA As Variant
Dim tagNameA As Variant
Dim i As Integer

TagA = Array("&H010E", "&H010F", "&H0110", "&H011A", "&H011B", "&H0128", "&H0131", "&H0132", "&H013E", "&H013F", "&H0211", _
"&H0213", "&H0214", "&H8298", "&H8769", "SUB_&H829A", "SUB_&H829D", "SUB_&H8822", "SUB_&H8827", "SUB_&H9000", _
"SUB_&H9003", "SUB_&H9004", "SUB_&H9101", "SUB_&H9102", "SUB_&H9201", "SUB_&H9202", "SUB_&H9203", "SUB_&H9204", _
"SUB_&H9205", "SUB_&H9206", "SUB_&H9207", "SUB_&H9208", "SUB_&H9209", "SUB_&H920A", "SUB_&H927C", "SUB_&H9286", _
"SUB_&H9290", "SUB_&H9291", "SUB_&H9292", "SUB_&HA000", "SUB_&HA001", "SUB_&HA002", "SUB_&HA003", "SUB_&HA004", _
"SUB_&HA005", "SUB_&HA20E", "SUB_&HA20F", "SUB_&HA210", "SUB_&HA215", "SUB_&HA217", "SUB_&HA300", "SUB_&HA301", _
"SUB_&HA302", "GPS_&H0000", "GPS_&H0001", "GPS_&H0002", "GPS_&H0003", "GPS_&H0004", "GPS_&H0005", "GPS_&H0006", _
"GPS_&H0007", "GPS_&H0008", "GPS_&H0009", "GPS_&H000A", "GPS_&H000B", "GPS_&H000C", "GPS_&H000D", "GPS_&H000E", _
"GPS_&H000F", "GPS_&H0010", "GPS_&H0011", "GPS_&H0012", "GPS_&H0013", "GPS_&H0014", "GPS_&H0015", "GPS_&H0016", _
"GPS_&H0017", "GPS_&H0018", "GPS_&H0019", "GPS_&H001A")


tagNameA = Array("ImageDescription", "Make", "Model", "XResolution", "YResolution", "ResolutionUnit", "Software", "DateTime", _
"WhitePoint", "PrimaryChromaticities", "YCbCrCoefficients", "YCbCrPositioning", "ReferenceBlackWhite", "Copyright", _
"ExifIFDPointer", "ExposureTime", "FNumber", "ExposureProgram", "ISOSpeedRatings", "ExifVersion", "DateTimeOriginal", _
"DateTimeDigitized", "ComponentsConfiguration", "CompressedBitsPerPixel", "ShutterSpeedValue", "ApertureValue", _
"BrightnessValue", "ExposureBiasValue", "MaxApertureValue", "SubjectDistance", "MeteringMode", "LightSource", "Flash", _
"FocalLength", "MakerNote", "UserComment", "SubsecTime", "SubsecTimeOriginal", "SubsecTimeDigitized", "FlashPixVersion", _
"ColorSpace", "ExifImageWidth", "ExifImageHeight", "RelatedSoundFile", "InteroperabilityIFDPointer", "FocalPlaneXResolution", _
"FocalPlaneYResolution", "FocalPlaneResolutionUnit", "ExposureIndex", "SensingMethod", "FileSource", "SceneType", "CFAPattern", _
"GPSVersionID", "GPSLatitudeRef", "GPSLatitude", "GPSLongitudeRef", "GPSLongitude", "GPSAltitudeRef", "GPSAltitude", "GPSTimeStamp", _
"GPSSatellites", "GPSStatus", "GPSMeasureMode", "GPSDOP", "GPSSpeedRef", "GPSSpeed", "GPSTrackRef", "GPSTrack", "GPSImgDirectionRef", _
"GPSImgDirection", "GPSMapDatum", "GPSDestLatitudeRef", "GPSDestLatitude", "GPSDestLongitudeRef", "GPSDestLongitude", _
"GPSDestBearingRef", "GPSDestBearing", "GPSDestDistanceRef", "GPSDestDistance")

Set tagName = CreateObject("Scripting.Dictionary")

If tagName.Count = 0 Then
For i = 0 To UBound(TagA)
tagName.Add tagNameA(i), TagA(i)
Next
End If
Set IFDtagData = CreateObject("Scripting.Dictionary")
Set GPStagData = CreateObject("Scripting.Dictionary")
Set SubIFDtagData = CreateObject("Scripting.Dictionary")
IFDtagData.RemoveAll
GPStagData.RemoveAll
SubIFDtagData.RemoveAll
Open filename For Binary As #1
'SOI: 2byte "FFD8"
'APP1 Marker 2byte "FFE1"
'APP1 Size 2byte
'Exif Mark 6byte "45786966 0000"="Exif"+"&H0000"
ExifHedder = InputB(12, #1)
'SOI="&H" & HEX(ExifHedder(0)) & HEX(ExifHedder(1))
'APP1Marker="&H" & HEX(ExifHedder(2)) & HEX(ExifHedder(3))


APP1Size = CLng(Byte2StrNE.endianHex(ExifHedder, 4, 2)) ' APP1データのサイズ。このサイズ分、現在の位置から読み込む(サイズデータ部分を含む)
ExifMark = Chr(ExifHedder(6)) & Chr(ExifHedder(7)) & Chr(ExifHedder(8)) & Chr(ExifHedder(9))
If ExifMark <> "Exif" Then
OpenExif = False
Close #1
Exit Function
Else
OpenExif = True
End If
APP1Size = APP1Size + 4 - 12 'APP1サイズには、先頭の8バイト(JPEGマーカー(SOI)とAPP1マーカーは含まれない。また、はじめのInput#分により次のInput#は12バイト分ずれている)
ExifData = InputB(APP1Size, #1) 'これによりExifDataは、Tiffヘッダの先頭からAPP1データ範囲のすべてを取り込むこととなる。

'エンディアン変換用オブジェクトにendianプロパティを設定
Byte2Str.endian = Chr(ExifData(0)) & Chr(ExifData(1))
'IFD領域の開始点をセット(オフセット値。Tiffヘッダ領域の先頭4バイト)
IFDstart = CLng(Byte2Str.endianHex(ExifData, 4, 4))
'IFDデータの個数をセット(Tiffヘッダ領域の先頭5-6バイト)
IFDcount = CLng(Byte2Str.endianHex(ExifData, IFDstart, 2))
'IFDデータオブジェクトを配列に登録
ReDim IFDdata(IFDcount) 'IFDデータオブジェクトの配列を個数に合わせて再定義
For III = 1 To IFDcount
IFDdata(III).endian = Byte2Str.endian 'IFDデータオブジェクトにエンディアンを設定。このデータは無駄。再考の必要あり
IFDdata(III).readIFD ExifData, IFDstart + 2 + (III - 1) * 12 'IFDデータオブジェクトの配列にデータをセット
IFDtagData.Add IFDdata(III).TagI, III 'IFDのタグ番号とオブジェクトの配列との対比をDictonaryオブジェクトに記録
Next
'&H8769 SubIFD unsigned long SubIFDデータを再度読み直し
If IFDtagData.Exists("&H8769") Then
SubIFDstart = CLng(IFDdata(IFDtagData("&H8769")).DataOffset) 'SubIFDタグインフォからSubIFDデータのオフセットを呼び出す
'SubIFDデータはエンディアンデータの入っている場所(&H0C)から上記オフセット分後ろに入っている
'ただし、この関数におけるExifDataは、先頭が上記エンディアンデータとなっているため、&H0Cについては考慮する必要なし。
SubIFDcount = CLng(Byte2Str.endianHex(ExifData, SubIFDstart, 2))
ReDim SubIFDdata(SubIFDcount)
For III = 1 To SubIFDcount
SubIFDdata(III).endian = Byte2Str.endian
SubIFDdata(III).readIFD ExifData, SubIFDstart + 2 + (III - 1) * 12
SubIFDtagData.Add SubIFDdata(III).TagI, III
Next
End If

'0x8825 GPSInfo unsigned long GPSデータを再度読み直し
If IFDtagData.Exists("&H8825") Then
GPSstart = CLng(IFDdata(IFDtagData("&H8825")).Data) 'GPSタグインフォからGPSデータのオフセットを呼び出す
'GPSデータはエンディアンデータの入っている場所(&H0C)から上記オフセット分後ろに入っている
'ただし、この関数におけるExifDataは、先頭が上記エンディアンデータとなっているため、&H0Cについては考慮する必要なし。
GPScount = CLng(Byte2Str.endianHex(ExifData, IFDdata(IFDtagData("&H8825")).DataOffset, 2))
ReDim GPSdata(GPScount)
For III = 1 To GPScount
GPSdata(III).endian = Byte2Str.endian
GPSdata(III).readIFD ExifData, GPSstart + 2 + (III - 1) * 12
GPStagData.Add GPSdata(III).TagI, III
Next
End If

Close #1
End Function


Public Function getIFDdata(tag As String) As String
'0x010e ImageDescription ascii string
'0x0132 DateTime ascii string
'0x8298 Copyright ascii string
'0x9286 UserComment undefined "ユーザーコメントが格納されます。ImageDescriptionタグと違って、こちらはJIS2バイトコード、
'Unicode等での記述が許されており、最初の8バイトが文字コードを示します。

'0x41,0x53,0x43,0x49,0x49,0x00,0x00,0x00':ASCII
'0x4a,0x49,0x53,0x00,0x00,0x00,0x00,0x00':JIS
'0x55,0x4e,0x49,0x43,0x4f,0x44,0x45,0x00':Unicode
'0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00':Undefined"

'0x9003 DateTimeOriginal ascii string
'0x9004 DateTimeDigitized ascii string
'0x8825 GPSInfo unsigned long
Dim ImgTag As String
If InStr(tagName(tag), "GPS_") > 0 Then
ImgTag = Replace(tagName(tag), "GPS_", "")
getIFDdata = Replace(GPSdata(GPStagData(ImgTag)).Data, Chr(0), "")
ElseIf InStr(tagName(tag), "SUB_") > 0 Then
ImgTag = Replace(tagName(tag), "SUB_", "")
getIFDdata = Replace(SubIFDdata(SubIFDtagData(ImgTag)).Data, Chr(0), "")

Else
getIFDdata = Replace(IFDdata(IFDtagData(tagName(tag))).Data, Chr(0), " ")
End If
End Function
Public Function getGPSdata(tagName As String) As String
'0x0000 GPS タグのバージョン GPSVersionID
'0x0001 北緯(N)or 南緯(S) GPSLatitudeRef
'0x0002 緯度（数値） GPSLatitude
'0x0003 東経(E)or 西経(W) GPSLongitudeRef
'0x0004 経度（数値） GPSLongitude
'0x0005 高度の単位 GPSAltitudeRef
'0x0006 高度（数値） GPSAltitude
'0x0012 測位に用いた地図データ GPSMapDatum
Dim ImgTag As String
Select Case tagName
Case "GPSVersionID"
ImgTag = "&H0000"
Case "GPSLatitudeRef"
ImgTag = "&H0001"
Case "GPSLatitude"
ImgTag = "&H0002"
Case "GPSLongitudeRef"
ImgTag = "&H0003"
Case "GPSLongitude"
ImgTag = "&H0004"
Case "GPSAltitudeRef"
ImgTag = "&H0005"
Case "GPSAltitude"
ImgTag = "&H0006"
Case "GPSMapDatum"
ImgTag = "&H0012"
Case Else
ImgTag = False
End Select
If ImgTag Then
getGPSdata = Replace(GPSdata(GPStagData(ImgTag)).Data, Chr(0), "")
Else
getGPSdata = "Not Available"
End If

End Function


Private Sub setTagname()
End Sub

ByteExchange.cls

VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "ByteExchange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public endian As String
'エンディアン変換用クラスモジュール
'endian プロパティにセットする値は、"II"(インテル形式)または"MM"(モトローラ形式)
Public Function endianHex(Data() As Byte, startP As Long, Length As Long) As String
'エンディアンを変換する。開始点と取り出すバイト数からきめる。あらかじめendianをセットしておく必要がある。
'エンディアンのデフォルトは"MM"
'戻り値は、"&H"がついた16進形式の文字列。
If endian <> "II" Then endian = "MM"
Dim III As Long
Dim startW As Long
Dim endW As Long
Dim stepW As Long
Dim tempB As String
endianHex = "&H"
'エンディアンに基づき、バイトデータの読み順を決める
If endian = "II" Then
startW = startP + Length - 1
endW = startP
stepW = -1
ElseIf endian = "MM" Then
startW = startP
endW = startP + Length - 1
stepW = 1
Else

End If
'エンディアンに基づき、バイト列を16進形式の文字列にする。
For III = startW To endW Step stepW
tempB = Hex(Data(III))
If Len(tempB) = 1 Then tempB = "0" & tempB
endianHex = endianHex & tempB
Next
End Function

Public Function byte_Hex(Indata As Integer) As String
byte_Hex = Hex(Indata)
If Len(byte_Hex) = 1 Then byte_Hex = "0" & byte_Hex
End Function