Dokumentation: Projekt Kundenverwaltung (2009 - ) Modul: Wartung

Details
Kategorie: Archivierte Beiträge
'Kundenverwaltung.odb Modul Wartung
'Backup Texte
Const sTextBackupErfolgreich1 = "Backup erfolgreich gespeichert unter: "
Const sTextBackupErfolgreich2 = "gesichert"
Const sTextBackupErfolgreich3 = "Backupset Nummer "
Const sTextBackupErfolgreich4 = " von "
Const sTextBackupErfolgreich5 = " Sets "
Const sTextBackupErfolgreich6 = "Backup ausgeführt"


'Wartung der Datenbank
SUB Datenbank_komprimieren
    DIM stMessage AS STRING
    oDatenquelle = ThisComponent.Parent.CurrentController ' Zugriffsmöglichkeit aus dem    Formular heraus
    IF NOT (oDatenquelle.isConnected()) THEN
    oDatenquelle.connect()
    END IF
    
    
    oVerbindung = oDatenquelle.ActiveConnection()
    oSQL_Anweisung = oVerbindung.createStatement()
    stSql = "SHUTDOWN COMPACT" ' Die Datenbank wird komprimiert und geschlossen
    oSQL_Anweisung.executeQuery(stSql)
    stMessage = "Die Datenbank wurde komprimiert." + CHR(13) + "Das Formular wird jetzt geschlossen."
    stMessage = stMessage + CHR(13) + "Anschließend sollte die Datenbankdatei geschlossen werden."
    stMessage = stMessage + CHR(13) + "Auf die Datenbank kann erst nach dem erneuten Öffnen der Datenbankdatei zugegriffen werden."
    msgbox stMessage
    ThisDatabaseDocument.FormDocuments.getByName( "Unternehmen" ).close
    REM Das Schließen der Datenbankdatei führt beim Neustart zu einem Wiederherstellungsablauf.
    ' ThisDatabaseDocument.close(True)
    SaveAndCloseAll
END SUB

SUB Daten_aus_Cache_schreiben
    DIM oDaten AS OBJECT
    DIM oDataSource AS OBJECT
    oDaten = ThisDatabaseDocument.CurrentController
    IF NOT ( oDaten.isConnected() ) THEN oDaten.connect()
    oDataSource = oDaten.DataSource
    oDataSource.flush
END SUB

SUB Datenbankbackup
    DIM oPath AS OBJECT
    DIM oDoc AS OBJECT
    DIM sTitel AS STRING
    DIM sUrl_Ziel AS STRING
    DIM sUrl_Start AS STRING
    DIM i AS INTEGER
    DIM k AS INTEGER
    Daten_aus_Cache_schreiben 'Aufruf von SUB Daten_aus_Cache_schreiben
    msgbox "zuerst wird der Cache gesichert", 64, "Cache speichern"
    oDoc = ThisComponent
    'sTitel = oDoc.Title
    'sUrl_Start = oDoc.URL
    sTitel = ThisDatabaseDocument.Title
       sUrl_Start = ThisDatabaseDocument.URL
    oPath = createUnoService("com.sun.star.util.PathSettings")
    
    FOR i = 1 TO 100
    IF NOT FileExists(oPath.Backup & "/" & i & "_" & sTitel) THEN
    IF i > 99 THEN
    FOR k = 98 TO 1 STEP -1
    IF FileDateTime(oPath.Backup & "/" & k & "_" & sTitel) <= FileDateTime(oPath.Backup & "/" & k+1 & "_" & sTitel) THEN
    IF k = 1 THEN
    i = k
    EXIT FOR
    END IF
    ELSE
    i = k + 1
    EXIT FOR
    END IF
    NEXT
    END IF
    EXIT FOR
    END IF
    NEXT
    knur = k
    inur = i
    sUrl_Ziel = oPath.Backup & "/" & i &"_" & sTitel
    FileCopy(sUrl_Start,sUrl_Ziel)
    MsgBox(sTextBackupErfolgreich1 + Chr(13) & oPath.Backup + Chr(13) + sTextBackupErfolgreich3 & knur & sTextBackupErfolgreich4 & inur & sTextBackupErfolgreich5 & sTextBackupErfolgreich2,64,sTextBackupErfolgreich6)
END SUB


Sub Defrag_Database()
' this macro can be assigned to a button on your data form
dim conn, stmt, dbName, DBContext, Datasource As Object
dbName = "Kundenverwaltung" '<<- change to suit, must be a registered datasource

DBContext=createUnoService("com.sun.star.sdb.DatabaseContext")

    If DBContext.hasByName(dbName) then
          DataSource = DBContext.getByName(dbName)
          conn = DataSource.getConnection( "sa", "" ) '<<- default username/password pair
          stmt = conn.CreateStatement
          stmt.ExecuteUpdate( "CHECKPOINT DEFRAG" )
          conn.dispose '<<- your database will still be open to enter/edit the data
        'Wir Zeigen eine Erfolgsmeldung das die Defragmentierung der Kundenverwaltung.odb abgeschlossen ist!
          MsgBox "Defragmentierung " & chr(13) & dbName & chr(13) & "erfolgreich beendet....", ," --AOO Database Defrag-- "
    else
        'Wir Zeigen eine Fehlermeldung da die Defragmentierung der Kundenverwaltung.odb fehlgeschlagen ist!
         MsgBox "Defragmentierung fehlgeschlagen!" & chr(13) & "Defragmentierung kann nicht erfolgen da die Kundenverwaltung.odb bereits geöffnet ist. Sie müssen Sub Defrag_Database_Silent vor dem öffnen einbinden" & chr(13) & dbName,  ," --AOO Database Defrag--"
    End If
End Sub

Sub Defrag_Database_Silent()
' this macro can be assigned to a button on your data form
dim conn, stmt, dbName, DBContext, Datasource As Object
dbName = "Kundenverwaltung" '<<- change to suit, must be a registered datasource

DBContext=createUnoService("com.sun.star.sdb.DatabaseContext")

    If DBContext.hasByName(dbName) then
          DataSource = DBContext.getByName(dbName)
          conn = DataSource.getConnection( "sa", "" ) '<<- default username/password pair
          stmt = conn.CreateStatement
          stmt.ExecuteUpdate( "CHECKPOINT DEFRAG" )
          conn.dispose '<<- your database will still be open to enter/edit the data
        'Wir Zeigen eine Erfolgsmeldung das die Defragmentierung der Kundenverwaltung.odb abgeschlossen ist!
          'MsgBox "Defragmentierung " & chr(13) & dbName & chr(13) & "erfolgreich beendet....", ," --AOO Database Defrag-- "
    else
        'Wir Zeigen eine Fehlermeldung da die Defragmentierung der Kundenverwaltung.odb fehlgeschlagen ist!
         'MsgBox "Defragmentierung fehlgeschlagen!" & chr(13) & "Defragmentierung kann nicht erfolgen da die Kundenverwaltung.odb bereits geöffnet ist. Sie müssen Sub Defrag_Database_Silent vor dem öffnen einbinden" & chr(13) & dbName,  ," --AOO Database Defrag--"
    End If
End Sub

SUB Datenbankbackup_Silent
    'DIM oPath AS STRING
    DIM sUrlBackupFiles AS STRING
    ' Dateipfad ermitteln
    'sUrlBackupFiles = ThisComponent.getUrl()
    'URL = Dokument.getURL()
    'MsgBox(sUrlBackupFiles,64,"URL")
    sUrlBackupFiles = "file:///O:/VERWALTUNG/BACKUP/"
    DIM oDoc AS OBJECT
    DIM sTitel AS STRING
    DIM sUrl_Ziel AS STRING
    DIM sUrl_Start AS STRING
    DIM i AS INTEGER
    DIM k AS INTEGER
        Daten_aus_Cache_schreiben 'Aufruf von SUB Daten_aus_Cache_schreiben
        'msgbox "zuerst wird der Cache gesichert", 64, "Cache speichern"
        oDoc = ThisComponent
        'sTitel = oDoc.Title
        'sUrl_Start = oDoc.URL
        sTitel = ThisDatabaseDocument.Title
        'oPath = sUrlBackupFiles
        'oPath = createUnoService("com.sun.star.util.PathSettings")
        'sUrlBackupFiles = createUnoService("com.sun.star.util.PathSettings")
        
        FOR i = 1 TO 100
            IF NOT FileExists(sUrlBackupFiles & i & "_" & sTitel) THEN
                IF i > 99 THEN
                    FOR k = 98 TO 1 STEP -1
                        IF FileDateTime(sUrlBackupFiles & k & "_" & sTitel) <= FileDateTime(sUrlBackupFiles & k+1 & "_" & sTitel) THEN
                            IF k = 1 THEN
                            i = k
                    EXIT FOR
                END IF
            ELSE
            i = k + 1
        EXIT FOR
    END IF
NEXT
    END IF
        EXIT FOR
    END IF
NEXT
    knur = k
    knur = 100
    inur = i

    sUrl_Start = ThisDatabaseDocument.URL
    'sUrlt_Start = ThisDatabaseDocument
    'sUrlt_Start = sUrlBackupFiles  & "/" & i &"_" & sTitel
    'sUrl_Ziel = oPath.Backup & "/" & i &"_" & sTitel
    sUrl_Ziel = sUrlBackupFiles & i &"_" & sTitel

    FileCopy(sUrl_Start,sUrl_Ziel)
    'Laden von Sub Defrag_Database_Silent
    Defrag_Database_Silent()

END SUB

SUB SaveAndCloseAllNOTWORKANYMORE( ) 'erzeugt als Knop einen Fehler: BASIC-Laufzeitfehler. Es ist eine Ausnahme aufgetreten  Type: com.sun.star.lang.DisposedException Message: Component is already disposed.
    IF MsgBox("Kundenverwaltung speichern und schliessen?", 1 + 48 + 512,"Kundenverwaltung beenden")= 1 THEN
     DIM oForm AS OBJECT
    'Dim oDispatch as object
    oDoc = ThisComponent.CurrentController.Frame
    oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
    oDispatch.executeDispatch(oDoc, ".uno:CloseDoc", "", 0, Array()) ' erst das aktive Formular schließen
    ' ***************************************************************************
    ' * Bei der folgenden Methode bleibt OO im Speicher *
    ' ***************************************************************************
    oDoc = ThisComponent.Parent.CurrentController.Frame ' und nun das Hauptfenster (Parent) holen
    oDoc.close(true) ' und schließen
        If not(saveandcloseall) then
        'Variable zur Steuerung der Fensterschließung (falls false: Endlosschleife
        '(shutdown schließt Formular, Formularschließen löst dbShutdown aus etc)
        saveandcloseall = true
        
        'Controler referenzieren
         oController = ThisDatabaseDocument.CurrentController
         oConnection = oController.ActiveConnection
         
         'Verbindung und SubComponenten schließen, Dokument speichern und DB anschließend schließen
        oDoc = ThisDatabaseDocument
        oDoc.store()
        oController.closeSubComponents
        oController.ActiveConnection.close()
        oDoc.dispose()
        oDoc.close(True)
    endif
        ' START Daten Backup_SIlent aus WARTUNG inklusive Defrag_Database_Silent() der Kundenverwaltung.odb nach /Backup
    Datenbankbackup_Silent 'inklusive Defrag_Database_Silent()
    ' ENDE Daten Backup der Kundenverwaltung.odb nach /Backup
    ' ***************************************************************************
    ' * Hier kommt die harte Methode, die anschliessend OO komplett beendet (incl. Schnellstart)*
    ' ***************************************************************************
    oDoc = ThisComponent.Parent.CurrentController.Frame
    oDispatch = createUnoService("com.sun.star.frame.DispatchHelper")
    oDispatch.executeDispatch(oDoc, ".uno:CloseDoc", "", 0, Array())
    oDispatch.executeDispatch(oDoc, ".uno:CloseWin", "", 0, Array())
    MsgBox(sTextAbgebrochen1 + Chr(13) + sTextAbgebrochen2,48,sTextAbgebrochen3)
    ELSE
    ' Hier sammeln wir Text mit Zeilenumbruch Chr$(13)für eine bessere Darstellung
    MsgBox(sTextAbgebrochen1 + Chr(13) + sTextAbgebrochen2,48,sTextAbgebrochen3)
        EXIT SUB
    END IF
END SUB
Zugriffe: 787