'---------------------------------------------------------------------------------------
' Modul     : mdlBackendUpdate
' Autor     : Günter Gerold
' Datum     : 20.01.2008
' Abh?ngigkeiten : Die Klasse clsCommonDialog von Karsten Pries wird benötigt, mdlErrorHandler
' Text      : Die Version des Backends wird geprüft, wenn nötig Felder und Tabellen
'             hinzugefügt.
'             Dazu sind erstmal 2 Informationen nötig. Zum Einen die erwartete Versionsnummer
'             des Backends. Diese wird aus dem ersten Datensatz der Tabelle cFrontendsettingsTabelle
'             aus dem Feld cFrontendsettingsfldBackendKey geholt.
'             Die tatsächliche Backendversionsnummer kommt aus der Tabelle cBackendsettingsTabelle,
'             Feld cBackendsettingsfldKey.
'             Die Versionsnummern werden verglichen und gegebenenfalls ein Update gestartet.
'             Die eigendlichen Updates werden in aufsteigender Versionsnummern-Reihenfolge
'             in der Tabelle cBackendHistoryTabelle im Frontend abgelegt
'             Die Tabelle cBackendsettingsTabelle im Backend wird
'             erzeugt, wenn sie nicht vorhanden ist und die Version "1.0.0" gesetzt
'
' Aktionen:   AddTable      fügt eine Tabelle ins Backend ein.
'             AddColumn     fügt ein Feld in die Tabelle ein
'             DropTable     löscht die Tabelle im Backend
'             DropColumn    löscht das Feld in der Tabelle
'             AlterColumn   ändert das Feld in der Tabelle
'             ConnectTable  verbindet eine neue Tabelle mit dem Frontend
'---------------------------------------------------------------------------------------

Option Compare Database
Option Explicit

'Fehlerrückgabewerte
Public Enum BackupAndUpdateResult
    bur_okay = -1
    bur_UnKownError = 0
    bur_FrontEndAktive = 1
    bur_BackEndNotFound = 2
    bur_TooMuchBackups = 3
    bur_FrontendOld = 4
    bur_SQLError = 5
End Enum

' Konstanten für clsCommonDialog
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_PATHMUSTEXIST = &H800
Const OFN_HIDEREADONLY = &H4
Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2

Private Const connectPrefixJet As String = ";DATABASE="

' Die Bezeichnungen f?r die SQL-Befehle
Private Const cAddTable = "AddTable"        'Tabelle hinzufügen
Private Const cDropTable = "DropTable"      'Tabelle löschen
Private Const cAddColumn = "AddColumn"      'Feld hinzufügen
Private Const cDropColumn = "DropColumn"    'Feld löschen
Private Const cAlterColumn = "AlterColumn"  'Feldtyp und/oder Grösse verändern
Private Const cConnectTable = "ConnectTable" 'Frontend mit Tabelle verbinden

' Der Tabellenname und die Feldnamen der Frontend-Settingstabelle im Frontend
Private Const cFrontendsettingsTabelle = "Settings"
Private Const cFrontendsettingsfldBackendKey = "BackendKey"

' Der Tabellenname und die Feldnamen der Backend-Settingstabelle im Backend
Private Const cBackendsettingsTabelle = "Settings"
Private Const cBackendsettingsfldID = "ID"
Private Const cBackendsettingsfldKey = "Key"

' Der Tabellenname und die Feldnamen der Backendhistorytabelle im Frontend
Private Const cBackendHistoryTabelle = "tblBackendHistory"
Private Const cBackupHistoryfldAction = "aktion"
Private Const cBackupHistoryfldTabelle = "Tabelle"
Private Const cBackupHistoryfldFeld = "Feld"
Private Const cBackupHistoryfldTyp = "Typ"
Private Const cBackupHistoryfldGroesse = "Groesse"
Private Const cBackupHistoryfldKey = "Key"
Private Const cBackupHistoryfldID = "ID"
Private Const cBackupHistoryfldPrimary = "Primary"
Private Const cBackupHistoryfldDone = "Done"

Private varFrontendVersion As String    'Beim ersten Abruf der Versionsnummern werden diese in den Variablen abgelegt,
Private varBackendVersion As String     ' damit nicht jedesmal die Tabelle ge?ffnet werden muss.

'---------------------------------------------------------------------------------------
' Prozedur  : getVersionNumberFromFrontend
' Autor     : Günter Gerold
' Datum     : 05.01.2008
' Text      : Holt die Versionsnummer aus der Settings-Tabelle des Frontends
'---------------------------------------------------------------------------------------
'
Private Function getVersionNumberFromFrontend() As String

      Dim rss As DAO.Recordset

