HOME TIPPS & TRICKS BEFEHLSREFERENZ API-REFERENZ FAQ FORUM DOWNLOAD TOOLBESPRECHUNG BÜCHERECKE MARKETPLACE GRAFIK & DESIGN VB-SEITEN

Partnerseiten
Top 5 Partnerlinks







Weitere...

Entwickler / Welt

··· Workshops · Dialoge/Dateien

Daten sichern und wiederherstellen mit Visual-Basic 5/6 Teil 1 Im ersten Teil unseres Workshop zur Datensicherung und Wiederherstellung werden alle benötigten Formulare und Prozeduren erstellt, um alle Dateien eines bestimmten Ordners in eine einzige Backup-Datei entweder auf Festplatte oder auf Diskette zu sichern.
Autor:  Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  14.840

Eine wichtige Funktion in einem Anwendungsprogramm stellt für die Käufer eine ordentlich funktionierende und einfach zu handhabende Datensicherungs- und Wiederherstellungsfunktion dar. In unserem Workshop werden wir - Schritt für Schritt - eine solche Programmfunktion ausarbeiten, so daß Sie den fertigen Code sofort in Ihre eigenen Anwendungen übernehmen können.

Warum eine eigene Datensicherungsfunktion integrieren?
Für das Bereitstellen einer eigenen Datensicherungsfunktion sprechen mindestens zwei Gründe:

• Versetzen Sie sich einmal in die Lage eines normalen Durchschnittsanwenders. Dieser schaltet den Computer ein, startet die Anwendung und arbeitet dann mit dem Programm. Von Zeit zu Zeit möchte er natürlich eine Datensicherung seiner wertvollen Daten erstellen. Ist in der Anwendung keine eigene Datensicherungsfunktion vorgesehen, wird es für ihn schon kompliziert. Welches Programm soll er verwenden? Meist wissen die Anwender gar nicht, daß Windows ein Backup-Programm bereitstellt. Und wenn doch, müssen sie sich zusätzlich in das Windows-Backup-Programm einarbeiten, da die Datensicherung nicht durch einen einfachen Mausklick erstellt wird.
   
• Ein zweiter Grund für das Integrieren einer programmeigenen Datensicherungsfunktion betrifft Sie selber. Nehmen wir an, der Anwender hat Probleme mit dem Programm oder den Daten, worauf Sie ihm mitteilen, daß Sie - um das Problem/den Fehler nachvollziehen zu können - seine Daten benötigen. Nehmen wir weiter an, der Anwender verwendet hierfür ein Backup-Programm, welches Sie selber gar nicht besitzen. Dann nützt Ihnen auch die Datensicherung des Anwenders nichts. Also sollte es auch in Ihrem Interesse liegen, eine eigene Datensicherungsfunktion bereitzustellen.

Anforderungen
Zunächst müssen wir uns Gedanken machen, wie die Datensicherungsroutine ablaufen soll. Welche Möglichkeiten sollen dem Anwender unseres Programms geboten werden?

Wir entscheiden uns für die Möglichkeit die Daten entweder in ein eigenes Verzeichnis auf die Festplatte oder auch auf ein externes Medium, wie 3,5"- oder ZIP-Diskette zu sichern. Desweiteren möchten wir, daß beim Sichern auf die Festplatte mindestens die letzten drei Sicherungskopien gespeichert bleiben. Beim Wiederherstellen/Zurücksichern einer vorhandenen Datensicherung soll der Anwender dann aus den letzten drei Sicherungskopien auswählen können.

Benötigte Formulare und Module
Für die Datensicherungsfunktion benötigen wir zwei Formulare und ein Modul, in welchem alle globalen Deklarationen und Prozeduren "abgelegt" werden.

Formular für die Auswahl des Sicherungsmediums
Fügen Sie dem Projekt ein neues Formular hinzu. Legen Sie die Eigenschaften des Formulars wie in nachfolgender Tabelle zu sehen, fest:

Name BackupLaufwerkBox BorderStyle 3 - Fester Dialog Caption Daten sichern Height 2325 Width 5700

Platzieren der benötigten Steuerelemente:
Für die Auswahl des Sicherungsmediums benötigen wir auf jeden Fall das Drive-Steuerelement und zwei CommandButton-Steuerelemente. Außerdem sollte ein kurzer Text mit dem Hinweis zur Auswahl des Laufwerks angezeigt werden. Hierzu platzieren wir ein Label-Steuerlement auf das Formular. Zusätzlich kann man für die Optik noch ein kleines Bildsymbol (Image-Element) hinzufügen.

Das fertige Formular sieht dann folgendermaßen aus:



Besonderheiten:

Command1(0)	Setzen Sie die Eigenschaft Default auf den Wert True
Command1(1)	Setzen Sie die Eigenschaft Cancel auf den Wert True

Nachdem das Formular erstellt ist, muß jetzt noch der benötigte Quellcode eingefügt werden:

Private Sub Form_Load()
  ' Initialisieren
  Dim Laufwerk As String
 
  Laufwerk = GetIniString("Backup", "Laufwerk", "A:", 255, IniFile)
  If Laufwerk = "" Then Laufwerk = "A:"
 
  On Local Error Resume Next
  Drive1.Drive = Laufwerk
  On Local Error GoTo 0
  CenterForm Me
End Sub

Anmerkungen:
Die Funktion GetIniString liest Daten aus der durch IniFile festgelegten Datei. Bei dieser Funktion handelt es sich nicht um eine Visual-Basic, sondern um eine von uns selber erstellte Funktion. Den für die Funktion hinterlegten Quellcode finden Sie im globalen Modul, welches wir im Anschluß an das Formular beschreiben. Auch der Befehl CenterForm ist kein VB-Standard Befehl, sondern eine im globalen Modul hinterlegte Prozedur.

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  ' Schließen
  If UnloadMode <> 1 Then
    Cancel = True
    Command1_Click 1
  End If
