Quelle  GetTexts.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
 * This file is part of the LibreOffice project.
 *
 * This Source Code Form is subject to the terms of the Mozilla Public
 * License, v. 2.0. If a copy of the MPL was not distributed with this
 * file, You can obtain one at http://mozilla.org/MPL/2.0/.
 *
 * This file incorporates work covered by the following license notice:
 *
 *   Licensed to the Apache Software Foundation (ASF) under one or more
 *   contributor license agreements. See the NOTICE file distributed
 *   with this work for additional information regarding copyright
 *   ownership. The ASF licenses this file to you under the Apache
 *   License, Version 2.0 (the "License"); you may not use this file
 *   except in compliance with the License. You may obtain a copy of
 *   the License at http://www.apache.org/licenses/LICENSE-2.0 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="GetTexts" script:language="StarBasic">Option Explicit
' Description:
' This macro extracts the strings out of the currently active document and inserts them into a log document.
' The aim of the macro is to provide the programmer an insight into the OpenOffice API.
' It focuses on how document objects are accessed.
' Therefore not only texts of the document body are retrieved but also texts of general
' document objects like, annotations, charts and general document information.

Public oLogDocument, oLogText, oLogCursor, oLogHeaderStyle, oLogBodyTextStyle as Object
Public oDocument as Object
Public LogArray(1000) as String
Public LogIndex as Integer
Public oLocHeaderStyle as Object

Sub Main
Dim sDocType as String
Dim oHyperCursor as Object
Dim oCharStyles as Object
 BasicLibraries.LoadLibrary("Tools")
 On Local Error GoTo NODOCUMENT
 oDocument = StarDesktop.ActiveFrame.Controller.Model
 sDocType = GetDocumentType(oDocument)
 NODOCUMENT:
 If Err <> 0 Then
  Msgbox("This macro extracts all data from the active Writer, Calc or Draw/Impress document." & chr(13) &_
      "To start this macro you have to activate a document first." , 16, GetProductName)
  Exit Sub
 End If
 On Local Error Goto 0

 ' Open a new document where all the texts are inserted
 oLogDocument = CreateNewDocument("swriter")
 If Not IsNull(oLogDocument) Then
  oLogText = oLogDocument.Text

  ' create and define the character styles of the log document
  oCharStyles = oLogDocument.StyleFamilies.GetByName("CharacterStyles")
  oLogHeaderStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
  oCharStyles.InsertbyName("Log Header", oLogHeaderStyle)

  oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
  oLogBodyTextStyle = oLogDocument.createInstance("com.sun.star.style.CharacterStyle")
  oCharStyles.InsertbyName("Log Body", oLogBodyTextStyle)

  ' Insert the title of the activated document as a hyperlink
  oHyperCursor = oLogText.createTextCursor()
  oHyperCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
  oHyperCursor.gotoStart(False)
  oHyperCursor.HyperLinkURL = oDocument.URL
  oHyperCursor.HyperLinkTarget = oDocument.URL
  If oDocument.DocumentProperties.Title <> "" Then
   oHyperCursor.HyperlinkName = oDocument.DocumentProperties.Title
  End If
  oLogText.insertString(oHyperCursor, oDocument.DocumentProperties.Title, False)
  oLogText.insertControlCharacter(oHyperCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)

  oLogCursor = oLogText.createTextCursor()
  oLogCursor.GotoEnd(False)
  ' "Switch off" the Hyperlink - Properties
  oLogCursor.SetPropertyToDefault("HyperLinkURL")
  oLogCursor.SetPropertyToDefault("HyperLinkTarget")
  oLogCursor.SetPropertyToDefault("HyperLinkName")
  LogIndex = 0

  ' Get the Properties of the document
  GetDocumentProps()

  Select Case sDocType
   Case "swriter"
    GetWriterStrings()
   Case "scalc"
    GetCalcStrings()
   Case "sdraw", "simpress"
    GetDrawStrings()
   Case Else
    Msgbox("This macro only works with a Writer, Calc or Draw/Impress document.", 16, GetProductName())
  End Select
 End If
End Sub


' ***********************************************Calc documents**************************************************

Sub GetCalcStrings()
Dim i, n as integer
Dim oSheet as Object
Dim SheetName as String
Dim oSheets as Object
 ' Create a sequence of all sheets within the document
 oSheets = oDocument.Sheets

 For i = 0 to osheets.Count - 1
  oSheet = osheets.GetbyIndex(i)
  SheetName = oSheet.Name
  MakeLogHeadLine("Sheet No. " & i & " (" & SheetName & ")" )

  ' Check the "body" of the sheet
  GetCellTexts(oSheet)

  If oSheet.IsScenario then
   MakeLogHeadLine("Scenario Comments from " & SheetName & "'")
   WriteStringtoLogFile(osheet.ScenarioComment)
  End if

  GetAnnotations(oSheet, "Annotations from '" & SheetName & "'")

  GetChartStrings(oSheet, "Charts from '" & SheetName & "'")

  GetControlStrings(oSheet.DrawPage, "Controls from '" & SheetName & "'")
 Next

 ' Pictures
 GetCalcGraphicNames()

 GetNamedRanges()