10    On Error GoTo getVersionNumberFromFrontend_Error

20    Set rss = CurrentDb.OpenRecordset(cFrontendsettingsTabelle, dbOpenDynaset)
30    varFrontendVersion = rss(cFrontendsettingsfldBackendKey)
40    getVersionNumberFromFrontend = varFrontendVersion
50    rss.Close

Ausgang:
60          On Error Resume Next
70          rss.Close
80          Set rss = Nothing
90          Exit Function

getVersionNumberFromFrontend_Error:
100    Select Case Err.Number
           Case 0
110             Resume Ausgang
120        Case Else
130             Call fncErrorHandler("mdlBackendUpdate", _
    "getVersionNumberFromFrontend")
140             Resume Ausgang
150   End Select

End Function

'---------------------------------------------------------------------------------------
' Prozedur  : getVersionNumberFromBackend
' Autor     : Günter Gerold
' Datum     : 05.01.2008
' Text      : Holt die Versionsnummer aus der Settings-Tabelle des Backends
'---------------------------------------------------------------------------------------
'
Private Function getVersionNumberFromBackend(ByVal strPfad As String) As String
      Dim dbsBackend As DAO.Database
      Dim rss As DAO.Recordset

10    On Error GoTo getVersionNumberFromBackend_Error

20    Set dbsBackend = OpenDatabase(strPfad)
30    Set rss = dbsBackend.OpenRecordset(cBackendsettingsTabelle, dbOpenDynaset)

40    varBackendVersion = rss(cBackendsettingsfldKey)
50    getVersionNumberFromBackend = varBackendVersion
60    rss.Close
70    dbsBackend.Close

Ausgang:
80          On Error Resume Next
90          rss.Close
100         dbsBackend.Close
110         Set rss = Nothing
120         Set dbsBackend = Nothing
130         Exit Function

getVersionNumberFromBackend_Error:
140    Select Case Err.Number
           Case 0
150             Resume Ausgang
160        Case 3078              'Tabelle im Backend fehlt
170             createBackendSettingsTable strPfad, dbsBackend
180             Err.Clear
190             Resume
200        Case Else
210             Call fncErrorHandler("mdlBackendUpdate", _
    "getVersionNumberFromBackend")
220             Resume Ausgang
230   End Select

End Function
'---------------------------------------------------------------------------------------
' Prozedur  : checkBackendVersion
' Autor     : Günter Gerold
' Datum     : 05.01.2008
' Text      : Es wird nur aktualisiert, wenn das Frontend neuer als das Backend ist
'---------------------------------------------------------------------------------------
'
Public Function checkBackendVersion() As BackupAndUpdateResult
      Dim fd As New clsCommonDialog
      Dim strFile As String
10    With fd
20        .DialogTitle = "Backend Update"
30        .DefaultExt = "MDB"             'Standard-Endung wenn vom Benutzer nix anderes angegeben
40        .DefaultDir = "c:\"
50        .Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_READONLY
60        .MultiSelect = False
70        .Filter1Text = "Access97-2003-Dateien"
80        .Filter1Suffix = "*.mdb"
90        .Filter2Text = "Access2007-Dateien"
100       .Filter2Suffix = "*.accdb"
110       .ShowOpen                          ' oder .ShowSave
120       If fd.FileName = "" Then Exit Function   ' Abbruch durch Benutzer
130       strFile = fd.FileName
140   End With
150   On Error GoTo checkBackendVersion_Error
170   Select Case CInt(getVersionNumberFromFrontend) - _
    CInt(getVersionNumberFromBackend(strFile))
          Case Is > 0     'Updater starten
180           checkBackendVersion = BackupAndUpdate(strFile)
190       Case 0          'Nix zu tun, alles Okay
200           checkBackendVersion = bur_okay
210       Case Is < 0     'Frontend veraltet, sowieso nix machen.
220           checkBackendVersion = bur_FrontendOld
230   End Select
Ausgang:
240         On Error Resume Next
250         Exit Function

checkBackendVersion_Error:
260    Select Case Err.Number
           Case 0
270             Resume Ausgang
280        Case Else
290             Call fncErrorHandler("mdlBackendUpdate", "checkBackendVersion")
300             Resume Ausgang
310   End Select

End Function

'---------------------------------------------------------------------------------------
' Prozedur  : BackupAndUpdate
' Autor     : Günter Gerold
' Datum     : 05.01.2008
' Text      : Es wird versucht, das Backend exclusiv zu öffnen. Gelingt dies,
'             wird das Backend mit neuem Namen kopiert, das alte in .old umbenannt
'---------------------------------------------------------------------------------------
'
Private Function BackupAndUpdate(ByVal strDateiMitPfad As String) As _
    BackupAndUpdateResult

      Dim dbsBackend As DAO.Database
      Dim rss As DAO.Recordset
      Dim strBackupDB As String
      Dim I As Integer