End Sub

Das 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, so simulieren wir einfach einen Klick auf die Abbrechen-Schaltfläche.

Private Sub Form_Unload(Cancel As Integer)
  ' Beenden
  Set BackupLaufwerkBox = Nothing
End Sub

Im Form_Unload-Ereignis wird durch den Befehl Set BackupLaufwerkBox = Nothing die Form vollständig aus dem Speicher entfernt.

Private Sub Command1_Click(Index As Integer)
  ' Befehlsschaltflächen OK/Abbrechen
  Select Case Index
    Case 0
      WriteIniString "Backup", "Laufwerk", _
        left$(UCase$(Drive1.Drive), 2), IniFile
      Me.Tag = left$(UCase$(Drive1.Drive), 2)
      Me.Hide
    Case 1
      Me.Tag = ""
      Me.Hide
  End Select
End Sub

Klickt der Anwender auf OK, so wird das Command1_Click-Ereignis mit Index = 0 ausgelöst. Hier wird die Auswahl des Sicherungsmediums (Laufwerk) in der INI-Datei gespeichert, so daß diese Einstellung bei einem erneuten Aufruf wieder vorgegeben werden kann. Das Speichern erfolgt mittels des WriteIniString-Befehls, welchen wir bei der Beschreibung des globalen Moduls näher erläutern werden. Über die Tag-Eigenschaft der Form wird dann das ausgewählte Laufwerk 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.

Deklarationen, Prozeduren und Funktionen im globalen Modul
Alle zusätzliche Prozeduren und Funktionen, welche wir in unserem Projekt mehrmals benötigen, speichern wir global in einem eigens hierfür vorgesehenen Modul. Fügen Sie also dem Projekt ein neues Modul hinzu.

Alle benötigten Windows-API-Funktionen, Konstanten und Datenstrukturen:

Option explicit
 
' Benötigte API-Deklarationen
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
  "WritePrivateProfileStringA" ( _
  ByVal lpApplicationName As String, _
  ByVal lpKeyName As Any, _
  ByVal lpString As Any, _
  ByVal lpFilename As String) As Long
 
Declare Function GetPrivateProfileInt Lib "kernel32" Alias _ 
  "GetPrivateProfileIntA" ( _
  ByVal lpApplicationName As String, _ 
  ByVal lpKeyName As String, 
  ByVal nDefault As Long, _
  ByVal lpFilename As String) As Long
 
Declare Function GetPrivateProfileString Lib "kernel32" Alias _ 
  "GetPrivateProfileStringA" ( _
  ByVal lpApplicationName As String, _
  ByVal lpKeyName As Any, _
  ByVal lpDefault As String, _
  ByVal lpReturnedString As String, _
  ByVal nSize As Long, _
  ByVal lpFilename As String) As Long
 
Declare Function GetDiskFreeSpace Lib "kernel32" Alias _
  "GetDiskFreeSpaceA" ( _
  ByVal lpRootPathName As String, _
  lpSectorsPerCluster As Long, _
  lpBytesPerSector As Long, _
  lpNumberOfFreeClusters As Long, _
  lpTtoalNumberOfClusters As Long) As Long
 
Declare Function GetDriveType Lib "kernel32" Alias _
  "GetDriveTypeA" ( _
  ByVal nDrive As String) As Long
 
Global Const hdBackupPath = "\Backup" 
Global Const BackupDatei = "Backup."
Global Const DiskDrive = 2
Global Const FileBlock = 16384
Global Const MaxBackupCount = 3
 
Type BackupDaten
  FileLen      As Integer
  FileName     As String
  FileSize     As Long
  DiskSize     As Long
  Date         As String * 10
  Time         As String * 5
  Split        As Boolean
End Type
 
Type BackupKopf
  AnzFiles    As Integer
  MaxFileSize As Long
  NextDisk    As Boolean
End Type
 
Global IniFile As String

Die ersten drei Deklarationen (WritePrivateProfileString, GetPrivateProfileString, GetPrivateProfileInt) werden für die von uns implementierten Befehle GetIniString und WriteIniString benötigt. Die nächste Routine (GetDiskSpaceFree) verwenden wir, um den noch freien Speicherplatz eines Datenträgers zu ermitteln. Mit Hilfe der GetDriveType-Funktion können wir den Laufwerkstyp abfragen (Festplatte, Wechseldatenträger, etc.).

Die Konstante hdBackupPath legt das Verzeichnis für eine Festplatten-Datensicherung fest, BackupDatei den Dateinamen für die Sicherungsdatei. Die Konstante DiskDrive verwenden wir in Zusammenhang mit der GetDriveType-Funktion und die Konstante FileBlock legt fest, wieviele Bytes auf einmal gelesen bzw. geschrieben werden sollen. Die Konstante MaxBackupCount legt fest, wieviele Datensicherungen maximal gespeichert bleiben und findet nur beim Sichern der Daten auf die Festplatte Berücksichtigung.

Die beiden Datenstrukturen BackupDaten und BackupKopf benötigen wir für das Schreiben und Lesen der Datensicherungs-Informationen.

Public Sub CenterForm(F As Object)
  ' Fenster zentrieren
  F.left = Screen.Width / 2 - F.Width / 2
  F.top = Screen.Height / 2 - F.Height / 2
End Sub

