contrib/odt/BasicODConverter/Main.bas

   1 REM  *****  BASIC  *****
   2
   3 Dim Interactive As Boolean
   4 Dim WaitFor
   5
   6 Function Convert(Optional inFileURL, Optional filterSpec, Optional outFileURL)
   7         Dim inDoc, inDocType, openParams, closeInDoc, presentationDoc
   8
   9         ' Set Interactivity i.e., LogMessage pops up a message.
  10         Interactive = False
  11
  12         WaitFor = 10
  13
  14         ' Init dependencies
  15         BasicLibraries.LoadLibrary("Tools")
  16         ' BasicLibraries.LoadLibrary("XrayTool")
  17
  18         ' Setup Export filters
  19         InitExportFilters
  20
  21         ' Export to doc format by default
  22         If IsMissing(filterSpec) Then
  23                 If Interactive Then
  24                         filterSpec = InputBox("Export to: ")
  25                 Else
  26                         filterSpec = "doc"
  27                 End If
  28         End If
  29         filterSpec = Trim(filterSpec)
  30
  31         closeInDoc = False
  32         If IsMissing(inFileURL) Then
  33                 ' Most likely, the Macro is run interactively. Act on
  34                 ' the current document
  35                 If Not ThisComponent.HasLocation() Then
  36                         LogMessage("Document doesn't have a location")
  37                         Goto Failure
  38                 End If
  39
  40                 inDoc = ThisComponent
  41                 inFileURL = inDoc.GetLocation()
  42                 closeInDoc = False
  43
  44         Else
  45                 ' Load the document
  46                 On Error Goto Failure
  47                 openParams = Array(MakePropertyValue("Hidden", True),MakePropertyValue("ReadOnly", True),)
  48
  49                 'openParams = Array()
  50                 inDoc = StarDesktop.loadComponentFromURL(inFileURL, "_blank", 0, OpenParams())
  51                 closeInDoc = True
  52         End If
  53
  54         If IsMissing(outFileURL) Then
  55                 outFileURL = GetURLWithoutExtension(inFileURL)
  56         End If
  57
  58         If ExportDocument(inDoc, filterSpec, outFileURL) Then
  59                 Goto Success
  60         End If
  61
  62         LogMessage("filterSpec1 is " & filterSpec)
  63
  64         ' Export didn't go through. Maybe didn't find a valid filter.
  65
  66         ' Check whether the request is to convert a Text or a Web
  67         ' Document to a Presentation Document
  68
  69         inDocType = GetDocumentType(inDoc)
  70         If (inDocType = "com.sun.star.text.TextDocument" Or _
  71             inDocType = "com.sun.star.text.WebDocument") Then
  72                 LogMessage("Filterspec2 is " & filterSpec)
  73                 filter = GetFilter("com.sun.star.presentation.PresentationDocument", filterSpec)
  74                 If IsNull(filter) Then
  75                         LogMessage("We tried our best. Nothing more to do"
  76                         Goto Failure
  77                 Else
  78                         LogMessage("Trying to create presentation document. Found valid filter for " & filterSpec)
  79                 End If
  80         Else
  81                 Goto Failure
  82         End If
  83
  84         ' Export Outline to Presentation
  85         dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  86         dispatcher.executeDispatch(inDoc.CurrentController.Frame, ".uno:SendOutlineToStarImpress", "", 0, Array())
  87
  88         ' Dispatch event above is aynchronous. Wait for a few seconds for the above event to finish
  89         Wait(WaitFor * 1000)
  90
  91         ' After the dispatch, the current component is a presentation
  92         ' document. Note that it doesn't have a location
  93
  94         presentationDoc = ThisComponent
  95         If IsNull(ExportDocument(presentationDoc, filter, outFileURL)) Then
  96                 Goto Failure
  97         Else
  98                 presentationDoc.Close(True)
  99         End If
 100
 101 Success:
 102         LogMessage("Successfully exported to " & outFileURL )
 103         Goto Done
 104
 105 Failure:
 106         LogMessage("Export failed " & outFileURL )
 107         Goto Done
 108
 109 Done:
 110         If closeInDoc Then
 111                 inDoc.Close(True)
 112         End If
 113 End Function
 114
 115 ' http://codesnippets.services.openoffice.org/Writer/Writer.MergeDocs.snip
 116 ' http://user.services.openoffice.org/en/forum/viewtopic.php?f=20&t=39983
 117 ' http://user.services.openoffice.org/en/forum/viewtopic.php?f=21&t=23531
 118
 119 ' http://wiki.services.openoffice.org/wiki/Documentation/BASIC_Guide/Files_and_Directories_%28Runtime_Library%29
 120
 121
 122 Function ExportDocument(inputDoc, filterSpec, outFileURL) As Boolean
 123         Dim inputDocType, filter
 124         ExportDocument = False
 125
 126         On Error Goto Failure
 127         inputDocType = GetDocumentType(inputDoc)
 128
 129         If IsArray(filterSpec) Then
 130                 ' Filter is fully specified
 131                 filter = filterSpec
 132         Else
 133                 ' Filter is specified by it's name
 134                 filter = GetFilter(inputDocType, filterSpec)
 135         End If
 136
 137         If InStr(outFileURL, ".") = 0 Then
 138                 outFileURL = outFileURL & "." & FilterSaveExtension(filter)
 139         End If
 140
 141         LogMessage("outFileURL is " & outFileURL)
 142
 143         inputDoc.storeToUrl(outFileURL, Array(MakePropertyValue("FilterName", FilterHandler(filter))))
 144
 145         ExportDocument = True
 146         LogMessage("Export to " & outFileURL & " succeeded")
 147 Done:
 148         Exit Function
 149
 150 Failure:
 151         LogMessage("Export to " & outFileURL & " failed")
 152         Resume Done
 153 End Function
 154
 155
 156 Function GetURLWithoutExtension(s As String)
 157         Dim pos
 158         pos = Instr(s, ".")
 159         If pos = 0 Then
 160                 GetURLWithoutExtension = s
 161         Else
 162                 GetURLWithoutExtension = Left(s, pos - 1)
 163         End If
 164 End Function
 165
 166 Function GetDocumentType(oDoc)
 167         For Each docType in DocTypes
 168                 If (oDoc.supportsService(docType)) Then
 169                         GetDocumentType = docType
 170                         Exit Function
 171                 End If
 172         Next docType
 173         GetDocumentType = Nothing
 174 End Function
 175
 176 Function MakePropertyValue(Optional sName As String, Optional sValue) As com.sun.star.beans.PropertyValue
 177         Dim oPropertyValue As New com.sun.star.beans.PropertyValue
 178
 179         If Not IsMissing(sName) Then
 180                 oPropertyValue.Name = sName
 181         EndIf
 182
 183         If Not IsMissing(sValue) Then
 184                 oPropertyValue.Value = sValue
 185         EndIf
 186
 187         MakePropertyValue() = oPropertyValue
 188
 189 End Function
 190
 191
 192 Sub LogMessage(message)
 193         If Interactive Then
 194                 If Err <> 0 Then
 195                         Print "Error " & Err & ": " & Error$ & " (line : " & Erl & ")"
 196                 End If
 197                 Print message
 198         End If
 199 End Sub
 200
 201