- 积分
- 4295
- 明经币
- 个
- 注册时间
- 2007-5-7
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|

楼主 |
发表于 2013-9-9 22:19:46
|
显示全部楼层
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
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 Function GdipGetPropertySize Lib "gdiplus" (ByVal Image As Long, totalBufferSize As Long, numProperties As Long) As Long
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
End Function
这是网上查到的VB版,请高手转换为LISP咯 |
|