Die Prozedur CenterForm zentriert ein beliebiges Objekt auf dem Bildschirm. Wir verwenden diese Prozedur, um die Dialogfenster für die Datensicherung und Rücksicherung mittig auf dem Desktop anzuzeigen.

Public Function FileExists(ByVal File As String) As Boolean
  ' Prüfen, ob Datei vorhanden
  Dim Größe As Long
 
  On Local Error Resume Next
  Err = 0
  Größe = FileLen(File)
  FileExists = (Err = 0)
  On Local Error GoTo 0
End Function

Mit Hilfe der FileExists-Funktion prüfen wir, ob eine bestimmte Datei existiert oder nicht. Die Funktion gibt hier entweder True (Datei existiert) oder False (Datei existiert nicht) zurück.

Public Function GetDiskFree(ByVal strDrive As String) _
  As Long
  ' Freier Disk/Festplatten-Speicher
  Dim strCurDrive As String
  Dim lDiskFree As Long
 
  On Error Resume Next
  strDrive = UCase$(strDrive)
  strCurDrive = UCase$(left$(CurDir$, 2))
  If InStr(strDrive, ":") = 0 Or Len(strDrive) > 2 Then
    strDrive = left$(strDrive, 1) & ":"
  End If
  ChDrive strDrive
  If Err <> 0 Or (strDrive <> UCase$(left$(CurDir$, 2))) Then
    lDiskFree = -1
  Else
    Dim lRet As Long
    Dim lBytes As Long, lSect As Long
	Dim lClust As Long, lTot As Long
 
    Err = 0
    lRet = GetDiskFreeSpace(vbNullString, lSect, lBytes, lClust, lTot)
    lDiskFree = (lBytes * lSect) * lClust
    If Err Then lDiskFree = 2147483647
  End If
  ChDrive strCurDrive
  On Local Error GoTo 0
 
  GetDiskFree = lDiskFree
End Function

Die Funktion GetDiskFree ruft in sich die Windows-API-Funktion GetDiskFreeSpace auf und ermittelt den auf einem Datenträger noch zur Verfügung stehenden freien Speicherplatz. Der Laufwerksbuchstabe des zu prüfenden Datenträgers wird als Parameter (strDrive) übergeben. Die API-Funktion GetDiskFreeSpace ermittelt die Anzahl der Sektoren, die Anzahl der Bytes je Sektor und die freien Cluster. Daraus läßt sich dann die Gesamtanzahl freier Bytes errechnen. Bei großen Festplatten kann es vorkommen, daß die API-Funktion nicht die gewünschten Werte zurückgibt, sondern stattdessen einen Laufzeitfehler erzeugt. Dem beugen wir vor, indem wir mit On Local Error Resume Next den Fehler "abfangen" und dann den Wert 2147483647 als freien Speicherplatz annehmen.

Public Function GetIniString(ByVal Sektion As String, ByVal Titel As String, _
  ByVal Vorgabe As String, ByVal Länge As Integer, _
  ByVal IniFile As String) As String
  ' Text aus INI-Datei auslesen
  Dim Result As Integer
  Dim dummy As String
 
  Dummy = Space$(Länge + 1)
  Result = GetPrivateProfileString(Sektion, Titel, Vorgabe, _
    dummy, Länge, IniFile)
  GetIniString = left$(dummy, Result)
End Function

Die Funktion GetIniString liest einen String (Text) aus einer INI-Datei aus.

Beschreibung der Paramater:

Sektion	Gibt den Abschnitt innerhalb der INI-Datei an
Titel	Gibt die Zeile innerhalb des Abschnittes (Sektion) an
Vorgabe	Ist der Text, welcher zurückgegeben werden soll, wenn der Eintrag noch nicht in der INI-Datei gespeichert ist.
Länge	Gibt die maximale Länge des Textes an (meist 255)
IniFile	Bestimmt den Dateinamen (inkl. Pfad) der INI-Datei

Public Function GetItem(dummy As String, _
  Optional ByVal Trenn As String = vbTab) As String
  ' Teilstring aus einem String ausfiltern
  If InStr(dummy, Trenn) Then
    GetItem = Left$(dummy, InStr(dummy, Trenn) - 1)
    dummy = Mid$(dummy, InStr(dummy, Trenn) + 1)
  Else
    GetItem = dummy
    dummy = ""
  End If
End Function

Die Funktion GetItem zerlegt eine Textstring in zwei Teile und gibt den linken Teilstring zurück. Das Trennzeichen der beiden Teilstrings kann optional als Parameter übergeben werden. Erfolgt keine Angabe wird als Trennzeichen das Tabulator-Zeichen [Chr$(9)] verwendet.

Public Sub KillFile(ByVal Datei As String)
  ' Datei löschen und ggf. Fehler übergehen
  On Local Error Resume Next
  Kill Datei
  On Local Error GoTo 0
End Sub

Die Prozedur KillFile löscht die im Parameter Datei angegebene Datei und übergeht hierbei alle ggf. auftretenden Fehler.

Public Function MakePath(ByVal Verz As String) As Boolean
  ' Verzeichnis erstellen
  Dim Success As Boolean
  Dim dummy As String
  Dim Entry As String
 
  Err = 0
  Success = True
  dummy = "": Entry = Verz
  On Local Error Resume Next
  While Len(Entry) > 0 And Success = True
    If left$(Entry, 1) = "\" Then
      dummy = dummy + "\"
      Entry = Mid$(Entry, 2)
    ElseIf Mid$(Entry, 2, 2) = ":\" Then
      dummy = dummy + left$(Entry, 3)
      Entry = Mid$(Entry, 4)
    End If
    While left$(Entry, 1) <> "\" And Len(Entry) > 0
      dummy = dummy + left$(Entry, 1)
      Entry = Mid$(Entry, 2)
    Wend
    Err = 0
    MkDir dummy
    If Err <> 75 And Err <> 0 Then Success = False
  Wend
  On Local Error GoTo 0
 
  MakePath = Success