End Sub


Sub GetCellTexts(oSheet as Object)
Dim BigRange, BigEnum, oCell as Object
 BigRange = oDocument.CreateInstance("com.sun.star.sheet.SheetCellRanges")
 BigRange.InsertbyName("",oSheet)
 BigEnum = BigRange.GetCells.CreateEnumeration
 While BigEnum.hasmoreElements
  oCell = BigEnum.NextElement
  If oCell.String <> "" And Val(oCell.String) = 0then
   WriteStringtoLogFile(oCell.String)
  End If
 Wend
End Sub


Sub GetAnnotations(oSheet as Object, HeaderLine as String)
Dim oNotes as Object
Dim n as Integer
 oNotes = oSheet.getAnnotations
 If oNotes.hasElements() then
  MakeLogHeadLine(HeaderLine)
  For n = 0 to oNotes.Count-1
   WriteStringtoLogFile(oNotes.GetbyIndex(n).String)
  Next
 End if
End Sub


Sub GetNamedRanges()
Dim i as integer
 MakeLogHeadLine("Named Ranges")
 For i = 0 To oDocument.NamedRanges.Count - 1
  WriteStringtoLogFile(oDocument.NamedRanges.GetbyIndex(i).Name)
 Next
End Sub


Sub GetCalcGraphicNames()
Dim n,m as integer
 MakeLogHeadLine("Graphics")
 For n = 0 To oDocument.Drawpages.count-1
  For m = 0 To oDocument.Drawpages.GetbyIndex(n).Count - 1
   WriteStringtoLogFile(oDocument.DrawPages.GetbyIndex(n).GetbyIndex(m).Text.String)
  Next m
 Next n
End Sub


' ***********************************************Writer documents**************************************************

Sub GetParagraphTexts(oParaObject as Object, HeadLine as String)
Dim ParaEnum as Object
Dim oPara as Object
Dim oTextPortEnum as Object
Dim oTextPortion as Object
Dim i as integer
Dim oCellNames()
Dim oCell as Object

 MakeLogHeadLine(HeadLine)
 ParaEnum = oParaObject.Text.CreateEnumeration

 While ParaEnum.HasMoreElements
  oPara = ParaEnum.NextElement

  ' Note: The enumeration ParaEnum lists all tables and paragraphs.
  ' Therefore we have to find out what kind of object "oPara" actually is
  If oPara.supportsService("com.sun.star.text.Paragraph") Then
   ' "oPara" is a Paragraph
   oTextPortEnum = oPara.createEnumeration
   While oTextPortEnum.hasmoreElements
    oTextPortion = oTextPortEnum.nextElement()
    WriteStringToLogFile(oTextPortion.String)
   Wend
  Else
   ' "oPara" is a table
   oCellNames = oPara.CellNames
   For i = 0 To Ubound(oCellNames())
    If oCellNames(i) <> "" Then
     oCell = oPara.getCellByName(oCellNames(i))
     WriteStringToLogFile(oCell.String)
    End If
   Next
  End If
 Wend
End Sub


Sub GetChartStrings(oSheet as Object, HeaderLine as String)
Dim i as Integer
Dim aChartObject as Object
Dim aChartDiagram as Object

 MakeLogHeadLine(HeaderLine)

 For i = 0 to oSheet.Charts.Count-1
  aChartObject = oSheet.Charts.GetByIndex(i).EmbeddedObject
  If aChartObject.HasSubTitle then
   WriteStringToLogFile(aChartObject.SubTitle.String)
  End If

  If aChartObject.HasMainTitle then
   WriteStringToLogFile(aChartObject.Title.String)
  End If

  aChartDiagram = aChartObject.Diagram

  If aChartDiagram.hasXAxisTitle Then
   WriteStringToLogFile(aChartDiagram.XAxisTitle)
  End If

  If aChartDiagram.hasYAxisTitle Then
   WriteStringToLogFile(aChartDiagram.YAxisTitle)
  End If

  If aChartDiagram.hasZAxisTitle Then
   WriteStringToLogFile(aChartDiagram.ZAxisTitle)
  End If
 Next i
End Sub


