Teste offlineCMS mit Calc

Kann auch Umlaute und Sonderzeichen!

Calc generiert aus den Daten eine json-Datei und lädt diese automatisch via ftp auf den Webspace.

Nebenbei kann auch eine Writer-Seriendruck-Datei angesprochen werden, um bspw. die Daten für eine Restaurant-Speisenkarte in Calc zusammenzustellen, in Writer die Speisenkarte zu drucken und abschliessend alles VOLL automatisch auf den Webspace zu laden...

Genial einfach - oder?

A wie AntonB wie Berta
... and more lorem ... and more ipsum ... and more dolor...

Mehr unter bugs Stichwort: offlineCMS/Calc


Calc-Screenshot


VBA-Quellcode für Calc Makro

Alle Einstellungen für Dateinamen und ftp-Zugang bitte in Sub Fertig anpassen...

      Option Explicit
      Public JSONFileName As String
      Public WRITERFileName As String
      Public WorkSheetName As String
      Public UserFTP As String
      Public PwdFTP As String
      Public ServerFTP As String
      Public FTPDirectory As String
      Public FTPWait As Long
      Public Sub Fertig()
         'Dateinamen richtig einstellen
         JSONFileName = ActivePath & "test_CMS.json"
         WRITERFileName = ActivePath & "test_CMS.odt"
         'Calc richtig einstellen
         WorkSheetName = "Test" 's.a. Calc-Datei
         'FTP richtig einstellen
         UserFTP = "user"
         PwdFTP = "pwd"
         ServerFTP = "ftp.example.com"
         FTPDirectory = "test/gaga"
         FTPWait = "30" 'Sekunden
         'alles ausführen
         SaveAsJSON
         OpenWriter
         UploadFTP
         'Calc beenden
         thisComponent.store
         thisComponent.close(true)
      End Sub
      PRIVATE Function Replace(Source As String, Search As String, NewPart As String)
        Dim Result As String
        Dim StartPos As Long
        Dim CurrentPos As Long
        Result = ""
        StartPos = 1
        CurrentPos = 1
        If Search = "" Then
          Result = Source
        Else 
          Do While CurrentPos <> 0
            CurrentPos = InStr(StartPos, Source, Search)
            If CurrentPos <> 0 Then
              Result = Result + Mid(Source, StartPos, _
              CurrentPos - StartPos)
              Result = Result + NewPart
              StartPos = CurrentPos + Len(Search)
            Else
              Result = Result + Mid(Source, StartPos, Len(Source))
            End If
          Loop 
        End If 
        Replace = Result
      End Function
      PRIVATE Function ActivePath()
        DIM Result, surl as String
        DIM apfad() as String
        Result = ""
        surl = ThisComponent.url
        apfad = split(surl,"/")
        apfad(ubound(apfad)) = ""
        Result = join(apfad,"/")
        ActivePath = Result
      End Function
      PRIVATE Sub SaveAsJson
          DIM oFileAccess as Object
          DIM oOutputStream as Object
          DIM oFileWrite as Object
          DIM allRows as Long
          DIM allColumns as Long
          Dim rowcounter As Long
          Dim columncounter As Long
          Dim linedata As String  
          Dim oSheets as Object
          Dim oSheet as Object
          Dim oCurs as Object
          oSheets = ThisComponent.getSheets()
          oSheet = oSheets.getByName(WorkSheetName)
          oCurs = oSheet.createCursor()
          oCurs.gotoEndOfUsedArea( true )
          allColumns = OCurs.getRangeAddress().EndColumn
          allRows = OCurs.getRangeAddress().EndRow
          linedata = "["
          For rowcounter = 1 To allRows
              linedata = linedata + "{"
              For columncounter = 0 to allColumns
                  linedata = linedata + """" + _
                             replace(oSheet.getCellByPosition( columncounter, 0         ).String,"""","'") + """" + _
                             ":" + """" + _
                             replace(oSheet.getCellByPosition( columncounter, rowcounter).String,"""","'") + """"
                  If columncounter < allColumns Then
                      linedata = linedata + ","
                  Else
                      linedata = linedata + ""
                  End If
              Next
              If rowcounter < allRows Then
                  linedata = linedata + "},"
              Else
                  linedata = linedata + "}"
              End If
          Next
          linedata = linedata + "]"   
      	oFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
      	oOutputStream = oFileAccess.openFileWrite(ConvertToURL(JSONFileName))	
      	oFileWrite = createUnoService("com.sun.star.io.TextOutputStream")
      	oFileWrite.OutputStream = oOutputStream
      	oFileWrite.writeString(linedata)
      	oFileWrite.closeOutput	
      End Sub
      Private Sub UploadFTP()
          Dim tmp_Script As String
          Dim tmp_Batch As String
          DIM bat as String
          DIM scr as String
          DIM oscrFileAccess as Object
          DIM oscrOutputStream as Object
          DIM oscrFileWrite as Object
          DIM obatFileAccess as Object
          DIM obatOutputStream as Object
          DIM obatFileWrite as Object
          Dim lTick As Long
          tmp_Script = ActivePath() & "script_LOF.dat"
          tmp_Batch = ActivePath() & "upload_LOF.bat"
          scr = UserFTP + chr(13) + chr(10) + _
                PwdFTP  + chr(13) + chr(10) +  _
                "binary" + chr(13) + chr(10) +  _
                "cd " + FTPDirectory  + chr(13) +chr(10) + _
                "put """ + JSONFileName + """" + chr(13) +  chr(10) +  _
                "quit" + chr(13) + chr(10) 
      	  oscrFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
      	  oscrOutputStream = oscrFileAccess.openFileWrite(ConvertToURL(tmp_Script))	
      	  oscrFileWrite = createUnoService("com.sun.star.io.TextOutputStream")
      	  oscrFileWrite.OutputStream = oscrOutputStream
      	  oscrFileWrite.writeString(scr)
      	  oscrFileWrite.closeOutput	
          bat = "ftp -i -s:""" & replace(tmp_Script,"file:///","") & """ " & "ftp.strato.com" +chr(13) + chr(10) 'ServerFTP
      	  obatFileAccess = CreateUnoService("com.sun.star.ucb.SimpleFileAccess")
      	  obatOutputStream = obatFileAccess.openFileWrite(ConvertToURL(tmp_Batch))	
      	  obatFileWrite = createUnoService("com.sun.star.io.TextOutputStream")
      	  obatFileWrite.OutputStream = obatOutputStream
      	  obatFileWrite.writeString(bat)
      	  obatFileWrite.closeOutput	
          Shell(tmp_Batch, 0)    
          lTick = GetSystemTicks()
          Wait FTPWait*1000
          lTick = (GetSystemTicks() - lTick) 
          Kill tmp_Script
          Kill tmp_Batch    
      End Sub
      Private Sub OpenWriter
          Dim url 
          url=ConvertToUrl(WRITERFileName)
          StarDesktop.loadComponentFromURL(url,"_blank",0,Array())
      End Sub
    

Writer-Screenshot


Der jquery-Quelltext zum Einlesen der json-Daten findet Ihr in dieser HTML-Datei am Ende unter <script> :)