End Function

Die Funktion MakePath prüft, ob ein bestimmtes Verzeichnis existiert. Ist dies nicht der Fall wird versucht, das Verzeichnis zu erstellen. Existierte das Verzeichnis bereits oder konnte es erstellt werden, wird der Wert True zurückgegeben, andernfalls False.

Public Sub WriteIniString(ByVal Sektion As String, _
  ByVal Titel As String, ByVal IniString As String, _
  ByVal IniFile As String)
  ' String in INI-Datei schreiben
  Dim Result As Integer
 
  Result = WritePrivateProfileString(Sektion, Titel, IniString, IniFile)
End Sub

Mit Hilfe der Prozedur WriteIniString lassen sich Einträge in einer INI-Datei speichern. Die einzelnen Parameter haben wir bereits bei der Funktion GetIniString beschrieben.

Hauptformular für die Datensicherung
Während der Durchführung der Datensicherung wollen wir dem Anwender den Fortschritt in Form von Balkendiagrammen und Zeitangaben anzeigen. Fügen Sie dem Projekt ein neues Formular hinzu und legen Sie die Eigenschaften des Formulars wie in nachfolgender Tabelle zu sehen, fest:

Name BackupBox BorderStyle 3 - Fester Dialog Caption Daten sichern Height 4845 ShowInTaskbar True Width 4680 Auf dieser Form plazieren Sie bitte alle in der nächsten Abbildung gezeigten Elemente. Hierbei handelt es sich hauptsächlich um Label-Steuerelemente, da ja in erster Linie nur der Fortschritt der Datensicherung mitgeteilt werden soll.

Das fertige Formular sollte dann folgendermaßen aussehen:



Besonderheiten:

LabelStatus

Setzen Sie die Font-Eigenschaft der beiden LabelStatus-Elemente auf Wingdings, Größe 9, Attribut Fett und die BorderStyle-Eigenschaft auf 1 - Fest Einfach. Geben Sie für Caption 19 x das kleine n ein und tragen Sie für die Tag-Eigenschaft die Zahl 19 ein. Auf diese Weise wird das Standard Statusbar-Element von Visual-Basic nachgebildet, ohne auf die externe Datei COMCTL32.OCX zurückgreifen zu müssen.

Timer1

Stellen Sie die Interval-Eigenschaft auf 500. Das bedeutet, daß das Timer1_Timer-Ereignis alle halbe Sekunde ausgelöst wird. Setzen Sie weiterhin die Enabled-Eigenschaft auf den Wert False.

Plazieren Sie zusätzlich noch zwei List-Steuerelemente auf die Form und setzen deren Visible-Eigenshaft auf False. Nennen Sie die beiden Steuerelemente Liste und List1 und setzen die Sorted-Eigenschaft von List1 auf True.

Quellcode für die Datensicherungsroutine:

Option explicit
 
Dim Abbruch As Integer
Dim Titel As String
Dim StartZeit As Variant
 
Private Declare Function SetVolumeLabel Lib "kernel32" Alias _
  "SetVolumeLabelA" ( _
  ByVal lpRootPathName As String, _
  ByVal lpVolumeName As String) As Long

Mit Hilfe der Windows-API-Funktion SetVolumeLabel läßt sich die Datenträgerbezeichnung ändern. Wir verwenden diese Funktion, wenn die Datensicherung auf ein externes Medium, wie 3,5"-Diskette erfolgen soll.

Public Sub InitMain(ByVal Pfad As String, _
  ByVal SubOrdner As String)
  ' Initialisieren
  Me.Tag = Pfad + Chr$(9) + SubOrdner
End Sub

Bei der InitMain-Prozedur handelt es sich um die Startprozedur für das Erstellen der Datensicherung. Der Parameter Pfad gibt das Verzeichnis an, dessen Ordner und Dateien gesichert werden sollen. Möchten Sie nur ein einzelnes Unterverzeichnis sichern, so können Sie dieses im Parameter SubOrdner angeben, andernfalls übergeben Sie der Prozedur hier einen Leerstring (""). Die beiden Parameter werden in der Tag-Eigenschaft der Form zwischengespeichert und im Form_Activate-Ereignis ausgelesen.

Private Sub Form_Load()
  ' Formular positioniern
  CenterForm Me
  Titel = "Daten sichern"
End Sub

Das 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()
  ' Backup-Routine aufrufen
  Dim Pfad As String
  Dim Ordner As String
 
  Me.Refresh
  If Me.Tag <> "" Then
    Ordner = Me.Tag
    Pfad = GetItem(Ordner)
    Me.Tag = ""
    MakeBackup Pfad, Ordner
  End If
  Screen.MousePointer = 0
End Sub

Das 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 werden die Pfadangaben zur Datensicherung aus der Tag-Eigenschaft ausgelesen und anschließend die Prozedur MakeBackup 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 MakeBackup-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 Sub

Das 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 BackupBox = Nothing
End Sub

Im Form_Unload-Ereignis wird durch den Befehl Set BackupBox = 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 Sub