Sub GetFrameTexts()
Dim i as integer
Dim oTextFrame as object
Dim oFrameEnum as Object
Dim oFramePort as Object
Dim oFrameTextEnum as Object
Dim oFrameTextPort as Object

 MakeLogHeadLine("Text Frames")
 For i = 0 to oDocument.TextFrames.Count-1
  oTextFrame = oDocument.TextFrames.GetbyIndex(i)
  WriteStringToLogFile(oTextFrame.Name)

  ' Is the frame bound to the page?
  If oTextFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE Then
   GetParagraphTexts(oTextFrame, "Text Frame Contents")
  End If

  oFrameEnum = oTextFrame.CreateEnumeration
  While oFrameEnum.HasMoreElements
   oFramePort = oFrameEnum.NextElement
   If oFramePort.supportsService("com.sun.star.text.Paragraph") then
    oFrameTextEnum = oFramePort.createEnumeration
    While oFrameTextEnum.HasMoreElements
     oFrameTextPort = oFrameTextEnum.NextElement
     If oFrameTextPort.SupportsService("com.sun.star.text.TextFrame") Then
      WriteStringtoLogFile(oFrameTextPort.String)
     End If
    Wend
   Else
    WriteStringtoLogFile(oFramePort.Name)
   End if
  Wend
 Next
End Sub


Sub GetTextFieldStrings()
Dim aTextField as Object
Dim i as integer
Dim CurElement as Object
 MakeLogHeadLine("Text Fields")
 aTextfield = oDocument.getTextfields.CreateEnumeration
 While aTextField.hasmoreElements
  CurElement = aTextField.NextElement
  If CurElement.PropertySetInfo.hasPropertybyName("Content") Then
   WriteStringtoLogFile(CurElement.Content)
  ElseIf CurElement.PropertySetInfo.hasPropertybyName("PlaceHolder") Then
   WriteStringtoLogFile(CurElement.PlaceHolder)
   WriteStringtoLogFile(CurElement.Hint)
  ElseIf Curelement.TextFieldMaster.PropertySetInfo.HasPropertybyName("Content") then
   WriteStringtoLogFile(CurElement.TextFieldMaster.Content)
  End If
 Wend
End Sub


Sub GetLinkedFileNames()
Dim oDocSections as Object
Dim LinkedFileName as String
Dim i as Integer
 If Right(oDocument.URL,3) = "sgl" Then
  MakeLogHeadLine("Sub-documents")
  oDocSections = oDocument.TextSections
  For i = 0 to oDocSections.Count - 1
   LinkedFileName = oDocSections.GetbyIndex(i).FileLink.FileURL
   If LinkedFileName <> "" Then
    WriteStringToLogFile(LinkedFileName)
   End If
  Next i
 End If
End Sub


Sub GetSectionNames()
Dim i as integer
Dim oDocSections as Object
 MakeLogHeadLine("Sections")
 oDocSections = oDocument.TextSections
 For i = 0 to oDocSections.Count-1
  WriteStringtoLogFile(oDocSections.GetbyIndex(i).Name)
 Next
End Sub


Sub GetWriterStrings()
 GetParagraphTexts(oDocument, "Document Body")
 GetGraphicNames()
 GetStyles()
 GetControlStrings(oDocument.DrawPage, "Controls")
 GetTextFieldStrings()
 GetSectionNames()
 GetFrameTexts()
 GetHyperLinks
 GetLinkedFileNames()
End Sub


' ***********************************************Draw/Impress documents**************************************************

Sub GetDrawPageTitles(LocObject as Object)
Dim n as integer
Dim oPage as Object

 For n = 0 to LocObject.Count - 1
  oPage = LocObject.GetbyIndex(n)
  WriteStringtoLogFile(oPage.Name)
  ' Is the page a DrawPage and not a MasterPage?
  If oPage.supportsService("com.sun.star.drawing.DrawPage")then
   ' Get the name of the NotesPage (only relevant for Impress documents)
   If oDocument.supportsService("com.sun.star.presentation.PresentationDocument") then
    WriteStringtoLogFile(oPage.NotesPage.Name)
   End If
  End If
 Next
End Sub


Sub GetPageStrings(oPages as Object)
Dim m, n, s as Integer
Dim oPage, oPageElement, oShape as Object
 For n = 0 to oPages.Count-1
  oPage = oPages.GetbyIndex(n)
  If oPage.HasElements then
   For m = 0 to oPage.Count-1
    oPageElement = oPage.GetByIndex(m)
    If HasUnoInterfaces(oPageElement,"com.sun.star.container.XIndexAccess") Then
     ' The Object "oPageElement" a group of Shapes, that can be accessed by their index
     For s = 0 To oPageElement.Count - 1
      WriteStringToLogFile(oPageElement.GetByIndex(s).String)
     Next s
    ElseIf HasUnoInterfaces(oPageElement, "com.sun.star.text.XText") Then
     WriteStringtoLogFile(oPageElement.String)
    End If
   Next
  End If
 Next
