Public Sub HoleFileInformation
On Error Resume Next
Dim objExif As New ExifReader
Dim txtExifInfo As String
Dim hFile As Long
Dim Retval As Long
Dim CTime As FILETIME
Dim STime As SYSTEMTIME
Dim ATime As FILETIME
Dim BTime As FILETIME
Dim Dummi As FILETIME
Dim OF As OFSTRUCT
Dim LowSize As Long
Dim HighSize As Long
Dim MyLowSize As Long
Dim sHelp As String
' Datei öffnen (nicht Erstellen, falls nicht vorhanden)
hFile = CreateFile(MyDirFile, GENERIC_READ, FILE_SHARE_READ, _
ByVal 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
If hFile = -1 Then
Select Case MyLanguage
Case "D"
sHelp = "Datei nicht vorhanden, wird ignoriert!"
Case "F"
sHelp = "Fichier pas disponible, ignoré!"
Case "I"
sHelp = "File non ottenibile, ignored!"
Case "E"
sHelp = "File not available, ignored!"
End Select
MsgBox sHelp, vbOKOnly + vbInformation, "GetFileInformation"
Exit Sub
End If
' Erstellungsdatum ermitteln
GetFileTime hFile, CTime, ATime, BTime
' Konvertieren nach "Lokale Zeitzone"
FileTimeToLocalFileTime BTime, BTime
' In Systemzeit umwandeln
FileTimeToSystemTime BTime, STime
'Öffnet die Datei
OF.cBytes = Len(OF)
hFile = OpenFile(MyDirFile, OF, OF_READ)
If hFile = 0 Then
Exit Sub
End If
' Ermitteln der Dateigröße
LowSize = GetFileSize(hFile, HighSize)
CloseHandle hFile
MyFilePrint = MyFile
' ermitteln der Bildabmessungen
Select Case LCase$(Right$(MyFile, 3))
Case "bmp", "jpg", "gif", "wmf"
If GetPictureSize(MyDirFile, nWidth, nHeight) = False Then
MsgBox "Fehler... " & "Evtl. wurde ein ungültiger Bildpfad angegeben.", vbOKOnly, "RenamePictures"
End If
End Select
CloseHandle MyDirFile
' ermitteln Aufnahmedateum und Zeit wenn JPG-Bild
Select Case LCase$(Right$(MyFile, 3))
Case "jpg"
objExif.Load MyDirFile
txtExifInfo = objExif.Tag(DateTimeOriginal)
MsgBox txtExifInfo
End Select
Case m_RATIONAL, m_SRATIONAL
BytesPerComponent = 8
.Offset_To_Value = _
ExifTemp((Offset + 2) + ((i - 1) * 12) + 11) * 256& * 256& * 256& + _
ExifTemp((Offset + 2) + ((i - 1) * 12) + 10) * 256& * 256& + _
ExifTemp((Offset + 2) + ((i - 1) * 12) + 9) * 256& + _
ExifTemp((Offset + 2) + ((i - 1) * 12) + 8)
ab hier ist gelb markiert im VB
.Value = _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 3) * 256& * 256& * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 2) * 256& * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 1) * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 0) & _
"/" & _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 7) * 256& * 256& * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 6) * 256& * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 5) * 256& + _
ExifTemp(Offset_to_TIFF + .Offset_To_Value + 4)
bis hier
End Select
Könnte es sein, das das Klassenmodul aussteigt, wenn kein Aufnahme-Datum vorhanden ist?
' *** begin abu ***
' Private
Public IsLoaded As Boolean
' *** end abu ***
' *** begin abu ***
If objExif.IsLoaded Then
txtExifInfo = objExif.Tag(DateTimeOriginal)
If "" <> txtExifInfo Then
MsgBox txtExifInfo
End If
End If
' *** end abu ***