Der Anwender hat die Möglichkeit den Sicherungsvorgang 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 MakeBackup-Prozedur mitzuteilen, daß der Vorgang abgebrochen werden soll (innerhalb der MakeBackup-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 Sub

Das Timer1_Timer-Ereignis wird jede halbe Sekunde ausgelöst, damit wir die bereits verstrichene Zeit im Dialogfenster anzeigen können.

Private Sub MakeBackup(ByVal Pfad As String, _
  ByVal SubOrdner As String)
  ' Sichern
  Dim BackupFile As BackupDaten
 
  Dim DirName As String
  Dim AktDir As Long
  Dim AnzDir As Long
  Dim Verz As String
  Dim F As Integer
  Dim N As Integer
  Dim AktDisk As Integer
  Dim antwort As Integer
  Dim AnzDat As Long
  Dim AktDat As Long
  Dim dummy As String
  Dim File As String
  Dim FileSize As Long
  Dim DiskSize As Long
  Dim AktSize As Long
  Dim ReadSize As Long
  Dim DiskFreeSize As Long
  Dim MaxBackupSize As Long
  Dim AktBackupSize As Long
  Dim AnzDisks As Integer
  Dim Result As Integer
  Dim ZielLW As String
  Dim DriveType As Integer
 
  ' Sicherungsmedium auswählen  
  Load BackupLaufwerkBox
  With BackupLaufwerkBox
    If SubOrdner <> "\" And SubOrdner <> "" Then
      .Text1 = "\" + SubOrdner
    End If
    .Show 1
    ZielLW = .Tag
    SubOrdner = .Text1
  End With
  Unload BackupLaufwerkBox
  Me.Refresh
 
  ' Wenn Medium ausgewählt, zu sichernde Ordner ermitteln  
  If ZielLW <> "" Then
    Screen.MousePointer = 11
    Label1 = "Die Daten werden jetzt auf Laufwerk " + _
      ZielLW + " gesichert."
    List1.Clear: Liste.Clear
    If Right$(Pfad, 1) <> "\" Then Pfad = Pfad + "\"
    If IsMissing(DatenPath) Then DatenPath = ""
    GetAllFolders Pfad + DatenPath
    List1.AddItem Pfad + DatenPath
 
    ' Dateien + Gesamtgröße aller zu sichernden Ordner ermitteln
    MaxBackupSize = 0
    AktDir = 0: AnzDir = List1.ListCount
    Abbruch = False
    On Local Error Resume Next
    While AktDir < AnzDir And Not Abbruch
      AktDir = AktDir + 1
      Verz = List1.List(AktDir - 1)
      If Right$(Verz, 1) <> "\" Then Verz = Verz + "\"
      DirName = Dir(Verz + "*.*", vbNormal)
      While DirName <> "" And Not Abbruch
        dummy = Mid$(Verz + DirName, Len(Pfad) + 1)
        F = FreeFile
        ' Prüfen, ob Datei geöffnet werden kann und Größe ermitteln
        Do
          Result = True: Err = 0
          Close #F: Open Pfad + dummy For Binary As #F
          If Err <> 0 Then
            Result = False
            antwort = MsgBox("Fehler beim Öffnen der Datei '" + dummy + "'." + _
              vbCrLf + vbCrLf + "Zum Erstellen der Sicherungskopien muß das _
              Programm exklusiven Zugriff auf die Dateien besitzen.", 274, Titel)
            Select Case antwort
              Case 4
              Case 5
                Exit Do
              Case Else
                Abbruch = True
                Exit Do
            End Select
          End If
        Loop Until Result
        If Not Abbruch And Result Then
          AktBackupSize = LOF(F)
          If AktBackupSize > 0 Then
            MaxBackupSize = MaxBackupSize + AktBackupSize
            Liste.AddItem dummy
          End If
        End If
        Close #F      
        DirName = Dir
      Wend
    Wend
    List1.Clear
    Screen.MousePointer = 0
 
    ' Beginn Sicherungsvorgang
    If Not Abbruch Then
      AktBackupSize = 0
      AktDat = 0: AnzDat = Liste.ListCount
      If AnzDat > 0 Then
        LabelFiles(0) = Mid$(Str$(AnzDat), 2)
        LabelSize(0) = Format$(MaxBackupSize, "###,###,###")
        AktDisk = 1
        Abbruch = False
        On Local Error GoTo Backup_Error
        ' GGf. Aufforderung zum Disketten-Einlegen
        If InsertBackupDisk(AktDisk, ZielLW) Then
          StartZeit = Now
          Timer1.Enabled = True
          DiskFreeSize = GetDiskFree(ZielLW)
          ' Freien Speicherplatz prüfen
          If DiskFreeSize > -1 And DiskFreeSize < MaxBackupSize + 4096 And _
          Len(ZielLW) > 3 Then
            antwort = MsgBox("Auf dem Ziellaufwerk ist nicht genügend freier _
              Speicherplatz frei." + vbCrLf + vbCrLf + "Freier Speicherplatz: " + _
              Format$(DiskFreeSize, "###,###,###,###") + vbCrLf + _
              "Benötigter Speicherplatz: " + Format$(MaxBackupSize + 4096, _
              "###,###,###,###"), 16, Titel)
            Liste.Clear
            Screen.MousePointer = 0
            Unload Me
            Exit Sub
          End If
          ' Anzahl benötigter Disketten ermitteln
          AnzDisks = Int((MaxBackupSize + (AnzDat * 100)) / DiskFreeSize)
          If AnzDisks * DiskFreeSize < MaxBackupSize + (AnzDat * 100) Then
            AnzDisks = AnzDisks + 1
          End If
          LabelDisk(0) = Mid$(Str$(AnzDisks), 2)
 
          ' Dateikopf in Sicherungsdatei schreiben
          OpenBackupDatei F, AktDisk, ZielLW
          WriteBackupKopf F, AnzDat, MaxBackupSize, False, Pfad
          Do While AktDat < AnzDat And Not Abbruch
            AktDat = AktDat + 1
            File = Liste.List(AktDat - 1)
            LabelFiles(1) = Mid$(Str$(AktDat), 2)
            Label2 = File
            Status(0).Caption = ""
            DoEvents
 
            ' Datei öffnen + Informationen lesen
            BackupFile.Date = Format(FileDateTime(Pfad + File), "dd.mm.yyyy")
            BackupFile.Time = Format(FileDateTime(Pfad + File), "hh:mm")
            N = FreeFile
            Close #N: Open Pfad + File For Binary Shared As #N
            FileSize = LOF(N)
            DiskFreeSize = GetDiskFree(ZielLW)
            BackupFile.FileLen = Len(File)
            BackupFile.FileName = File
            BackupFile.FileSize = FileSize
            BackupFile.DiskSize = FileSize
            BackupFile.Split = False
 
            ' Wenn kein Platz mehr, neue Diskette einlegen
            If DiskFreeSize > -1 And DiskFreeSize < Len(BackupFile) Then
              GoSub Backup_NextDisk
            End If
            If Not Abbruch Then
              DiskFreeSize = DiskFreeSize - Len(BackupFile)
              If DiskFreeSize > -1 And DiskFreeSize < FileSize Then
                DiskSize = DiskFreeSize
                BackupFile.DiskSize = DiskSize
                BackupFile.Split = True
              Else
                DiskSize = FileSize
                BackupFile.Split = False
              End If
              WriteBackupFileInfo F, BackupFile
              AktSize = 0
              ' Datei auf Datenträger sichern
              Do
                If AktSize + FileBlock > DiskSize Then
                  ReadSize = DiskSize - AktSize
                Else
                  ReadSize = FileBlock
                End If
                If ReadSize > 0 Then
                  ' Fortschrittsanzeige aktualisieren
                  AktBackupSize = AktBackupSize + ReadSize
                  AktSize = AktSize + ReadSize
                  LabelSize(1) = Format$(AktBackupSize, "###,###,###")
                  ShowProzent Status(0), AktSize, FileSize
                  ShowProzent Status(1), AktBackupSize, MaxBackupSize
 
                  dummy = Space$(ReadSize)
                  Get #N, , dummy
                  Put #F, , dummy
                End If
 
                ' Evtl. Aufforderung für nächste Diskette                
                If AktSize >= DiskSize And BackupFile.Split Then
                  GoSub Backup_NextDisk
                  If Not Abbruch Then
                    DiskFreeSize = GetDiskFree(ZielLW) - Len(BackupFile)
                    If DiskFreeSize > -1 And FileSize - AktSize > DiskFreeSize Then
                      DiskSize = AktSize + DiskFreeSize
                      BackupFile.Split = True
                    Else
                      DiskSize = FileSize
                      BackupFile.Split = False
                    End If
                    BackupFile.DiskSize = DiskSize
                    WriteBackupFileInfo F, BackupFile
                  End If
                End If
                DoEvents
              Loop Until AktSize >= FileSize Or Abbruch
              Close #N
            End If
            DoEvents
          Loop
          If F > 0 Then Close #F
        Else
          Abbruch = True
        End If
 
        ' Sicherungsvorgang beendet
        Timer1.Enabled = False
        If Abbruch Then
          antwort = MsgBox("Der Vorgang wurde abgebrochen.", 48, Titel)
        Else
          ' Laufwerkstyp
          DriveType = GetDriveType(ZielLW)
          If DriveType = DiskDrive Then
            antwort = MsgBox("Die Datensicherung wurde erfolgreich durchgeführt." + _
            vbCrLf + vbCrLf + _
            "Bitte bewahren Sie die Disketten an einem sicheren Ort auf.", 64, Titel)
          Else
            antwort = MsgBox("Die Datensicherung wurde erfolgreich durchgeführt.", _
              64, Titel)
          End If
        End If
        On Local Error GoTo 0
      Else
        antwort = MsgBox("Im Verzeichnis '" + Pfad + _
          "' sind keine Dateien gespeichert...", 48, Titel)
      End If
    End If
  End If
  Liste.Clear
  Screen.MousePointer = 0
  Unload Me
  Exit Sub
 
Backup_NextDisk:
  WriteBackupKopf F, AnzDat, MaxBackupSize, True, Pfad
  Close #F
  AktDisk = AktDisk + 1
  If InsertBackupDisk(AktDisk, ZielLW) Then
    LabelDisk(1) = Mid$(Str$(AktDisk), 2)
    OpenBackupDatei F, AktDisk, ZielLW
    WriteBackupKopf F, AnzDat, MaxBackupSize, False, Pfad
  Else
    Abbruch = True
  End If
Return
 
Backup_Error:
  If Not Abbruch Then
    antwort = MsgBox("Während des Sicherungvorgangs 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 Sub
 

In der MakeBackup-Prozedur läuft die eigentliche Datensicherung ab. Zunächst werden alle benötigten Variablen deklariert.

Und jetzt der Reihe nach:

• Als erstes wird das Dialogfenster zur Auswahl des Sicherungsmediums geladen und angezeigt (Load BackupLaufwerkBox). Über die Tag-Eigenschaft wird der Laufwerksbuchstabe des ausgewählten Mediums zurückgegeben. Handelt es sich um einen Leerstring (""), so hat der Anwender auf Abbrechen geklickt. In diesem Fall wird der Sicherungsvorgang nicht ausgeführt.
   
• Als nächstes werden mit Hilfe der GetAllFolders-Prozedur (diese wird im Anschluß an die MakeBackup-Prozedur beschrieben) alle zu sichernden Ordner ermittelt und dem unsichtbaren List1-Steuerelement hinzugefügt.
   
• Im dritten Abschnitt werden alle Dateien der jeweiligen Unterverzeichnisse ermittelt und dem Steuerelement Liste hinzugefügt. Hierbei wird für jede einzelne Datei geprüft, ob auf diese zugegriffen (geöffnet) werden kann. Außerdem berechnen wir den Speicherplatz, der auf dem Sicherungsmedium benötigt wird.
   
• Erfolgt die Datensicherung auf ein externes Speichermedium, fordern wir den Anwender auf eine leere formatierte Diskette einzulegen (Aufruf der Prozedur InsertBackupDisk).
   
• Bevor der eigentliche Sicherungsvorgang gestartet wird, prüfen wir noch, ob der auf dem Sicherungsmedium zur Verfügung stehende freie Speicherplatz ausreicht. Den freien Speicherplatz ermitteln wir mit Hilfe der GetDiskFree-Funktion. Erfolgt die Datensicherung auf die Festplatte und steht hier nicht genügend freier Speicherplatz zur Verfügung, so blenden wir ein entsprechendes Hinweisfenster ein.
   
• Jetzt beginnen wir mit dem Sicherungsvorgang. Mit Hilfe einer Do...Loop - Schleife werden die einzelnen Dateien in eine einzige große Backup-Datei zusammengefasst gespeichert. Erfolgt der Sicherungsvorgang auf Diskette, so müssen wir natürlich immer den noch freien Speicherplatz abfragen und ggf. den Anwender auffordern, die nächste Diskette einzulegen. Zu jeder Datei wird zusätzlich ein Datensatz von der Struktur BackupDaten gespeichert. In diesem Datensatz sind die Informationen, wie Datum und Uhrzeit, Dateigröße, usw. enthalten. Kann die Datei aufgrund unzureichenden Speicherplatzes nicht vollständig auf die Diskette geschrieben werden, setzen wir das Datenfeld Split auf True. Diese Information benötigen wir später in der Datenrücksicherungsroutine.
   
• Während die Dateien gesichert werden teilen wir dem Anwender den aktuellen Fortschritt in Form von Text- und Balkengrafiken mit. Somit kann der Anwender die Datensicherung ganz ganau mitverfolgen.
   
• Sind alle Dateien gesichert und wurde der Vorgang nicht abgebrochen, so blenden wir ein Hinweisfenster mit dem Text "Die Datensicherung wurde erfolgreich durchgeführt" ein.
   

Wenn Sie sich den Quellcode der MakeBackup-Routine ansehen, werden Sie noch einige unbekannte Prozeduraufrufe finden. Hierbei handelt es sich um folgende Prozeduren:

Private Sub GetAllFolders(ByVal Pfad As String)
  ' Alle Verzeichnisse ermitteln
  Dim Count As Long
  Dim I As Long
  Dim D() As String
 
  On Local Error Resume Next
  Count = GetAllSubDir(Pfad, D())
  I = 1
  Do Until I > Count
    List1.AddItem Pfad + D(I)
    GetAllFolders Pfad + D(I) + "\"
    I = I + 1
  Loop
  On Local Error GoTo 0
End Sub

Private Function GetAllSubDir(Path As String, D() As String) As Integer
  ' Unterverzeichnisse ermitteln
  Dim DirName As String
  Dim Count As Integer
 
  If right$(Path, 1) <> "\" Then Path = Path + "\"
  DirName = Dir(Path, vbDirectory)
  Count = 0
  Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      If (GetAttr(Path + DirName) And vbDirectory) = vbDirectory Then
        If (Count Mod 10) = 0 Then
          ReDim Preserve D(Count + 10) As String
        End If
        Count = Count + 1
        D(Count) = DirName
      End If
    End If
    DirName = Dir
  Loop
  GetAllSubDir = Count
End Function

Die Prozedur GetAllFolders ruft die Prozedur GetAllSubDirs auf, um alle Unterverzeichnisse eines bestimmten Ordners zu ermitteln. Da diese Unterverzeichnisse wiederum Unterverzeichnisse enthalten können, ruft die GetAllFolders-Prozedur sich für jedes der in GetAllSubDirs ermittelten Unterverzeichnisse erneut auf. Man spricht hier von einer rekursiven Funktion. Alle ermittelten Unterverzeichnisse werden dem List1-Steuerelement hinzugefügt.

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 DriveType As Integer
  Dim DiskNr As String
  Dim I As Integer
 
  ' Laufwerkstyp
  DriveType = GetDriveType(ZielLW)
 
  Result = False
  On Local Error Resume Next
  If DriveType = DiskDrive Then
    antwort = MsgBox("Bitte legen Sie die Diskette Nr. " + _
      Mid$(Str$(AktDisk), 2) + " in Laufwerk " + ZielLW + " ein.", 49, Titel)
  Else
    ZielLW = Left$(ZielLW, 2) + hdBackupPath
    antwort = 2
    If MakePath(ZielLW) Then antwort = 1
 
    ' Evtl. vorhandene Backups umbenennen, letztes fällt raus
    If MaxBackupCount > 1 Then
      For I = MaxBackupCount To 2 Step -1
        If FileExists(ZielLW + "\" + BackupDatei + Format$(I - 1, "000")) Then
          KillFile ZielLW + "\" + BackupDatei + Format$(I, "000")
          Name ZielLW + "\" + BackupDatei + Format$(I - 1, "000") As _
            ZielLW + "\" + BackupDatei + Format$(I, "000")
        End If
      Next I
      KillFile ZielLW + "\" + BackupDatei + "001"
    End If
  End If
  If antwort = 1 Then
    ' Prüfen, ob Diskette leer
    Do
      Screen.MousePointer = 11
      Err = 0
      DirName = Dir(ZielLW + "\*.*", 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
        Result = True
        If DirName <> "" And MaxBackupCount < 2 Then
          antwort = MsgBox("Auf dem Datenträger in Laufwerk " + ZielLW + _
            " befinden sich bereits Dateien. Sollen die vorhandenen Dateien _
            jetzt gelöscht werden?", 35, Titel)
          Select Case antwort
            Case 6
              Err = 0
              Kill ZielLW + "\*.*"
              If Err <> 0 Then
                antwort = MsgBox("Beim Löschen der Dateien ist ein Fehler _
                aufgetreten." + vbCrLf + vbCrLf + "Fehler " + _
                Mid$(Str$(Err), 2) + vbCrLf + Error + vbCrLf + vbCrLf + _
                "Bitte legen Sie jetzt eine neue formatierte Diskette in _
                das Laufwerk " + ZielLW, 49, Titel)
                Result = False
                If antwort <> 1 Then Exit Do
              End If
            Case 7
              antwort = MsgBox("Bitte legen Sie jetzt eine neue Diskette ein.", _
                49, Titel)
              Result = False
              If antwort <> 1 Then Exit Do
            Case Else
              Result = False
              Exit Do
          End Select
        End If
      End If
    Loop Until Result
 
    ' Volume-Label
    If Result And DriveType = DiskDrive Then
      DiskNr = Mid$(Str$(AktDisk), 2)
      While Len(DiskNr) < 3: DiskNr = "0" + DiskNr: Wend
      Result = SetVolumeLabel(ZielLW + "\", "BACKUP" + DiskNr)
      Result = True
    End If
 
    Screen.MousePointer = 0
  End If
 
  On Local Error GoTo 0
  InsertBackupDisk = Result
End Function

Erfolgt die Datensicherung auf Disketten, wird der Anwender auf das Einlegen einer leeren formatierten Diskette hingewiesen. Erfolgt die Datensicherung auf die Festplatte, wird das älteste Backup gelöscht, und die anderen vorhandenen Backups umbenannt, so daß immer die letzten X Backups gespeichert bleiben. Die Anzahl der Backup-Sätze haben wir im globalen Modul und der Variable MaxBackupCount auf 3 festgelegt. Im Anschluß daran wird geprüft, ob sich noch Daten auf dem Sicherungsmedium befinden und ggf. ein Hinweis angezeigt. Bei der Sicherung azf Disketten wird noch mit Hilfe der Windows-API SetVolumeLabel die Datenträgerbezeichnung geändert.

Private Sub OpenBackupDatei(F As Integer, AktDisk As Integer, ZielLW As String)
  ' Backup-Datei Öffnen
  Dim DiskNr As String
 
  DiskNr = Mid$(Str$(AktDisk), 2)
  While Len(DiskNr) < 3: DiskNr = "0" + DiskNr: Wend
  F = FreeFile
  Close #F: Open ZielLW + "\" + BackupDatei + DiskNr For Binary As #F
End Sub

Die OpenBackupDatei-Prozedur erstellt die Backup-Datei, in welcher die zu sichernden Datendateien zusammengefasst gespeichert werden sollen.

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 Sub

Die Prozedur ShowProzent dient zum Aktualisieren der grafischen Statusanzeige.

Private Sub WriteBackupFileInfo(F As Integer, BackupFile As BackupDaten)
  ' Datei-Informationen schreiben
  Put #F, , BackupFile.FileLen
  Put #F, , BackupFile.FileName
  Put #F, , BackupFile.FileSize
  Put #F, , BackupFile.DiskSize
  Put #F, , BackupFile.Date
  Put #F, , BackupFile.Time
  Put #F, , BackupFile.Split
End Sub

In der WriteBackupFileInfo-Prozedur erfolgt das "Schreiben" der Datei-Informationen. Diese Informationen werden für die spätere Rücksicherung benötigt.

Private Sub WriteBackupKopf(F As Integer, AnzDat As Long, MaxBackupSize As Long, _
  NextDisk As Boolean, Pfad As String)
  ' Backup-Kopf
  Dim BackupHead As BackupKopf
 
  BackupHead.AnzFiles = AnzDat
  BackupHead.MaxFileSize = MaxBackupSize
  BackupHead.NextDisk = NextDisk
  Seek #F, 1
  Put #F, , BackupHead
End Sub

Die WriteBackupKopf speichert Informationen über die Anzahl der gesicherten Dateien und die Gesamtgröße des Sicherungssatzes. Das Datenfeld BackupHead.NextDisk ist für die Datenrücksicherung von ganz großer Bedeutung, da hier festgehalt wird, ob für die Datensicherung weitere Disketten benötigt wurden.

So das war der 1. Teil unseres Workshops. Zum Abschluß noch der Quellcode zum "Ausprobieren" der Datensicherungsfunktion:

Sub Main()
  Dim DatenPath As String
  Dim StartPath As String
 
  StartPath = App.Path + IIf(Right$(App.Path, 1) <> "\", "\", "")
  DatenPath = StartPath
 
  IniFile = StartPath & "\BackupDemo.ini"
  Load BackupBox
  BackupBox.InitMain DatenPath, ""
  BackupBox.Show 1
  Unload BackupBox
  End
End Sub

Legen Sie jetzt noch die Sub Main - Prozedur als Startobjekt fest. Diese Einstellung können Sie in den Projekt-Eigenschaften vornehmen (Menü Projekt - Eigenschaften...).

Im zweiten Teil unseres Workshops werden wir dann die Daten-Wiederherstellungs-Routine entwickeln.

 

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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel