VBGood網站全文搜索 Google

搜索VBGood全站網頁(全文搜索)

VB愛好者樂園(VBGood)

 找回密碼
 立即注冊
搜索
查看: 410|回復: 1
打印 上一主題 下一主題

[求助] 如何獲取照片文件的拍攝日期

[復制鏈接]
跳轉到指定樓層
1
發表于 2019-6-21 21:00:47 | 只看該作者 回帖獎勵 |倒序瀏覽 |閱讀模式
我電腦有好多照片 想分類 一下
手動太累 太麻煩
我想用VB 獲取 照片的拍攝日期  將 相同的日期 的照片放在同一個文件夾
2
發表于 2019-6-23 21:41:24 | 只看該作者
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 of this property
   Length                   As Long               ' Length of the property value, in bytes
   Type                     As Long                 ' Type of the value, as one of TAG_TYPE_XXX  defined above
   Value                    As Long                ' property value
End Type


Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, hImage As Long) As Long '從指定路徑的文件,得到一個image對象,從文件創建GDI+句柄
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 '獲取EXIF顯示總數
Private Declare Function GdipGetPropertyIdList Lib "gdiplus" (ByVal Image As Long, ByVal numOfProperty As Long, list As Long) As Long ' 獲取PropertyId列表
Private Declare Function GdipGetPropertyItemSize Lib "gdiplus" (ByVal Image As Long, ByVal propId As Long, Size As Long) As Long ' '獲取每個EXIF信息的數據段大小
Private Declare Function GdipGetPropertyItem Lib "gdiplus" (ByVal Image As Long, ByVal propId As Long, ByVal propSize As Long, Buffer As Long) As Long '獲取EXIF信息段
Private Declare Function GdipGetPropertySize Lib "gdiplus" (ByVal Image As Long, totalBufferSize As Long, numProperties As Long) As Long '獲取此Image對象中存儲的所有屬性項的總大小(以字節為單位)。GetPropertySize函數還可以獲取此Image對象中存儲的屬性項的數量。
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal ByteLength As Long)



Private Function GetPhotoDate(ImagePath As String) As String
    Dim Bitmap                  As Long
    Dim Token                   As Long
    Dim Index                   As Long
    Dim PropertyCount           As Long
    Dim ItemSize                As Long
    Dim Prop                    As PropertyItem
    Dim GdipInput               As GdiplusStartupInput
    Const PropertyTagExifDTOrig As Long = &H9003&                  ' Date & time of original

    GdipInput.GdiplusVersion = 1
    GdiplusStartup Token, GdipInput
    GdipLoadImageFromFile StrPtr(ImagePath), Bitmap
    GdipGetPropertyCount Bitmap, PropertyCount
    ReDim PropertyList(PropertyCount - 1) As Long
    GdipGetPropertyIdList Bitmap, PropertyCount, PropertyList(0)
    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)
        ReDim Data(ItemSize - 16) As Byte
        CopyMemory Data(0), ByVal Prop.Value, ItemSize - 16
        Select Case PropertyList(Index)
        Case PropertyTagExifDTOrig
            GetPhotoDate = StrConv(Data, vbUnicode)
        End Select
    Next
    GdipDisposeImage Bitmap
    GdiplusShutdown Token
    Text1 = GetPhotoDate
End Function

Private Sub Form_Load()
Dim a As String
a = "d:\臨時文件夾\P1030744.JPG"
    GetPhotoDate a
   
End Sub


回復 支持 反對

使用道具 舉報

您需要登錄后才可以回帖 登錄 | 立即注冊

本版積分規則

文字版|手機版|小黑屋|VBGood  

GMT+8, 2019-8-5 08:01

VB愛好者樂園(VBGood)
快速回復 返回頂部 返回列表
守车人游戏