10    On Error GoTo BackupAndUpdate_Error
20    Set dbsBackend = OpenDatabase(strDateiMitPfad, True)  'exclusiv ?ffnen hier gibts ev. einen Fehler...
30    dbsBackend.Close

40    I = 1
50    Do      'solange testen, bis ein freier Dateiname gefunden ist
60        strBackupDB = strDateiMitPfad & ".Kopie (" & I & ")" & ".old"
70        If Dir(strBackupDB) = "" Then
80            Exit Do
90        End If
100       I = I + 1
110       If I > 100 Then
120           BackupAndUpdate = bur_TooMuchBackups
130           Exit Function
140       End If
150   Loop
160   FileCopy strDateiMitPfad, strBackupDB
170   Set dbsBackend = OpenDatabase(strDateiMitPfad, True)  'schon wieder exclusiv öffnen
180   BackupAndUpdate = updateBackend(strDateiMitPfad, dbsBackend)    'die Updates werden gemacht
190   Set rss = dbsBackend.OpenRecordset(cBackendsettingsTabelle)
200   If BackupAndUpdate = bur_okay Then                        'wenn alles gut verlaufen ist...
210       rss.Edit
220       rss(cBackendsettingsfldKey) = varFrontendVersion    'die neue Backendversion wird geschrieben
230       rss.Update
240       rss.Close
250       dbsBackend.Close
260   End If

Ausgang:
280         On Error Resume Next
290         rss.Close
300         dbsBackend.Close
310         Set rss = Nothing
320         Set dbsBackend = Nothing
330         Exit Function

BackupAndUpdate_Error:
340    Select Case Err.Number
           Case 0
350             BackupAndUpdate = bur_okay
360             Resume Ausgang
370        Case 3356
380             BackupAndUpdate = bur_FrontEndAktive     '(3356)Backend ist nicht alleine
390             Resume Ausgang
400        Case 3024
410             BackupAndUpdate = bur_BackEndNotFound    '(3024) alte Datei nicht gefunden
420             Resume Ausgang
430        Case Else
440             BackupAndUpdate = bur_UnKownError    'sicher ist sicher ;-)
450             Call fncErrorHandler("mdlBackendUpdate", "BackupAndUpdate")
460             Resume Ausgang
470   End Select

End Function

'---------------------------------------------------------------------------------------
' Prozedur  : updateBackend
' Autor     : Günter Gerold
' Datum     : 06.01.2008
' Text      : in der tblBackendHistory sind alle Änderungen aufgelistet mit der dazugehörigen
'             Versionsnummer. Zuerst wird die Versionsnummer vom Backend geholt und diese dann
'             immer mit der Versionsnummer in der History verglichen. Wenn die Versionsnummer
'             höher ist wird der Befehl ausgeführt, falls der Befehl bekannt ist.
'---------------------------------------------------------------------------------------
'
Private Function updateBackend(ByVal strPfad As String, ByRef DB As Database) _
    As BackupAndUpdateResult
      Dim rss As DAO.Recordset
      Dim strSQL As String
      Dim tdf As DAO.TableDef
      Dim dbs As DAO.Database
      Dim erledigt As Integer
         
10    On Error GoTo updateBackend_Error

20    Set dbs = CurrentDb()
30    Set rss = dbs.OpenRecordset(cBackendHistoryTabelle, dbOpenDynaset)
40    Do Until rss.EOF
50        If CInt(rss(cBackupHistoryfldKey).Value) > CInt(varBackendVersion) _
    Then
60            Select Case rss(cBackupHistoryfldAction).Value
                  Case cAddTable
70                    strSQL = "CREATE TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & ";"
80                Case cDropTable
90                    strSQL = "DROP TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & ";"
100               Case cAddColumn
110                   If rss(cBackupHistoryfldTyp).Value = "Text" Then
120                       strSQL = "ALTER TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & " ADD COLUMN " & _
    rss(cBackupHistoryfldFeld).Value & " " & rss(cBackupHistoryfldTyp).Value & "(" _
    & rss(cBackupHistoryfldGroesse).Value & ");"
130                   Else
140                       strSQL = "ALTER TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & " ADD COLUMN " & _
    rss(cBackupHistoryfldFeld).Value & " " & rss(cBackupHistoryfldTyp).Value & ";"
