查看数码相机jpg照片信息的VB代码

如今数码相机和手机拍照已经普及，这种数码相机拍出来的jpg图片文件与普通的jpg图片文件相比较，多了“数码相机识别信息”，这些信息包括拍摄时的光圈、快门、白平衡、ISO、焦距、日期时间以及相机品牌、型号、色彩编码等各种数据。各位一定想在自己编写的程序中查看这些信息，没问题！下面就是可以查看这些信息的代码，由于信息比较多，我只选取了其中的一部分，你可以自行增、删，当然前提是你必须对TIFF文件的数据结构比较熟悉（因为这些信息采用的是TIFF格式）。如果不熟悉，请先参看笔者的《TIF文件数据结构》和《jpg文件数据结构》。
在窗体上添加一个按纽和一个文本框，文本框设置为有垂直滚动条和可以接受多行文本，代码如下：

Option Explicit

Private Type GdiplusStartupInput
GdiplusVersion           As Long
DebugEventCallback       As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs   As Long
End Type

Private Type PropertyItem           '标签结构
propId                   As Long  '标签ID
Length                   As Long  '标签值长度字节
Type                     As Long  '标签类型
Value                    As Long  '标签值
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, hImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipGetPropertyCount Lib "gdiplus" (ByVal Image As Long, numOfProperty As Long) As Long
Private Declare Function GdipGetPropertyIdList Lib "gdiplus" (ByVal Image As Long, ByVal numOfProperty As Long, list As Long) As Long
Private Declare Function GdipGetPropertyItemSize Lib "gdiplus" (ByVal Image As Long, ByVal propId As Long, Size As Long) As Long
Private Declare Function GdipGetPropertyItem Lib "gdiplus" (ByVal Image As Long, ByVal propId As Long, ByVal propSize As Long, Buffer As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)

Dim ImagePath As String

Private Sub Form_Load()
ImagePath = "(全路径文件名)"
End Sub

Private Sub Command1_Click()
Dim Bitmap        As Long    '图像句柄
Dim Token         As Long    'Gdip启动标记
Dim Index         As Long    '标签索引
Dim PropertyCount As Long    '标签数量
Dim ItemSize      As Long    '标签值大小
Dim TagName       As String  '标签名
Dim TagID         As String * 4 '标签ID
Dim Prop          As PropertyItem
Dim GdipInput     As GdiplusStartupInput
Dim d5 As String, st2 As String, st3 As String, st4 As String, st5 As String
Dim d_1 As Long, d_2 As Long
Dim k As Integer, z As String

GdipInput.GdiplusVersion = 1
GdiplusStartup Token, GdipInput                 '启动Gdip
GdipLoadImageFromFile StrPtr(ImagePath), Bitmap '装入图像，获取图像句柄
GdipGetPropertyCount Bitmap, PropertyCount      '获取标签数量

If PropertyCount Then
ReDim PropertyList(PropertyCount - 1) As Long
GdipGetPropertyIdList Bitmap, PropertyCount, PropertyList(0)    '获取所有标签的ID(TagID)

For Index = 0 To PropertyCount - 1
GdipGetPropertyItemSize Bitmap, PropertyList(Index), ItemSize '获取标签大小
ReDim Buffer(ItemSize - 1) As Byte                            '根据标签大小建立缓冲区
GdipGetPropertyItem Bitmap, PropertyList(Index), ItemSize, ByVal VarPtr(Buffer(0)) '根据标签大小获取其内容
CopyMemory Prop, ByVal VarPtr(Buffer(0)), Len(Prop) '把标签内容复制到Prop结构
ReDim Data(ItemSize - 16) As Byte
CopyMemory Data(0), ByVal Prop.Value, ItemSize - 16 '把Prop结构中的标签值复制到Data数组
TagID = Right("000" & Hex(Prop.propId), 4)
Select Case Prop.Type
Case 2, 7 '值类型是文本
TagName = ""
Select Case TagID
Case "0131": TagName = "图像生成软件..："
Case "0132": TagName = "图像生成时间..："
Case "5041": TagName = "Interop 索引..："
Case "5042": TagName = "Interop 版本..："
Case "010E": TagName = "图像描述......："
Case "010F": TagName = "相机制造厂商..："
Case "0110": TagName = "数码相机型号..："
Case "9000": TagName = "Exif 版本.....："
Case "9003": TagName = "照片拍摄时间..："
Case "9004": TagName = "数字化时间....："
Case "9101": TagName = "像素顺序......：": GoSub 200
Case "A000": TagName = "FlashPix 版本.："
Case "A300": TagName = "图像来源......：": GoSub 200
Case "A301": TagName = "场景类型......：": GoSub 200
Case "C4A5": TagName = "打印命令集版本："
End Select
If Len(TagName) Then
z = StrConv(Data, vbUnicode): k = InStr(z, Chr(0))
If k Then z = Left(z, k - 1)
st2 = st2 & TagName & Replace(z, Chr(0), "") & vbCrLf
End If
Case 3     '值类型是整形
TagName = ""
Select Case TagID
Case "0103": TagName = "数据压缩方式..：": z = IIf(Data(0) = 0, "未压缩", "JPEG压缩")
Case "0112": TagName = "相机对场景方向：": z = Choose(Data(0) + 1, "未知", "顶部左侧", "顶部右侧", "底部右侧", "底部左侧", "左侧顶部", "右侧顶部", "右侧底部", "左侧底部")
Case "0128": TagName = "分辨率单位....：": z = Choose(Data(0) + 1, "未知", "无单位", "英吋", "厘米")
Case "0213": TagName = "颜色抽样方式..：": z = IIf(Data(0) = 1, "像素阵列中心", "基准点")
Case "8822": TagName = "曝光模式......：": z = Choose(Data(0) + 1, "未知", "手动曝光", "正常曝光", "光圈优先", "快门优先", "慢速", "高速", "肖像", "风景")
Case "8827": TagName = "ISO 感光度....：": z = Data(0)
Case "9207": TagName = "测光方式......：": z = Choose(Data(0) + 1, "未知", "平均测光", "中央重点测光", "点测光", "多点测光", "多区域测光", "部分测光", "其它")
Case "9208": TagName = "白平衡........：": z = Choose(Data(0) + 1, "未知", "日光", "荧光灯", "白炽灯", "其它")
Case "9209": TagName = "闪光灯应用....：": z = IIf(Data(0) = 1, "闪光", "未闪光")
Case "A001": TagName = "色彩空间......：": z = IIf(Data(0) = 1, "sRGB", "其它")
Case "A210": TagName = "密度单位......：": z = Choose(Data(0) + 1, "未知", "无单位", "英吋", "厘米")
End Select
If Len(TagName) Then st3 = st3 & TagName & z & vbCrLf
Case 4     '值类型是长整形
TagName = ""
Select Case TagID
Case "A002": TagName = "源图像宽(像素)："
Case "A003": TagName = "源图像高(像素)："
Case "9206": TagName = "到焦点距离(米)："
End Select
If Len(TagName) Then d_1 = Data(0) + Data(1) * 256: st4 = st4 & TagName & d_1 & vbCrLf
Case 5, 10 '值类型是分数
TagName = ""
Select Case TagID
Case "011A": TagName = "横分辨率(像素)：": GoSub 500: z = d5
Case "011B": TagName = "纵分辨率(像素)：": GoSub 500: z = d5
Case "829A": TagName = "曝光时间(秒)..：": GoSub 500: z = "1/" & d_2
Case "9201": TagName = "快门速度(秒)..：": GoSub 500: z = "1/" & Format(d5, "#")
Case "9202": TagName = "相机光圈(F值).：": GoSub 500: z = "F" & Format(d5, "0.0")
Case "9203": TagName = "曝光量........：": GoSub 500: z = "1/" & Format(d5, "0.0")
Case "9204": TagName = "曝光补偿(EV)..：": GoSub 500: z = Format(d5, "0.00")
Case "9205": TagName = "镜头最大光圈值：": GoSub 500: z = "F" & Format(d5, "0.0")
Case "920A": TagName = "物理焦距(毫米)：": GoSub 500: z = Format(d5, "0.0")
Case "A215": TagName = "CCD感光度(ISO)：": GoSub 500: z = Format(d5, "#")
End Select
If Len(TagName) Then st5 = st5 & TagName & z & vbCrLf
End Select
Next

Text1 = st4 & st2 & st5 & st3
End If

GdipDisposeImage Bitmap
GdiplusShutdown Token
Exit Sub

200
Select Case TagID
Case "9101": If Data(0) = 0 Then z = "无" Else z = IIf(Data(0) = 1 And Data(1) = 2 And Data(2) = 3, "YCbCr", "RGB")
Case "A300": z = IIf(Data(0) = 3, "数字相机", "未知")
Case "A301": z = IIf(Data(0) = 1, "相机直接拍摄", "未知")
End Select
Data = StrConv(z, vbFromUnicode)
Return

500
d_1 = "&H" & Right("0" & Hex(Data(3)), 2) & Right("0" & Hex(Data(2)), 2) & Right("0" & Hex(Data(1)), 2) & Right("0" & Hex(Data(0)), 2)
d_2 = "&H" & Right("0" & Hex(Data(7)), 2) & Right("0" & Hex(Data(6)), 2) & Right("0" & Hex(Data(5)), 2) & Right("0" & Hex(Data(4)), 2)
If d_2 Then d5 = d_1 / d_2 * IIf(Prop.Type = 5, 1, 10)
If TagID = "829A" Then If d5 Then d_2 = 10000 / (10000 * Round(d5, 4))
Return

End Sub