Attribute VB_Name = "mdlBackendUpdate" '--------------------------------------------------------------------------------------- ' 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