150                       If rss(cBackupHistoryfldPrimary) = True Then    'Wenn Prim?rindex gew?nscht wird, diesen setzen
160                           strSQL = strSQL & " CONSTRAINT " & _
    rss(cBackupHistoryfldTabelle).Value & " PRIMARY KEY" & ";"
170                       End If
180                   End If
190               Case cDropColumn
200                   strSQL = "ALTER TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & " DROP COLUMN " & _
    rss(cBackupHistoryfldFeld) & ";"
210               Case cAlterColumn
220                   If rss(cBackupHistoryfldTyp) = "Text" Then
230                       strSQL = "ALTER TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & " ALTER COLUMN " & _
    rss(cBackupHistoryfldFeld).Value & " " & rss(cBackupHistoryfldTyp).Value & "(" _
    & rss(cBackupHistoryfldGroesse).Value & ");"
240                   Else
250                       strSQL = "ALTER TABLE " & _
    rss(cBackupHistoryfldTabelle).Value & " ALTER COLUMN " & _
    rss(cBackupHistoryfldFeld).Value & " " & rss(cBackupHistoryfldTyp).Value & ";"
260                   End If
270               Case cConnectTable
280                   Set tdf = _
    dbs.CreateTableDef(rss(cBackupHistoryfldTabelle).Value)
290                   tdf.Connect = connectPrefixJet & strPfad
300                   tdf.SourceTableName = rss(cBackupHistoryfldTabelle).Value
310                   dbs.TableDefs.Append tdf
320               Case Else
330                   strSQL = "" 'keine gültige Aktion (löst Fehler 3078 aus)
340           End Select
350           erledigt = 2
360           DB.Execute strSQL, dbFailOnError
370           rss.Edit
380           rss(cBackupHistoryfldDone).Value = erledigt
390           rss.Update
400       End If
410       rss.MoveNext
420   Loop
430   updateBackend = bur_okay

Ausgang:
450         On Error Resume Next
460         rss.Close
470         Set rss = Nothing
480         Set tdf = Nothing
490         Set dbs = Nothing
500         Exit Function

updateBackend_Error:
510    Select Case Err.Number
           Case 0
520             updateBackend = bur_okay
530             Resume Ausgang
540        Case 3380          'Feld schon vorhanden, weitermachen
550             erledigt = 1
560             Resume Next
570        Case 3371
580             If Left(strSQL, 10) = "DROP TABLE" Then   'Tabelle die gelöscht werden soll ist schon weg, weitermachen
590               erledigt = 1
600               Resume Next
610             Else          'Tabelle gibts nicht
620               Call fncErrorHandler("mdlBackendUpdate", "updateBackend", _
    str(rss(cBackupHistoryfldID)))
630               updateBackend = bur_SQLError
640               Resume Ausgang
650             End If
660        Case 3078          'Die SQL-Abrage stimmt nicht. (z.B. oder die Aktion ist nicht bekannt), überspringen
670             erledigt = 0
680             Resume Next
690        Case 3010          'Tabelle im Backend schon vorhanden, weitermachen
700             erledigt = 1
710             Resume Next
720        Case 3012
730             erledigt = 1
740             Resume Next     'Tabellenverknüpfung im Frontend schon vorhanden, weitermachen
750        Case Else
760             Call fncErrorHandler("mdlBackendUpdate", "updateBackend", _
    str(rss(cBackupHistoryfldID)))
770             updateBackend = bur_SQLError
780             Resume Ausgang
790   End Select

End Function

Private Function createBackendSettingsTable(ByVal strPfad As String, ByRef DB _
    As Database) 'As BackupAndUpdateResult

      Dim strSQL As String
      Dim rss As DAO.Recordset

10    On Error GoTo createBackendSettingsTable_Error

20    strSQL = "CREATE TABLE " & cBackendsettingsTabelle & " ( [" & _
    cBackendsettingsfldID & "] COUNTER NOT NULL PRIMARY KEY, [" & _
    cBackendsettingsfldKey & "] TEXT(10));"
30    DB.Execute strSQL, dbFailOnError
40    Set rss = DB.OpenRecordset(cBackendsettingsTabelle, dbOpenDynaset)
50    rss.AddNew
60    rss(cBackendsettingsfldKey) = "1.0.0"
70    rss.Update
Ausgang:
80          On Error Resume Next
90          rss.Close
100         Set rss = Nothing
110         Exit Function

createBackendSettingsTable_Error:
120    Select Case Err.Number
           Case 0
130             Resume Ausgang
140        Case Else
150             Call fncErrorHandler("mdlBackendUpdate", _
    "createBackendSettingsTable")
160             Resume Ausgang
170   End Select

End Function