'Formular zum Download der Ambulanz-Datenbank vom Server, Synchronisieren der 
' Dateien und
'Zurückspielen der Datenbank auf den Server. Die Synchronisation erfolgt mit 
' Hilfe der Tabelle
'DBState, die den Status vor der jeweils letzten Synchronisation speichert.
 
Option Explicit
Dim.....
 
'Kopieren der lokalen Datenbank, löschen des Originals, Datenbank vom Server 
' holen
Private Sub cmd_TransferStart_Click()
connApp.Close                               'Verbindung zur Datenbank schließen 
' um Kopiervorgang zu ermöglichen
'On Error Resume Next
Inet1.Execute , "GET /db/Ambulanz.mdb C:\Programme\Ambulanz\AmbulanzServ.mdb"
Text1.Text = Text1.Text & vbCrLf & "Datenbank wird kopiert"
Screen.MousePointer = vbHourglass                               'Mauszeiger auf 
' Stundenglas setzen
    Do
        DoEvents
    Loop Until Not Inet1.StillExecuting
 
fso.DeleteFile fil1
Set fil1 = fso.GetFile("c:\Programme\Ambulanz\AmbulanzServ.mdb")
fso.CopyFile fil1, "C:\Programme\Ambulanz\Ambulanz.mdb"
Text1.Text = Text1.Text & vbCrLf & "Datenbank wird aktualisiert"
connApp.Open                                                    'Verbindung zur 
' Datenbank wieder öffnen
DBCheck                                                         'Funktion: 
' Datenbanken abgleichen
DoEvents
DBStateWrite                                                    'Funktion: 
' Aktuellen Status speichern
DoEvents
CopyDBLocToDBServ                                               'Funktion: 
' Lokale Datenbank wieder auf Server kopieren
End Sub
'Formular laden, verbindung zur Datenbak herstellen, Neuen Eintrag in Tabelle 
' DBState erzugen, der den
'aktuellen Status der von Veränderungen betroffenen Tabellen speichert.
 
Private Sub Form_Load()
strConnDBCopy = "C:\Programme\Ambulanz\AmbulanzCopy.mdb"                _
  'Datenbank kopieren
 
Set fil1 = fso.GetFile("c:\Programme\Ambulanz\Ambulanz.mdb")
fso.CopyFile fil1, strConnDBCopy
 
'On Error Resume Next
With Inet1                              'ftp-Verbindung zum Server herstellen
    .RemoteHost = "Account.Server.de"
    .UserName = "User"
    .Password = "Password"
    .Protocol = icFTP
    .RequestTimeout = 120
    .Execute , "DIR"
End With
 
'........
End Sub
 
'Statuswerte auslesen
Private Sub Inet1_StateChanged(ByVal State As Integer)
'.....
End Sub
 
'Daten aus Tabellen auslesen und ID-Werte in Tabelle rsDBState speichern
Function DBStateWrite()
'.....
End Function
 
'Internet-datenbank und lokale Datenbank abgleichen. Die Daten, die über as 
' Internet aktualisiert wurden
'sind mit dem Erstezen der Master-Datenbank durch die Internet-datenbank 
' automatisch vorhanden. Die Funktion
'überträgt nun die lokal veränderten Daten in die Master-Datenbank. 
' Anschließend werden die Stati aller
'Therapieplätze abgeglichen und aktualisiert.
Function DBCheck()                                          'Datenbanken 
' synchronisieren
'.....
End Function
 
'Lokale aktualisierte Datenbank auf Server kopieren.
Function CopyDBLocToDBServ()
Inet1.Execute , "DELETE /db/Ambulanz.mdb"
Text1.Text = Text1.Text & vbCrLf & "Datenbank auf Server wird gelöscht"
    Do                                          'Warteschleife
       DoEvents
   Loop Until Not Inet1.StillExecuting
Text1.Text = Text1.Text & vbCrLf & "Aktualisierte Datenbank wird übertragen"
 
 
Inet1.Execute , "PUT C:\Programme\Ambulanz\Ambulanz.mdb /db/Ambulanz.mdb"
    Do                                          'Warteschleife
        DoEvents
    Loop Until Not Inet1.StillExecuting
Screen.MousePointer = vbDefault
Text1.Text = "Aktualisierung abgeschlossen"
Inet1.Execute , "Quit"
fso.DeleteFile fil1                             'Kopie von Server auf Client 
' löschen
 
Unload Me
End Function