End Sub


Sub GetDrawStrings()
Dim oDPages, oMPages as Object

 oDPages = oDocument.DrawPages
 oMPages = oDocument.Masterpages

 MakeLogHeadLine("Titles")
 GetDrawPageTitles(oDPages)
 GetDrawPageTitles(oMPages)

 MakeLogHeadLine("Document Body")
 GetPageStrings(oDPages)
 GetPageStrings(oMPages)
End Sub


' ***********************************************Misc**************************************************

Sub GetDocumentProps()
Dim oDocuProps as Object
 MakeLogHeadLine("Document Properties")
 oDocuProps = oDocument.DocumentProperties
 WriteStringToLogFile(oDocuProps.Title)
 WriteStringToLogFile(oDocuProps.Description)
 WriteStringToLogFile(oDocuProps.Subject)
 WriteStringToLogFile(oDocuProps.Author)
 ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.ReplyTo)
 ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.Recipient)
 ' WriteStringToLogFile(oDocuProps.UserDefinedProperties.References)
 ' WriteStringToLogFile(oDocuProps.Keywords)
End Sub


Sub GetHyperlinks()
Dim i as integer
Dim oCrsr as Object
Dim oAllHyperLinks as Object
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
Dim oSearchDesc as Object

 MakeLogHeadLine("Hyperlinks")
 ' create a Search-Descriptor
 oSearchDesc = oDocument.CreateSearchDescriptor
 oSearchDesc.Valuesearch = False

 ' define the Search-attributes
 srchattributes(0).Name = "HyperLinkURL"
 srchattributes(0).Value = ""
 oSearchDesc.SetSearchAttributes(SrchAttributes())

 oAllHyperLinks = oDocument.findAll(oSearchDesc())

 For i = 0 to oAllHyperLinks.Count - 1
  oFound = oAllHyperLinks(i)
  oCrsr = oFound.Text.createTextCursorByRange(oFound)
  WriteStringToLogFile(oCrs.HyperLinkURL)  'Url
  WriteStringToLogFile(oCrs.HyperLinkTarget) 'Name
  WriteStringToLogFile(oCrs.HyperLinkName) 'Frame
 Next i
End Sub


Sub GetGraphicNames()
Dim i as integer
Dim oDocGraphics as Object
 MakeLogHeadLine("Graphics")
 oDocGraphics = oDocument.GraphicObjects
 For i = 0 to oDocGraphics.count - 1
  WriteStringtoLogFile(oDocGraphics.GetbyIndex(i).Name)
 Next
End Sub


Sub GetStyles()
Dim m,n as integer
 MakeLogHeadLine("User-defined Templates")

 ' Check all StyleFamilies(i.e. PageStyles, ParagraphStyles, CharacterStyles, cellStyles)
 For n = 0 to oDocument.StyleFamilies.Count - 1
  For m = 0 to oDocument.StyleFamilies.getbyIndex(n).Count-1
   If oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).IsUserDefined then
    WriteStringtoLogFile(oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).Name)
   End If
  Next
 Next
End Sub


Sub GetControlStrings(oDPage as Object, HeaderLine as String)
Dim aForm as Object
Dim m,n as integer
 MakeLogHeadLine(HeaderLine)
 'SearchFor all possible Controls
 For n = 0 to oDPage.Forms.Count - 1
  aForm = oDPage.Forms(n)
  For m = 0 to aForm.Count-1
   GetControlContent(aForm.GetbyIndex(m))
  Next
 Next
End Sub


Sub GetControlContent(LocControl as Object)
Dim i as integer

 If LocControl.PropertySetInfo.HasPropertybyName("Label") then
  WriteStringtoLogFile(LocControl.Label)

 ElseIf LocControl.SupportsService("com.sun.star.form.component.ListBox") then
  For i = 0 to Ubound(LocControl.StringItemList())
   WriteStringtoLogFile(LocControl.StringItemList(i))
  Next
 End If
 If LocControl.PropertySetInfo.HasPropertybyName("HelpText") then
  WriteStringtoLogFile(LocControl.Helptext)
 End If
End Sub

' ***********************************************Log document**************************************************

Sub WriteStringtoLogFile( sString as String)
 If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then
  LogArray(LogIndex) = sString
  LogIndex = LogIndex + 1
  oLogText.insertString(oLogCursor,sString,False)
  oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
 End If
End Sub


Sub MakeLogHeadLine(HeadText as String)
 oLogCursor.CharStyleName = "Log Header"
 oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
 oLogText.insertString(oLogCursor,HeadText,False)
 oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
 oLogCursor.CharStyleName = "Log Body"
End Sub
</script:module>