Im ersten Teil unseres Workshops haben wir eine universelle Datensicherungsfunktion erstellt, welche alle Dateien und Ordner eines bestimmten Verzeichnisses auf ein auswählbares Speichermedium sichert. Neben der Datensicherung benötigen wir jedoch auch eine Rücksicherungsfunktion, um die Daten der Datensicherung bei einem evtl. Datenverlust wiederherstellen zu können. Genau diese Aufgabe realsieren wir im zweiten Teil unseres Workshops. Benötigte Formulare
Plazieren der benötigten Steuerelemente: Für die Auswahl des Backup-Satzes benötigen wir ein ListBox-Steuerelement und zwei CommandButton-Steuerelemente. Außerdem sollte ein kurzer Text mit einem entsprechenden Hinweis angezeigt werden. Hierzu plazieren wir ein Label-Steuerlement auf das Formular. Das fertige Formular sieht dann folgendermaßen aus: Besonderheiten:
Nachdem das Formular erstellt ist, muß jetzt noch der benötigte Quellcode eingefügt werden: Private Sub Form_Load() ' Initialisieren CenterForm Me End SubDas Form_Load-Ereignis ruft die globale Prozedur CenterForm auf, welches das Fenster auf dem Bildschirm zentriert anzeigt. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Schließen If UnloadMode <> 1 Then Cancel = True Command1_Click 1 End If End SubDas Form_QueryUnload-Ereignis teilt uns mit, wie der Anwender das Formular geschlossen/ beendet hat. Hat der Anwender auf das Schließensymbol in der Titelzeile geklickt, simulieren wir einfach einen Klick auf die Abbrechen-Schaltfläche. Private Sub Form_Unload(Cancel As Integer) ' Beenden Set RestoreBackupBox = Nothing End SubIm Form_Unload-Ereignis wird durch den Befehl Set RestoreBackupBox = Nothing die Form vollständig aus dem Speicher entfernt. Public Sub InitMain(ByVal QuellLW As String) ' Backup-Sätze ermitteln Dim Count As Integer Dim AktDisk As Integer Dim Datei As String Dim Datum As String Dim Zeit As String ' Nach vorhandenen Backup-Dateien suchen ' und der Liste hinzufügen (Datei tt.mm.jjjj, hh:mm) Liste.Clear Count = 1 Do Datei = BackupDatei + Format$(Count, "000") If FileExists(QuellLW + "\" + Datei) Then Datum = Format$(FileDateTime(QuellLW + "\" + Datei), "dd.mm.yyyy") Zeit = Format$(FileDateTime(QuellLW + "\" + Datei), "hh:nn") Liste.AddItem Datei + vbTab + Datum + ", " + Zeit + " Uhr" Else Exit Do End If Count = Count + 1 Loop If Count > 1 Then Liste.ListIndex = 0 Else Liste.ListIndex = -1 End If Command1(0).Enabled = (Count > 0) End SubDie InitMain-Prozedur wird vom Hauptformular unter Angabe des Quell-Laufwerks aufgerufen. Innerhalb der Prozedur werden alle auf dem Quell-Laufwerk vorhandenen Backup-Sätze mit Datum und Uhrzeit ermittelt und der Liste (ListBox) hinzugefügt. Private Sub Command1_Click(Index As Integer) ' Befehlsschaltflächen OK/Abbrechen Dim Dummy As String Select Case Index Case 0 Dummy = Liste.List(Liste.ListIndex) Me.Tag = GetItem(Dummy) Me.Hide Case 1 Me.Tag = "" Me.Hide End Select End SubKlickt der Anwender auf OK, so wird das Command1_Click-Ereignis mit Index = 0 ausgelöst. Hier wird die Auswahl des Backup-Satzes in der Tag-Eigenschaft der Form zwischengespeichert und der aufrufenden Prozedur in unserem Hauptprogramm zurückgegeben. Klickt der Anwender auf Abbrechen, so wird das Command1_Click-Ereignis mit Index = 1 ausgelöst. Über die Tag-Eigenschaft der Form geben wir dann einen Leerstring zurück. Hauptformular für die Datenwiederherstellung
Das fertige Formular sollte dann folgendermaßen aussehen: Besonderheiten:
Quellcode für die Wiederherstellungsroutinen: Option explicit Dim Abbruch As Integer Dim Titel As String Dim StartZeit As Variant Private Type FileInfo FileLen As Integer End Type Private Type FileSize FileSize As Long DiskSize As Long Date As String * 10 Time As String * 5 Split As Boolean End Type ' Datei Datum/Zeit 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 ' Benötigte API-Deklarationen Private Declare Function CreateFile Lib "kernel32" _ 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 FileTimeToLocalFileTime Lib "kernel32" ( _ lpFileTime As FileTime, _ lpLocalFileTime 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" ( _ lpLocalFileTime As FileTime, _ lpFileTime As FileTime) As Long Private Const GENERIC_READ = &H80000000 Private Const GENERIC_WRITE = &H40000000 Private Const OPEN_EXISTING = 3Mit Hilfe der Strukturen FileTime und SYSTEMTIME, sowie der nachfolgenden API-Deklarationen können die Datums- und Zeitangaben einer Datei neu gesetzt werden. Beim Wiederherstellen der Dateien machen wir von dieser Funktion Gebrauch, da die Dateien sonst das aktuelle Tagesdatum und die aktuelle Uhrzeit bekämen. Private Sub Form_Load() ' Formular positioniern CenterForm Me Titel = "Daten wiederherstellen" End SubDas Form_Load-Ereignis ruft die globale Prozedur CenterForm auf, welches das Fenster auf dem Bildschirm zentriert anzeigt. Außerdem wird in der Formular-globalen Variable Titel der Titeltext für evtl. angezeigte Hinweis- oder Meldungsfenster gespeichert. Private Sub Form_Activate() ' Restore-Routine aufrufen Dim Pfad As String Me.Refresh If Me.Tag <> "" Then Pfad = Me.Tag Me.Tag = "" MakeRestore Pfad End If Screen.MousePointer = 0 End SubDas Form_Activate-Ereignis wird ausgelöst, wenn das Fenster am Bildschirm zum ersten Mal dargestellt wird und weiterhin immer dann, wenn das Fenster den Fokus erhält, d.h. aktiviert wird. Beim allerersten Durchlauf wird die Pfadangabe des Zielordners (Datenverzeichnis) aus der Tag-Eigenschaft ausgelesen und anschließend die Prozedur MakeRestore aufgerufen. Damit diese Befehlsfolge nicht bei jeder Fensteraktivierung erneut durchgeführt wird, setzen wir die Tag-Eigenschaft zurück, indem wir ihr einen Leerstring zuweisen. So ist sichergestellt, daß die MakeRestore-Prozedur nur ein einiziges Mal aufgerufen wird. Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ' Fenster schließen If UnloadMode <> 1 Then Cancel = True Command1_Click End If End SubDas Form_QueryUnload-Ereignis teilt uns mit, wie der Anwender das Formular geschlossen/ beendet hat. Hat der Anwender auf das Schließensymbol in der Titelzeile geklickt, simulieren wir einfach einen Klick auf die Abbrechen-Schaltfläche. Private Sub Form_Unload(Cancel As Integer) ' Beenden Set RestoreBox = Nothing End SubIm Form_Unload-Ereignis wird durch den Befehl Set RestoreBox = Nothing die Form vollständig aus dem Speicher entfernt. Private Sub Command1_Click() ' Vorgang abbrechen If MsgBox("Vorgang jetzt wirklich abbrechen?", 292, Titel) = 6 Then Abbruch = True End If End SubDer Anwender hat die Möglichkeit den Wiederherstellungsvorgang jederzeit über die Schaltfläche "Abbrechen" zu beenden. Klickt er nun auf die Abbrechen-Schaltfläche, so wird eine zusätzliche Sicherheitsabfrage angezeigt. Beantwortet er diese mit JA (Rückgabewert der MsgBox-Funktion = 6), so setzen wir die Form-globale Variable Abbruch auf True, um der MakeRestore-Prozedur mitzuteilen, daß der Vorgang abgebrochen werden soll (innerhalb der MakeRestore-Prozedur findet eine regelmäßige Prüfung der Abbruch-Variable statt). Private Sub Timer1_Timer() ' Zeit anzeigen LabelZeit = Format$(Now - StartZeit, "hh:nn:ss") End SubDas Timer1_Timer-Ereignis wird jede halbe Sekunde ausgelöst, damit wir die bereits verstrichene Zeit im Dialogfenster anzeigen können.
Private Sub MakeRestore(ByVal Pfad As String) ' Daten zurückspeichern Dim BackupFile As BackupDaten Dim antwort As Integer Dim AnzDat As Long Dim AktDat As Long Dim AktDisk As Integer Dim AnzDisks As Long Dim File As String Dim F As Integer Dim N As Integer Dim MaxBackupSize As Long Dim NextDisk As Boolean Dim FileSize As Long Dim DiskSize As Long Dim AktSize As Long Dim ReadSize As Long Dim AktBackupSize As Long Dim dummy As String Dim ZielLW As String Dim Result As Integer Dim Path As String ' Quell-Laufwerk auswählen Load BackupLaufwerkBox With BackupLaufwerkBox .Caption = Titel .Label1 = "Bitte wählen Sie jetzt das Laufwerk, auf dem die " +_ "letzte Datensicherung durchgeführt wurde..." .Show 1 ZielLW = .Tag End With Unload BackupLaufwerkBox Me.Refresh ' Aufforderung: Diskette einlegen bzw. Backup-Satz auswählen If ZielLW <> "" Then Label1 = "Die Daten werden jetzt von Laufwerk " + _ Left$(ZielLW, 2) + " zurück auf die Festplatte gespeichert." If Right$(Pfad, 1) <> "\" Then Pfad = Pfad + "\" AktDisk = 1 If InsertBackupDisk(AktDisk, ZielLW) Then antwort = MsgBox("ACHTUNG!" + vbCrLf + _ "Evtl. vorhandene Dateien auf dem Zielgerät werden jetzt überschrieben.", 17, Titel) Abbruch = (antwort <> 1) Else Abbruch = True End If ' Backup-Datei öffnen, Anzahl Disketten ' und Backup-Größe ermitteln If Not Abbruch Then Abbruch = False On Local Error GoTo Restore_Error StartZeit = Now Timer1.Enabled = True DoEvents OpenBackupDatei F, AktDisk, ZielLW, NextDisk, AnzDat, MaxBackupSize FileSize = LOF(F) If NextDisk Then AnzDisks = (MaxBackupSize + (AnzDat * 100)) / FileSize If AnzDisks * FileSize < MaxBackupSize + (AnzDat * 100) Then AnzDisks = AnzDisks + 1 End If If AnzDisks < 2 Then AnzDisks = 2 Else AnzDisks = 1 End If LabelDisk(0) = Mid$(Str$(AnzDisks), 2) LabelFiles(0) = Mid$(Str$(AnzDat), 2) LabelSize(0) = Format$(MaxBackupSize, "###,###,###") ' Restore starten AktDat = 0 Do While AktDat < AnzDat And Not Abbruch AktDat = AktDat + 1 If Loc(F) >= LOF(F) Then GoSub Restore_NextDisk Else ReadBackupFileInfo F, BackupFile End If If Not Abbruch Then File = BackupFile.FileName LabelFiles(1) = Mid$(Str$(AktDat), 2) Label2 = File Status(0).Caption = "" DoEvents ' ggf. Pfad anlegen Path = GetPathFromFile(Pfad + File) Result = MakePath(Path) If Result Then ' Falls Zieldatei besteht -> löschen If FileExists(Pfad + File) Then Kill Pfad + File N = FreeFile Close #N: Open Pfad + File For Binary As #N End If ' Dateigröße ermitteln AktSize = 0 DiskSize = BackupFile.DiskSize FileSize = BackupFile.FileSize If Loc(F) >= LOF(F) Then GoSub Restore_NextDisk End If If Not Abbruch Then ' einzelne Datei wiederherstellen Do If AktSize + FileBlock > DiskSize Then ReadSize = DiskSize - AktSize Else ReadSize = FileBlock End If If ReadSize > 0 Then ' Fortschrittsanzeige aktualisieren AktSize = AktSize + ReadSize AktBackupSize = AktBackupSize + ReadSize LabelSize(1) = Format$(AktBackupSize, "###,###,###") ShowProzent Status(0), AktSize, FileSize ShowProzent Status(1), AktBackupSize, MaxBackupSize dummy = Space$(ReadSize) Get #F, , dummy If Result Then Put #N, , dummy End If End If ' GGf. Aufforderung: Nächste Diskette einlegen If AktSize >= DiskSize And BackupFile.Split Then GoSub Restore_NextDisk If Not Abbruch Then DiskSize = BackupFile.DiskSize End If End If DoEvents Loop Until AktSize >= FileSize Or Abbruch Close #N ' Datum der Datei ändern If Not Abbruch Then SetDateTime Pfad + File, BackupFile End If DoEvents End If End If Loop If N > 0 Then Close #N If F > 0 Then Close #F Timer1.Enabled = False Else Abbruch = True End If ' Restore beendet If Abbruch Then antwort = MsgBox("Der Vorgang wurde abgebrochen.", 48, Titel) Else antwort = MsgBox("Die Dateien wurde erfolgreich _ wiederhergestellt.", 64, Titel) End If End If Screen.MousePointer = 0 Unload Me Exit Sub Restore_NextDisk: Close #F AktDisk = AktDisk + 1 LabelDisk(1) = Mid$(Str$(AktDisk), 2) If InsertBackupDisk(AktDisk, ZielLW) Then OpenBackupDatei F, AktDisk, ZielLW, NextDisk ReadBackupFileInfo F, BackupFile Else Abbruch = True End If Return Restore_Error: If Not Abbruch Then antwort = MsgBox("Während des Restorevorgangs ist ein _ Fehler aufgetreten." + vbCrLf + vbCrLf + "Fehler " + _ Mid$(Str$(Err), 2) + vbCrLf + Error$, 21, Titel) If antwort = 4 Then Resume 0 Abbruch = True End If Resume Next End SubIn der MakeRestore-Prozedur läuft die eigentliche Wiederherstellungsroutine ab. Zunächst werden alle benötigten Variablen deklariert. Und jetzt der Reihe nach:
Wenn Sie sich den Quellcode der MakeRestore-Routine ansehen, werden Sie noch einige unbekannte Prozeduraufrufe finden. Hierbei handelt es sich um folgende Prozeduren: Private Function InsertBackupDisk(AktDisk As Integer, ZielLW As String) As Boolean ' Diskette einlegen Dim antwort As Integer Dim Result As Boolean Dim DirName As String Dim DiskNr As String Dim DriveType As Integer ' Laufwerkstyp DriveType = GetDriveType(Left$(ZielLW, 2)) Result = False If DriveType = DiskDrive Then ' Aufforderung: Diskette einlegen ZielLW = Left$(ZielLW, 2) antwort = MsgBox("Bitte legen Sie die Backup-Diskette Nr. " + _ Mid$(Str$(AktDisk), 2) + " in Laufwerk " + ZielLW + " ein.", 49, Titel) Else ' Festplattensicherung: Backup-Satz auswählen ZielLW = Left$(ZielLW, 2) + hdBackupPath AktDisk = ChooseBackup(ZielLW) If AktDisk < 1 Then antwort = 0 Result = False ElseIf AktDisk > 1 Then Result = True antwort = 2 Else antwort = 1 End If End If If antwort = 1 Then ' Prüfen, ob richtige Diskette On Local Error Resume Next Do Screen.MousePointer = 11 Err = 0 DirName = Dir(ZielLW + "\" + BackupDatei + "*", vbNormal) If Err = 76 Or Err = 71 Then antwort = MsgBox("Fehler beim Lesen von Laufwerk " + ZielLW + vbCrLf + _ vbCrLf + "Entweder ist keine Diskette eingelegt oder der Datenträger ist nicht formatiert.", 21, Titel) If antwort <> 4 Then Exit Do Else DiskNr = Format$(AktDisk, "000") If UCase$(Left$(DirName, Len(BackupDatei))) <> UCase$(BackupDatei) Then antwort = MsgBox("Auf dem Datenträger in Laufwerk " + ZielLW + _ " befinden sich keine Backup-Dateien.", 21, Titel) If antwort <> 4 Then Exit Do ElseIf UCase$(DirName) <> UCase$(BackupDatei + DiskNr) Then If DriveType <> DiskDrive Then antwort = MsgBox("Im Laufwerk " + ZielLW + _ " befinden sich keine Backup-Dateien", 48, Titel) Exit Do Else antwort = MsgBox("Falsche Disketten-Reihenfolge." + vbCrLf + _ "Im Laufwerk " + ZielLW + " befindet sich die " + _ Mid$(Str$(Val(Right$(DirName, 3))), 2) + _ ". Backup-Diskette." + vbCrLf + vbCrLf + "Bitte legen Sie jetzt die " + Mid$(Str$(AktDisk), 2) + ". Backup-Diskette ein.", _ 21, Titel) If antwort <> 4 Then Exit Do End If Else Result = True End If End If Loop Until Result <> 0 Screen.MousePointer = 0 On Local Error GoTo 0 End If InsertBackupDisk = Result End Function Private Function ChooseBackup(ZielLW As String) As Integer ' Dialog zum Auswählen des Backup-Satzes anzeigen Dim AktDisk As Integer Dim dummy As String AktDisk = 1 Load RestoreBackupBox With RestoreBackupBox .InitMain ZielLW .Show 1 dummy = .Tag If dummy <> "" Then AktDisk = Val(Right$(dummy, 3)) Else AktDisk = 0 End If End With Unload RestoreBackupBox Me.Refresh ChooseBackup = AktDisk End FunctionMit Hilfe der Funktion GetDriveType ermitteln wir den Datenträgertyp des Quell-Laufwerks. Handelt es sich um einen Wechseldatenträger (Diskette, ZIP-Laufwerk), so fordern wir den Anwender auf, die entsprechende Sicherungsdiskette einzulegen. Handelt es sich hingegen um ein Festplatten-Laufwerk, so blenden wir den Dialog zur Auswahl des wiederherzustellenden Backup-Satzes ein. Im Anschluß daran müssen wir einige wichtige Prüfungen vornehmen. Gerade bei der Diskettensicherung ist es ganz wichtig, daß die korrekte Diskette eingelegt wurde. Dies überprüfen wir anhand der Dateiendung der vorhandenen Backup-Datei (die Backup-Dateien der jeweiligen Disketten haben die Endung .001, .002, usw.). Private Function GetPathFromFile(ByVal File As String) As String ' Pfad ermitteln Dim Pfad As String Pfad = File While Right$(Pfad, 1) <> "\" And Right$(Pfad, 1) <> ":" And Pfad <> "" Pfad = Left$(Pfad, Len(Pfad) - 1) Wend GetPathFromFile = Pfad End FunctionDie Funktion GetPathFromFile liefert uns die reine Pfadangabe aus einem kompletten Dateinamen - also ohne den Dateinamen selbst. Private Sub OpenBackupDatei(F As Integer, AktDisk As Integer, _ ZielLW, NextDisk As Boolean, Optional AnzDat As Variant, _ Optional MaxBackupSize As Variant) ' Backup-Datei öffnen Dim BackupHead As BackupKopf Dim DiskNr As String Dim RootLen As Integer Dim RootPath As String DiskNr = Format$(AktDisk, "000") F = FreeFile Close #F: Open ZielLW + "\" + BackupDatei + DiskNr For Binary As #F Get #F, , BackupHead NextDisk = BackupHead.NextDisk If Not IsMissing(AnzDat) Then AnzDat = BackupHead.AnzFiles If Not IsMissing(MaxBackupSize) Then MaxBackupSize = BackupHead.MaxFileSize End SubDie OpenBackupDatei-Prozedur öffnet die Backup-Datei, in welcher die zu sichernden Datendateien zusammengefasst gespeichert sind. Über die optionalen Parameterangaben AnzDat und MaxBackupSize werden die entsprechenden Informationen zurückgegeben (Gesamtanzahl Dateien und Gesamt-Backup-Größe). Diese Informationen benötigen wir nur bei der ersten Sicherungsdiskette - deswegen sind die Parameter auch optional. Private Sub ReadBackupFileInfo(F, BackupFile As BackupDaten) ' File-Informationen lesen Dim iFile As FileInfo Dim iSize As FileSize Dim dummy As String Dim FileSize As Long Dim DiskSize As Long Dim Split As Boolean Get #F, , iFile dummy = Space$(iFile.FileLen) Get #F, , dummy Get #F, , iSize BackupFile.FileLen = Len(dummy) BackupFile.FileName = dummy BackupFile.FileSize = iSize.FileSize BackupFile.DiskSize = iSize.DiskSize BackupFile.Date = iSize.Date BackupFile.Time = iSize.Time BackupFile.Split = iSize.Split End SubDie Prozedur ReadBackupFileInfo ermittelt alle notwendigen Datei-Informationen für die wiederherzustellende Datei. Diese Informationen werden für die Aktualisierung der Fortschrittsanzeige und für das Setzen der Datums- und Zeitangaben benötigt. Private Function ReadFileTime(ByVal lpFilename As String, _ tCreation As Date, tLastAccess As Date, tLastWrite As Date) As Boolean ' Datum/Zeitwert einer Datei ermitteln Dim fHandle As Long Dim ftCreation As FileTime Dim ftLastAccess As FileTime Dim ftLastWrite As FileTime Dim LocalFileTime As FileTime Dim LocalSystemTime As SYSTEMTIME ReadFileTime = False fHandle = CreateFile(lpFilename, GENERIC_READ, 0, 0, OPEN_EXISTING, 0, 0) If fHandle <> 0 Then ' Zeitinformationen auslesen If GetFileTime(fHandle, ftCreation, ftLastAccess, ftLastWrite) <> 0 Then ' Erstellungsdatum FileTimeToLocalFileTime ftCreation, LocalFileTime FileTimeToSystemTime LocalFileTime, LocalSystemTime With LocalSystemTime tCreation = CDate(Format$(.wDay) & "." & Format$(.wMonth) & "." & _ Format$(.wYear) & " " & Format$(.wHour) & ":" & Format$(.wMinute, "00") & _ ":" & Format$(.wSecond, "00")) End With ' Letzter Zugriff FileTimeToLocalFileTime ftLastAccess, LocalFileTime FileTimeToSystemTime LocalFileTime, LocalSystemTime With LocalSystemTime tLastAccess = CDate(Format$(.wDay) & "." & Format$(.wMonth) & "." & _ Format$(.wYear) & " " & Format$(.wHour) & ":" & Format$(.wMinute, "00") & _ ":" & Format$(.wSecond, "00")) End With ' Letzte Änderung FileTimeToLocalFileTime ftLastWrite, LocalFileTime FileTimeToSystemTime LocalFileTime, LocalSystemTime With LocalSystemTime tLastWrite = CDate(Format$(.wDay) & "." & Format$(.wMonth) & "." & _ Format$(.wYear) & " " & Format$(.wHour) & ":" & Format$(.wMinute, "00") & _ ":" & Format$(.wSecond, "00")) End With ReadFileTime = True End If CloseHandle fHandle End If End Function Private Function WriteFileTime(ByVal lpFilename As String, _ ByVal tCreation As Date, ByVal tLastAccess As Date, _ ByVal tLastWrite As Date) As Boolean ' Datum/Zeitwert einer Datei setzen Dim fHandle As Long Dim ftCreation As FileTime Dim ftLastAccess As FileTime Dim ftLastWrite As FileTime Dim LocalFileTime As FileTime Dim LocalSystemTime As SYSTEMTIME WriteFileTime = False fHandle = CreateFile(lpFilename, GENERIC_WRITE, 0, 0, OPEN_EXISTING, 0, 0) If fHandle <> 0 Then ' Erstellungsdatum With LocalSystemTime .wDay = Day(tCreation) .wDayOfWeek = Weekday(tCreation) .wMonth = Month(tCreation) .wYear = Year(tCreation) .wHour = Hour(tCreation) .wMinute = Minute(tCreation) .wSecond = Second(tCreation) End With SystemTimeToFileTime LocalSystemTime, LocalFileTime LocalFileTimeToFileTime LocalFileTime, ftCreation ' Letzter Zugriff With LocalSystemTime .wDay = Day(tLastAccess) .wDayOfWeek = Weekday(tLastAccess) .wMonth = Month(tLastAccess) .wYear = Year(tLastAccess) .wHour = Hour(tLastAccess) .wMinute = Minute(tLastAccess) .wSecond = Second(tLastAccess) End With SystemTimeToFileTime LocalSystemTime, LocalFileTime LocalFileTimeToFileTime LocalFileTime, ftLastAccess ' Letzte Änderung With LocalSystemTime .wDay = Day(tLastWrite) .wDayOfWeek = Weekday(tLastWrite) .wMonth = Month(tLastWrite) .wYear = Year(tLastWrite) .wHour = Hour(tLastWrite) .wMinute = Minute(tLastWrite) .wSecond = Second(tLastWrite) End With SystemTimeToFileTime LocalSystemTime, LocalFileTime LocalFileTimeToFileTime LocalFileTime, ftLastWrite If SetFileTime(fHandle, ftCreation, ftLastAccess, ftLastWrite) <> 0 Then WriteFileTime = True End If CloseHandle fHandle End If End Function Private Sub SetDateTime(ByVal Datei As String, BackupFile As BackupDaten) ' Datum, Uhrzeit setzen Dim dummy As String * 1 Dim Datum As String Dim Zeit As String Dim F As Integer Dim Result As Boolean If FileLen(Datei) > 0 Then Dim tCreation As Date Dim tLastAccess As Date Dim tLastWrite As Date Result = ReadFileTime(Datei, tCreation, tLastAccess, tLastWrite) If Not Result Then Datum = Date$: Zeit = Time$ Date$ = Mid$(BackupFile.Date, 4, 2) + "-" + Left$(BackupFile.Date, 2) + _ "-" + Right$(BackupFile.Date, 4) Time$ = BackupFile.Time F = FreeFile Close #F: Open Datei For Binary As #F Get #F, , dummy Seek #F, 1 Put #F, , dummy Close #F Date$ = Datum Time$ = Zeit Else tLastWrite = CDate(BackupFile.Date + " " + BackupFile.Time) WriteFileTime Datei, tCreation, tLastAccess, tLastWrite End If End If End SubDie Funktion SetDateTime übernimmt das Ändern der Datums- und Zeitangaben für eine bestimmte Datei. Innerhalb dieser Prozedur werden die beiden Prozeduren ReadFileTime und WriteFileTime aufgerufen. Erstere ermittelt alle gespeicherten Datums- und Zeitangaben der Datei. Hierzu gehören das Datum der Dateierstellung, des letzten Zugriffes und der letzten Dateiänderung. Über die zweite Prozedur (WriteFileTime) lassen sich die modifizierten Datums- und Zeitangaben speichern. Konnten die Datums- und Zeitangaben mit Hilfe der ReadFileTime-Prozedur nicht ermittelt werden, so verwenden wir einen kleinen Trick, um das Datum dennoch ändern zu können. Hierzu merken wir uns das aktuelle Datum und die aktuelle Uhrzeit, setzen dann das Datum und die Uhrzeit auf die entsprechenden Werte zurück, öffnen die Datei im Binärmodus, lesen das erste Byte und speichern diese sofort wieder zurück. Im Anschluß daran setzen wir das Datum und die Uhrzeit wieder auf die aktuellen Werte. Private Sub ShowProzent(Status As Control, ByVal AktDat As Long, _ ByVal AnzDat As Long) ' Status-Anzeige Dim Proz As Integer Proz = Int(AktDat / AnzDat * 100 + 0.5) If Proz < 0 Then Proz = 0 If Proz > 100 Then Proz = 100 Status.Caption = String$(Val(Status.Tag) / 100 * Proz + 0.5, "n") End SubDie Prozedur ShowProzent rufen wir immer dann auf, wenn die Fortschritts-Balken aktualisiert werden müssen. So das war der zweite Teil unseres Workshops. Zum Abschluß noch der Quellcode zum "Ausprobieren" der Wiederherstellungsfunktion: Public Sub Main() ' Hauptprozedur Dim DatenPath As String Dim StartPath As String Dim Action As Integer StartPath = App.Path + IIf(Right$(App.Path, 1) <> "\", "\", "") DatenPath = StartPath IniFile = StartPath & "\BackupDemo.ini" Action = 2 ' 1 = Backup erstellen ' 2 = Dateien wiederherstellen (Restore) If Action = 1 Then Load BackupBox BackupBox.InitMain DatenPath, "" BackupBox.Show 1 Unload BackupBox ElseIf Action = 2 Then Load RestoreBox RestoreBox.Tag = DatenPath RestoreBox.Show 1 Unload RestoreBox End If End End SubIm dritten Teil unseres Workshops werden wir dann die gesamte Datensicherungs- und Wiederherstellungs-Routinen in eine ActiveX-DLL verpacken, so daß Sie diese universell in Ihre bestehenden Anwendungen einbinden können. Dieser Workshop wurde bereits 10.834 mal aufgerufen.
Anzeige
Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats September 2024 Dieter Otter Übergabeparameter: String oder Array? Mit der IsArray-Funktion lässt sich prüfen, ob es sich bei einem Übergabeparameter an eine Prozedur um ein Array oder einer "einfachen" Variable handelt. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
|||||||||||||||||||||||||||||||||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |