' Gambas class file

' hans@ASROCK:~$ firefox -no-remote web.de ard.de

PUBLIC sSQL_Anweisung AS String
PUBLIC sDB_Name AS String
PUBLIC sDB_TabellenName AS String

PUBLIC SUB Form_Open()
  FMain.Center
  'Note: 
  'Sqlite has no concept of users. 
  'Access to a database is controlled by the actual file permissions of the database file. 
  'This means that the Login is always the user id executing the Gambas program. 
  
  'DB-Engine - SQLite3-Bibliothek:
  'Syntax: OpenDB(DBType, DBHost, DBName, DBUserName(leer), DBUserPassword(leer), DBPort(leer), DBTabellenName)
  MDataBase.OpenDB("sqlite3", User.Home &/ "XMLGenerator", "Kontakte2", "", "", "", "kontakt")  
  
  sDB_TabellenName = "kontakt" ' Name der DB-Tabelle
  sDB_Name = MDataBase.cDBVerbindung.Name  
  DataSource1.Table = sDB_TabellenName
  
  DataSource1.Filter = "" ' Alle Datensätze werden angezeigt
  ' Alternative Filter-Einstellungen; 2 Beispiele:
  ' DataSource1.Filter = "Hinweise <> " & Chr(34) & Chr(34) 
  ' DataSource1.Filter = "ID >= 2 AND ID < 15" 
END ' Form_Open

PUBLIC SUB Form_Show()  
  
  dcNachname.Field = "Nachname" ' Datensensitive Eingabebox für ein DB-Feld
  dcVorname.Field = "Vorname"
  cdWohnort.Field = "Wohnort"
  dcPLZ.Field = "PLZ"
  dcStrasse.Field = "Strasse"
  dcEMailAdresse.Field = "EMailAdresse"
  dcWebAdresse.Field = "WebAdresse"
  dcGebDatum.Field = "GebDatum"
  dcHinweise.Field = "Hinweise"
  dcTelefonFestnetz.Field = "TelefonFestnetz"
  dcTelefonMobil.Field = "TelefonMobil"
  
  DataBrowser1.GridView.Columns[0].Width = 45
  DataBrowser1.GridView.Columns[1].Width = 100
  DataBrowser1.GridView.Columns[2].Width = 100
  DataBrowser1.GridView.Columns[3].Width = 110
  DataBrowser1.GridView.Columns[4].Width = 50
  DataBrowser1.GridView.Columns[5].Width = 160
  
  ' Notwendig für den Sprung in die 1. Zeile von DataBrowser
  DataBrowser1.GridView.MoveTo(0, 0)
  dcNachname.SetFocus
  
END ' Form_Show

PUBLIC SUB btnDatenSicherungXML_Click()
  DIM xmlSicherung AS XmlWriter
  DIM iDatensatzNummer, iSpaltenNummer AS Integer
  
  sSQL_Anweisung = "SELECT * FROM " & sDB_TabellenName
  ' sSQL_Anweisung = "SELECT * FROM " & DataSource1.Table & " WHERE ID>1 ORDER BY Nachname"
  MDataBase.rDBResult = MDataBase.cDBVerbindung.Exec(sSQL_Anweisung)
  
  IF MDataBase.rDBResult.Count = 0 THEN 
     Message.Info("Die Anzahl der selektierten Datensätze ist Null!")
     RETURN 
  ENDIF 
  
  xmlSicherung = NEW XmlWriter
  xmlSicherung.Open(User.Home &/ "XMLGenerator" &/ sDB_TabellenName & ".xml", TRUE)

  xmlSicherung.Text("<!DOCTYPE " & sDB_Name & " SYSTEM " & Chr(34) & sDB_TabellenName & ".dtd" & Chr(34) & ">")
  xmlSicherung.Text(gb.NewLine)
  xmlSicherung.Text("<?xml-stylesheet type=" & Chr(34) & "text/xsl" & Chr(34) & " href=" & Chr(34) & sDB_TabellenName & ".xsl" & Chr(34) & " ?>")
  xmlSicherung.Text(gb.NewLine & gb.NewLine)
  xmlSicherung.Comment("Database: " & sDB_Name)
  xmlSicherung.StartElement(sDB_Name)
  xmlSicherung.Text(gb.NewLine & gb.NewLine)
  xmlSicherung.Text("Kontaktliste - Stand: " & Format(Now, "dd. mmmm yyyy"))
  xmlSicherung.Text(gb.NewLine & gb.NewLine)
  
  IF MDataBase.rDBResult.Available THEN
     MDataBase.rDBResult.MoveFirst
     
     FOR iDatensatzNummer = 0 TO MDataBase.rDBResult.Count - 1
         MDataBase.rDBResult.MoveTo(iDatensatzNummer)
         
         xmlSicherung.StartElement(sDB_TabellenName)
         
         FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
             xmlSicherung.StartElement(MDataBase.rDBResult.Fields[iSpaltenNummer].Name)
             IF MDataBase.rDBResult.Fields[iSpaltenNummer].Name = "GebDatum" THEN 
                xmlSicherung.Text(Format(MDataBase.rDBResult[iSpaltenNummer], "dd.mm.yyyy"))
             ELSE 
                xmlSicherung.Text(MDataBase.rDBResult[iSpaltenNummer])
             ENDIF 
             xmlSicherung.EndElement
         NEXT ' SpaltenNummer ---> FeldNummer
      
     xmlSicherung.EndElement
     NEXT ' Datensatz
     xmlSicherung.EndElement
  ENDIF '  MDataBase.rDBResult.Available  
  xmlSicherung.EndDocument
  
  DTDDateiAnlegen()
  XSLDateiAnlegen() ' Style-Anweisungen
  
END ' DatenSicherungXML

PUBLIC SUB DTDDateiAnlegen()
  DIM hFile AS File
  DIM sDTDDateiPfad, sFeldListe AS String
  DIM iSpaltenNummer AS Integer

  sDTDDateiPfad = User.Home &/ "XMLGenerator" &/ DataSource1.Table & ".dtd"
  sFeldListe = ""
  
  sSQL_Anweisung = "SELECT * FROM " & sDB_TabellenName
  MDataBase.rDBResult = MDataBase.cDBVerbindung.Exec(sSQL_Anweisung)
  
  hFile = OPEN sDTDDateiPfad FOR CREATE ' DTD-Datei wird neu angelegt oder geleert
  CLOSE #hFile 
  
  TRY hFile = OPEN sDTDDateiPfad FOR WRITE
  SEEK #hFile, 0  

  PRINT #hFile, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & " encoding=" & Chr(34) & "UTF-8" & Chr(34) & "?>"
  PRINT #hFile, "<!--Die Datei " & DataSource1.Table & ".dtd definiert die einzelnen Elemente der XML-Datei und ihre Verschachtelungsregeln-->"
  PRINT #hFile, "<!--Das ROOT-ELEMENT enthält Text oder eine beliebige Anzahl von Datensätzen-->"
  PRINT #hFile, ""
  PRINT #hFile, "<!ELEMENT " & MDataBase.cDBVerbindung.Name & " (#PCDATA | " & sDB_TabellenName & ")*>"
  
  IF MDataBase.rDBResult.Available THEN
     sFeldListe = MDataBase.rDBResult.Fields[0].Name
     
     MDataBase.rDBResult.MoveFirst
     FOR iSpaltenNummer = 1 TO MDataBase.rDBResult.Fields.Count - 1 
         sFeldListe = sFeldListe & "," & MDataBase.rDBResult.Fields[iSpaltenNummer].Name
     NEXT ' SpaltenNummer ---> FeldNummer
     
     PRINT #hfile, "<!ELEMENT " & sDB_TabellenName & " (" & sFeldListe & ")>" 
     
     MDataBase.rDBResult.MoveFirst
     FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
         PRINT #hfile, "<!ELEMENT " & MDataBase.rDBResult.Fields[iSpaltenNummer].Name & "(#PCDATA)>"
     NEXT ' SpaltenNummer ---> FeldNummer

  ENDIF ' MDataBase.rDBResult.Available  
  
  CLOSE #hFile  
END

PUBLIC SUB XSLDateiAnlegen()
  DIM hFile AS File
  DIM sDTDDateiPfad AS String
  DIM iSpaltenNummer AS Integer

  sDTDDateiPfad = User.Home &/ "XMLGenerator" &/ sDB_TabellenName & ".xsl"
  
  sSQL_Anweisung = "SELECT * FROM " & sDB_TabellenName
  MDataBase.rDBResult = MDataBase.cDBVerbindung.Exec(sSQL_Anweisung)
  
  hFile = OPEN sDTDDateiPfad FOR CREATE ' DTD-Datei wird neu angelegt oder geleert
  CLOSE #hFile 
  
  TRY hFile = OPEN sDTDDateiPfad FOR WRITE
  SEEK #hFile, 0  

  PRINT #hFile, "<?xml version=\"1.0\" encoding=\"utf-8\" ?>"
  PRINT #hFile, "<xsl:stylesheet version=\"1.0\" xmlns:xsl=\"http://www.w3.org/1999/XSL/Transform\">"
  PRINT #hFile, "<xsl:template match=\"/\">"
  PRINT #hFile, "<html>"
  PRINT #hFile, "  <head></head>"
  PRINT #hFile, "  <body bgcolor=\"#C3DDFF\" text=\"#000000\" style=\"font-family:Arial; font-size:12px;\">"
  PRINT #hFile, "    <table style=\"border-spacing: 0; border-collapse: collapse;\">"
  PRINT #hFile, "    <tr>"
  
  IF MDataBase.rDBResult.Available THEN
     
     MDataBase.rDBResult.MoveFirst
     FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
         PRINT #hfile, "      <td style=\"border:1px solid #708090;\"><b>" & MDataBase.rDBResult.Fields[iSpaltenNummer].Name & "</b></td>"
     NEXT ' SpaltenNummer ---> FeldNummer
     
     PRINT #hFile, "    </tr>"
     PRINT #hFile, "    <xsl:for-each select=\"" & sDB_Name & "/" & sDB_TabellenName & "\">"
     PRINT #hFile, "    <tr>"
     
     MDataBase.rDBResult.MoveFirst     
     FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
         PRINT #hfile, "      <td style=\"border:1px solid #708090;\"><xsl:value-of select=\"" & MDataBase.rDBResult.Fields[iSpaltenNummer].Name & "\"" & " /></td>"
     NEXT ' SpaltenNummer ---> FeldNummer
     
     PRINT #hFile, "    </tr>"
     PRINT #hFile, "    </xsl:for-each>"
     PRINT #hFile, "    </table>"
     PRINT #hFile, "  </body>"
     PRINT #hFile, "</html>"
     PRINT #hFile, "</xsl:template>"
     PRINT #hFile, ""
     PRINT #hFile, "</xsl:stylesheet>"
     
  ENDIF ' MDataBase.rDBResult.Available  
  
  CLOSE #hFile 
END ' XSLDateiAnlegen()

PUBLIC SUB btnDatenSicherungXHTML_Click()
  DIM xmlSicherung AS XmlWriter
  DIM iDatensatzNummer, iSpaltenNummer AS Integer
  
  sSQL_Anweisung = "SELECT * FROM " & sDB_TabellenName
  MDataBase.rDBResult = MDataBase.cDBVerbindung.Exec(sSQL_Anweisung)
  
  xmlSicherung = NEW XmlWriter
  xmlSicherung.Open(User.Home &/ "XMLB/sicherung.html", TRUE, "UTF-8")

  xmlSicherung.Text("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">" & gb.NewLine)
  xmlSicherung.Text("<html xmlns=\"http://www.w3.org/1999/xhtml\">" & gb.NewLine)
  xmlSicherung.StartElement("style", ["type", "text/css"])
  xmlSicherung.Text(gb.NewLine)
  xmlSicherung.Text("table {border=\"1\"; border-style=\"solid\"; padding=\"2pt\"; widht=\"100%\";}" & gb.NewLine)
  xmlSicherung.Text("th {font-weight: bold; background-color: #cccc99; color: #000000;}" & gb.NewLine)
  xmlSicherung.Text("tr.OddRow {background-color: #FFFFFF; text-align: center;}" & gb.NewLine)
  xmlSicherung.Text("tr.EvenRow {background-color: #f5f5dc; text-align: center;}" & gb.NewLine)  
  xmlSicherung.EndElement
  xmlSicherung.StartElement("table") '  , ["class", "fancyTable"])  
  
  IF MDataBase.rDBResult.Available THEN 
     MDataBase.rDBResult.MoveFirst
     
     FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
           xmlSicherung.Element("th", MDataBase.rDBResult.Fields[iSpaltenNummer].Name)
     NEXT ' SpaltenNummer ---> FeldNummer
     
     FOR iDatensatzNummer = 0 TO MDataBase.rDBResult.Count - 1
         MDataBase.rDBResult.MoveTo(iDatensatzNummer)
         IF iDatensatzNummer MOD 2 = 0 THEN 
            xmlSicherung.StartElement("tr", ["class", "OddRow"])
         ELSE 
            xmlSicherung.StartElement("tr", ["class", "EvenRow"])
         ENDIF 
         
         FOR iSpaltenNummer = 0 TO MDataBase.rDBResult.Fields.Count - 1 
             xmlSicherung.Element("td", MDataBase.rDBResult[iSpaltenNummer])
         NEXT ' SpaltenNummer ---> FeldNummer
         
         xmlSicherung.EndElement
     NEXT ' Datensatz
     'xmlSicherung.EndElement
  ENDIF     
  xmlSicherung.EndDocument
END ' DatenSicherungXHTML

PUBLIC SUB Form_Close()
  MDataBase.DBVerbindungSchliessen
END ' Form_Close

PUBLIC SUB btnProgrammEnde_Click()
  FMain.Close
END ' Programm-Ende
