VB 5/6-Tipp 0202: Dateizeiten manipulieren

von ActiveVB

Beschreibung

Dateizeiten können geändert werden. Dieser Tipp zeigt wie alle drei Zeittypen eines Files manipulierbar sind. Zudem beeinhaltet er die Funktion einer zufälligen Datums- und Zeitgenerierung.

Änderung am 08. März 2003 nach Tilo Hehnke (Tilo.Behnke@ib.bankgesellschaft.de): Um Fehlern vorzubeugen wird das Dateiattribut für kurze Zeit geändert.

Update am 18. August 2003: Es sollte nun keine Zeitverschiebung mehr stattfinden.

Update vom 25.11.2005 (Oliver Münchow): Die im System gespeicherte UTC-Zeit sollte nun korrekt in die lokale Zeitzone umgewandelt werden.

Update am 29.12.2005 (Kai): Die als "veraltet" markierte Funktion "openfile" wurde ersetzt.

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

CloseHandle, CreateFileA (CreateFile), FileTimeToLocalFileTime, FileTimeToSystemTime, GetFileTime, LocalFileTimeToFileTime, SetFileTime, SystemTimeToFileTime

Download:

Download des Beispielprojektes [4,27 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame2"
' Steuerelement: Schaltfläche "Command2" auf Frame2
' Steuerelement: Schaltfläche "Command1" auf Frame2
' Steuerelement: Beschriftungsfeld "Label9" auf Frame2
' Steuerelement: Beschriftungsfeld "Label8" auf Frame2
' Steuerelement: Beschriftungsfeld "Label7" auf Frame2
' Steuerelement: Beschriftungsfeld "Label12" auf Frame2
' Steuerelement: Beschriftungsfeld "Label11" auf Frame2
' Steuerelement: Beschriftungsfeld "Label10" auf Frame2
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Beschriftungsfeld "Label2" auf Frame1
' Steuerelement: Beschriftungsfeld "Label3" auf Frame1
' Steuerelement: Beschriftungsfeld "Label4" auf Frame1
' Steuerelement: Beschriftungsfeld "Label5" auf Frame1
' Steuerelement: Beschriftungsfeld "Label6" auf Frame1

Option Explicit

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
        (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) _
        As Long

Private Declare Function CreateFile Lib "kernel32.dll" Alias _
        "CreateFileA" (ByVal lpFileName As String, _
        ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, _
        ByVal lpSecurityAttributes As Long, _
        ByVal dwCreationDisposition As Long, _
        ByVal dwFlagsAndAttributes As Long, _
        ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" _
        (ByVal hObject As Long) As Long
        
Private Declare Function GetFileTime Lib "kernel32" _
        (ByVal hFile As Long, lpCreationTime As FILETIME, _
        lpLastAccessTime As FILETIME, lpLastWriteTime _
        As FILETIME) As Long
        
Private Declare Function SetFileTime Lib "kernel32" (ByVal _
        hFile As Long, lpCreationTime As FILETIME, _
        lpLastAccessTime As FILETIME, lpLastWriteTime As _
        FILETIME) As Long
        
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
        (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) _
        As Long

Private Declare Function SystemTimeToFileTime Lib "kernel32" _
        (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) _
        As Long

Private Declare Function LocalFileTimeToFileTime Lib "kernel32.dll" _
        (lpLocalFileTime As FILETIME, lpFileTime As FILETIME) As Long

Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const OFS_MAXPATHNAME As Long = 128&

Private Type OFSTRUCT
    cBytes As Byte
    fFixedDisk As Byte
    nErrCode As Integer
    Reserved1 As Integer
    Reserved2 As Integer
    szPathName(OFS_MAXPATHNAME) As Byte
End Type

Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

Dim TestFile As String

Private Sub Form_Load()
    Dim FN As Integer
    
    TestFile = App.Path & "\Test.txt"
    
    'Evt. Test-Datei erstellen
    If Len(Dir$(TestFile, vbNormal)) = 0 Then
        FN = FreeFile
        Open TestFile For Output As #FN
        Close FN
    End If
    
    Call GetFTime
    Command2.Enabled = False
End Sub

Private Sub Command1_Click()
    Dim DTformat As String, Base As Date
 
    DTformat = "dd.mm.yyyy hh:mm:ss"
    Base = GetRandomDate(Base)
    Label7.Caption = Format$(Base, DTformat)
    Base = GetRandomDate(Base)
    Label8.Caption = Format$(Base, DTformat)
    Base = GetRandomDate(Base)
    Label9.Caption = Format$(Base, DTformat)
    Command2.Enabled = True
End Sub

Private Sub Command2_Click()
    Dim hFile As Long, DTformat As String
    Dim sTime As SYSTEMTIME
    Dim OFS As OFSTRUCT
    Dim cTime As FILETIME
    Dim lTime As FILETIME
    Dim lwTime As FILETIME
    
    'Änderung 08.03.2003:
    'Die Dateiattribute werden nun zwischenzeitlich geändert,
    'um Fehlern vorzubeugen
    Dim fAttr As VbFileAttribute
    
    fAttr = GetAttr(TestFile)
    SetAttr TestFile, vbNormal
  
    OFS.cBytes = Len(OFS)
    ' Update von Kai: OpenFile gilt als "veraltet"
    'hFile = OpenFile(TestFile, OFS, OF_WRITE)
    hFile = OpenFile(TestFile, 1)
    
    If hFile > 0 Then
        DTformat = "dd.mm.yyyy hh:mm:ss"
        Call GetFileTime(hFile, cTime, lTime, lwTime)
        
        Call FileTimeToLocalFileTime(cTime, cTime)
        Call FileTimeToSystemTime(cTime, sTime)
        Label1.Caption = Format$(CalcFTime(sTime), DTformat)
        
        Call FileTimeToLocalFileTime(lTime, lTime)
        Call FileTimeToSystemTime(lTime, sTime)
        Label2.Caption = Format$(CalcFTime(sTime), DTformat)
        
        Call FileTimeToLocalFileTime(lwTime, lwTime)
        Call FileTimeToSystemTime(lwTime, sTime)
        Label3.Caption = Format$(CalcFTime(sTime), DTformat)
        
        Call CloseHandle(hFile)
    End If
    
    Call GetFTime
    Command2.Enabled = False
    
    SetAttr TestFile, fAttr
End Sub

Private Sub GetFTime()
    Dim DTformat As String
    Dim hFile As Long, OFS As OFSTRUCT
    Dim cTime As FILETIME
    Dim lTime As FILETIME
    Dim lwTime As FILETIME
    Dim sTime As SYSTEMTIME
     
    OFS.cBytes = Len(OFS)
    hFile = OpenFile(TestFile, 0)
    
    If hFile > 0 Then
        DTformat = "dd.mm.yyyy hh:mm:ss"
        Call GetFileTime(hFile, cTime, lTime, lwTime)
        
        Call FileTimeToSystemTime(cTime, sTime)
        Label1.Caption = Format$(CalcFTime(sTime), DTformat)
        
        Call FileTimeToSystemTime(lTime, sTime)
        Label2.Caption = Format$(CalcFTime(sTime), DTformat)
         
        Call FileTimeToSystemTime(lwTime, sTime)
        Label3.Caption = Format$(CalcFTime(sTime), DTformat)
         
        Call CloseHandle(hFile)
    End If
End Sub

Private Function CalcFTime(FTime As SYSTEMTIME) As Date
    Dim Datum As String, Zeit As String, aa As String
    Dim mm As String, ss As String, DT As Date
    Dim Da As String, Mo As String, Ye As String

    With FTime
        Da = .wDay
        If Len(Da) < 2 Then Da = "0" & Da
    
        Mo = .wMonth
        If Len(Mo) < 2 Then Mo = "0" & Mo
    
        Ye = CStr(.wYear)
        Datum = Da & "." & Mo & "." & Ye
    
        mm = Trim$(CStr(.wMinute))
        If Len(mm) < 2 Then mm = "0" & mm
    
        ss = Trim$(CStr(.wSecond))
        If Len(ss) < 2 Then ss = "0" & ss
    
        Zeit = .wHour & ":" & mm & ":" & ss
        DT = CDate(Datum & " " & Zeit)
        CalcFTime = DT
    End With
End Function

Private Function CalcNewfTime(Datum$) As FILETIME
    Dim SysT As SYSTEMTIME, FT As FILETIME
    Dim FTL As FILETIME
     
    With SysT
        .wDay = CInt(Left$(Datum, 2))
        .wMonth = CInt(Mid$(Datum, 4, 2))
        .wYear = CInt(Mid$(Datum, 7, 4))
        .wHour = CInt(Mid$(Datum, 12, 2))
        .wMinute = CInt(Mid$(Datum, 15, 2))
        .wSecond = CInt(Mid$(Datum, 18, 2))
    End With
    
    Call SystemTimeToFileTime(SysT, FT)
    
    'Update am  18 August 2003:
    'Nun sollten die Fehler mit der Zeitverschiebung verschwunden sein
    Call LocalFileTimeToFileTime(FT, FTL)
    CalcNewfTime = FTL
End Function

Private Function GetRandomDate(Base As Date) As Date
    Dim aa As String
    
    Do
        aa = ""
        aa = CStr(Int(28 * Rnd) + 1) & "." & _
           CStr(Int(12 * Rnd) + 1) & "." & _
           CStr(Int(10 * Rnd) + 1998) & " " & _
           CStr(Int(24 * Rnd)) & ":" & _
           CStr(Int(60 * Rnd)) & ":" & _
           CStr(Int(60 * Rnd))
    Loop While CDate(aa) < Base
    GetRandomDate = CDate(aa)
End Function

Public Function OpenFile(Filename As String, DesiredAccess As Long) As Long
    Dim dwDesiredAccess As Long
    
    If DesiredAccess = 0 Then dwDesiredAccess = GENERIC_READ
    If DesiredAccess = 1 Then dwDesiredAccess = GENERIC_WRITE
    If dwDesiredAccess = 0 Then Exit Function
    
    OpenFile = CreateFile(Filename, dwDesiredAccess, 0, 0, OPEN_EXISTING, 0, 0)
End Function
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Tipp-Kompatibilität:

Windows/VB-Version	Win32s	Win95	Win98	WinME	WinNT4	Win2000	WinXP
VB4
VB5
VB6

Ihre Meinung

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare

Klicken Sie diesen Text an, wenn Sie die 12 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von Mischa am 01.04.2007 um 00:07

Funktioniert einwandfrei, aber im es scheint sich ein Fehler eingeschlichen zu haben. Die SUB von COMMAND2_CLICK liest in diesm Fall das Dateidatum statt es zu setzen. es sollte wohl eher heissen:
Private Sub Command2_Click()
Dim hFile As Long, DTformat As String
Dim sTime As SYSTEMTIME
Dim OFS As OFSTRUCT
Dim cTime As FILETIME
Dim lTime As FILETIME
Dim lwTime As FILETIME

'Änderung 08.03.2003:
'Die Dateiattribute werden nun zwischenzeitlich geändert,
'um Fehlern vorzubeugen
Dim fAttr As VbFileAttribute

fAttr = GetAttr(TestFile)
SetAttr TestFile, vbNormal

OFS.cBytes = Len(OFS)
' Update von Kai: OpenFile gilt als "veraltet"
'hFile = OpenFile(TestFile, OFS, OF_WRITE)
hFile = OpenFile(TestFile, 1)

If hFile > 0 Then
'Korrektur von Mischa
'Dateizeiten setzen, nicht lesen

cTime = CalcNewfTime(Label7.Caption)
lTime = CalcNewfTime(Label8.Caption)
lwTime = CalcNewfTime(Label9.Caption)

SetFileTime hFile, cTime, lTime, lwTime

Call CloseHandle(hFile)
End If

Call GetFTime
Command2.Enabled = False

SetAttr TestFile, fAttr
End Sub

Gruß
Mischa

Kommentar von Ingo Moch am 16.03.2007 um 12:41

Hallo,

es gibt eine performantere (und meiner Meinung nach auch "sauberere" Möglichkeit, um die API-Datumsangaben ind der Funktion "CalcFTime" in den VB-Datentyp zu überführen:

Private Function CalcFTime(FTime As SYSTEMTIME) As Date
    With FTime
         CalcFTime = _
              DateSerial(.wYear, .wMonth, .wDay) + _
              TimeSerial(.wHour, .wMinute, .wSecond)
    End With
End Function

Oder habe ich da etwas übersehen?

Ingo

Kommentar von Andreas am 04.05.2006 um 12:05

Hallo Oliver,

ich brauch eigentlich auch nur das Auslesen der Zeiten, die Anmerkung bezog sich auch nur auf die Überschrift "Manipulieren"

Nur zur Info
Ich habe in der Zwischenzeit eine VB Funktion gefunden welche die Zeiten ausliest -> FileDateTime (zumindest in VB6)

Gruß Andi

Kommentar von Oliver Münchow am 04.05.2006 um 09:38

Hi Andreas,

ja stimmt, außer der Deklaration ist nichts dafür drin. Also ran an die Tastatur und Beispiel erweitern (wenn du eh gerade daran arbeitest). ;-)

Kommentar von Andreas am 04.05.2006 um 09:24

Hallo,

ich hab mal das Beispielprojekt runtergeladen. Das Auslesen der Zeiten funktioniert ja aber maipuliert wird nichts. Fehlt da nicht irgendwo die Funktion SetFileTime? Bis auf die Deklaration hab ich jedenfalls nichts gefunden.

Gruß Andi

Kommentar von Oliver Münchow am 27.05.2005 um 15:25

Die FileTime einer Datei wird in UTC Zeit gespeichert. Damit diese korrekt in die eigene Zeitzone umgewandelt wird sollte man noch folgendes API mit einbinden:

Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
        (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) _
        As Long

Schließlich sollte nach dem 'abholen' der Zeit einer Datei dies noch durch diese Mühle gedreht werden, dazu muss der obige Code folgendermaßen ergänzt werden:

If hFile > 0 Then
    DTformat = "dd.mm.yyyy hh:mm:ss"
    Call GetFileTime(hFile, cTime, lTime, lwTime)
    
    Call FileTimeToLocalFileTime(cTime, cTime)
    Call FileTimeToSystemTime(cTime, sTime)
    Label1.Caption = Format$(CalcFTime(sTime), DTformat)
    
    Call FileTimeToLocalFileTime(lTime, lTime)
    Call FileTimeToSystemTime(lTime, sTime)
    Label2.Caption = Format$(CalcFTime(sTime), DTformat)
     
    Call FileTimeToLocalFileTime(lwTime, lwTime)
    Call FileTimeToSystemTime(lwTime, sTime)
    Label3.Caption = Format$(CalcFTime(sTime), DTformat)
     
    Call CloseHandle(hFile)
End If

Kommentar von am 28.12.2003 um 16:31

Der Code ist anscheinend sehr langsam.

Wenn ich in einer Art Explorer-Ansicht die Dateizeiten anzeigen will bremst dieser Code die Anzeige auf meinem 1500 MHz-CPU die Anzeige bei großen Verzeichnissen um mehrere Sekunden aus.

Kommentar von baam am 28.08.2002 um 21:57

das geht auch einfacher mit date = 12.12.2002 oder so

Kommentar von Jens Fuchs am 15.08.2001 um 10:09

Leider ist es nicht möglich OFS_MAXPATHNAME auf 258 zu setzen. Unter WinNT4.0SP5 wären max. 245 möglich. Leider erhält man dann aber ein Handle -1 zurück, sprich er findet die Datei nicht mehr. Es tätsachlich so, das nur max. 126 Zeichen verwendet werden dürfen

Kommentar von Danny Goersdorf am 25.01.2001 um 16:12

Ich würde gerne das Datum einer ASP manipulieren. Es scheint allerdings nicht so einfach zu funktionieren. Gibt es da eine Möglichkeit ?
mfg Danny

Kommentar von Götz Reinecke am 15.11.2000 um 12:56

Hallo Jörg, das Problem läßt sich wahrscheinlich beheben, indem Du
Const OFS_MAXPATHNAME auf 258 und nicht wie angegeben auf 128 setzt.

Kommentar von Jörg Hagemann am 15.11.2000 um 12:47

Das Manipulieren der Zeiten funktioniert prinzipiell. Es gibt bei mir nur die Einschränkung, daß die Länge des Dateinamens (Pfad+Name oder nur Name) nicht länger als 126 Zeichen sein darf. Mit der Funktion CreateFile müßte es eigentlich klappen.
Gruß
Jörg