Quelle  Test_10er.xml   Sprache: XML

<?xml version="1.0" encoding="UTF-8"?>
<!--
 * 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 .
 -->
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Test_10er" script:language="StarBasic">REM  10er Test

const sSWLogFileName = "swlog.dat", sSCLogFileName = "sclog.dat"
const sSDLogFileName = "sdlog.dat", sSMathLogFileName = "smalog.dat"
const sSChartLogFileName = "schlog.dat"
const sSHptLogFileName = "shptlog.dat"
const sSDrawLogFileName = "sdrwlog.dat", sJavaLogFileName = "javalog.dat"
const sSDBLogFileName = "dblog.dat", sExtLogFileName = "extlog.dat"
const sTestGlueLogFileName = "testclosure.log"
const sLogFileName = "smoketest.log"
const cTempFileName = "smoketest_file"

const cMessageSaveOpen8Doc = "Save/Open open Documents (8.0)"
const cMessageNewDoc = "New Document"
const cMessageCloseDoc = "Close Document"
const cMessageRunMacros = "Run Macros"

Global sWorkPath$
Global sWorkPathURL$
Global LocalTestLog%
Global GlobalTestLog%

Sub Main
    call TestAllDocs()
end Sub

Sub DeleteAllSavedFiles()
    Dim sFileName as String
    sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter)
    If FileExists (sFileName) then
        Kill (sFileName)
    End If
    sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc)
    If FileExists (sFileName) then
        Kill (sFileName)
    End If
    sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress)
    If FileExists (sFileName) then
        Kill (sFileName)
    End If
    sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw)
    If FileExists (sFileName) then
        Kill (sFileName)
    End If
    sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmHyperText)
    If FileExists (sFileName) then
        Kill (sFileName)
    End If
End Sub

Sub DeleteAllLogFiles()
    If FileExists (sWorkPath+sLogFileName) then
        Kill (sWorkPath+sLogFileName)
    End If
    If FileExists (sWorkPath+sSWLogFileName) then
        Kill (sWorkPath+sSWLogFileName)
    End If
    If FileExists (sWorkPath+sSCLogFileName) then
        Kill (sWorkPath+sSCLogFileName)
    End If
    If FileExists (sWorkPath+sSDLogFileName) then
        Kill (sWorkPath+sSDLogFileName)
    End If
    If FileExists (sWorkPath+sSMathLogFileName) then
        Kill (sWorkPath+sSMathLogFileName)
    End If
    If FileExists (sWorkPath+sSChartLogFileName) then
        Kill (sWorkPath+sSChartLogFileName)
    End If
    If FileExists (sWorkPath+sSHptLogFileName) then
        Kill (sWorkPath+sSHptLogFileName)
    End If
    If FileExists (sWorkPath+sSDrawLogFileName) then
        Kill (sWorkPath+sSDrawLogFileName)
    End If
    If FileExists (sWorkPath+sJavaLogFileName) then
        Kill (sWorkPath+sJavaLogFileName)
    End If
    If FileExists (sWorkPath+sTestGlueLogFileName) then
        Kill (sWorkPath+sTestGlueLogFileName)
    End If
    If FileExists (sWorkPath+sSDBLogFileName) then
        Kill (sWorkPath+sSDBLogFileName)
    End If
    If FileExists (sWorkPath+sExtLogFileName) then
        Kill (sWorkPath+sExtLogFileName)
    End If
end Sub

Function OpenLogDat (sFileName as String) as Integer
    Dim LocaleFileChannel%
    If FileExists (sWorkPath+sFileName) then
        Kill (sWorkPath+sFileName)
    End If
    LocaleFileChannel% = Freefile
    Open sWorkPath+sFileName For Output As LocaleFileChannel%
    OpenLogDat = LocaleFileChannel%
end Function

Sub SetupWorkPath
    Dim configManager as Object
    configManager = CreateUnoService( "com.sun.star.config.SpecialConfigManager" )

    sWorkPath = configManager.SubstituteVariables( "$(userpath)/temp/" )
    sWorkPathURL = configManager.SubstituteVariables( "$(userurl)/temp/" )
End Sub

Function GetSystem (sTmpWorkPath as string) as string
    GetSystem = ""
    if InStr (sTmpWorkPath, ":") then
        GetSystem = "windows"
    else
        GetSystem = "unix"
    End If
end Function

Function ConvertPathToWin (sTmpWorkPath as string) as string
    for i%=1 to Len(sTmpWorkPath)
        sTemp = Mid (sTmpWorkPath, i%, 1)
        if sTemp = "/" then
            sTmpWorkPath = Left (sTmpWorkPath, i%-1) + "\" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%)
        else
            if sTemp = "|" then
                sTmpWorkPath = Left (sTmpWorkPath, i%-1) + ":" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%)
            end If
        end If
    next i%
    ConvertPathToWin = sTmpWorkPath
end Function

Sub TestAllDocs()
DIM sDocURL as String, sDocPath as String
DIM nStrPos as Long

    'search ExtensionURL
    sDocURL = gOutputDoc.URL
    CompatibilityMode(true)
    nStrPos = InStrRev (sDocURL, "/" )
    CompatibilityMode(false)
    sExtensionURL = Left (sDocURL, nStrPos) + "../Extension/" + cExtensionFileName

    GlobalTestLog = OpenLogDat (sLogFileName)
    call WriteTestSequence

    ' Do extension test first to avoid OOM with ASAN
    if bMakeExtensionTest then
    gCurrentDocTest = frmExtension
        call Test_Ext.TestExtensions
    end if

    if bMakeWriterTest then
    gCurrentDocTest = frmWriter
        call MakeDocTest
    end if
    if bMakeCalcTest then
    gCurrentDocTest = frmCalc
        call MakeDocTest
    end if
    if bMakeImpressTest then
    gCurrentDocTest = frmImpress
        call MakeDocTest
    end if
    if bMakeDrawTest then
    gCurrentDocTest = frmDraw
        call MakeDocTest
    end if
    if bMakeHTMLTest then
    gCurrentDocTest = frmHyperText
        call MakeDocTest
    end if
    if bMakeChartTest then
    gCurrentDocTest = frmChart
        call MakeChartTest
    end if
    if bMakeMathTest then
    gCurrentDocTest = frmMath
        call MakeNewDoc
    end if
    if bMakeJavaTest then
    gCurrentDocTest = frmJava
        call TestJava
    end if
    if bMakeDBTest then
    gCurrentDocTest = frmDataBase
        call Test_DB.TestDB
    end if

    Close #GlobalTestLog
    GlobalTestLog = 0
end Sub

Sub WriteTestSequence
    Print #GlobalTestLog, "Sequence of testing"

    if bMakeExtensionTest then
        WriteExtensionTests ("Extension   : ", GlobalTestLog)
    if bMakeWriterTest then
        WriteTests ("writer  : ", true, GlobalTestLog)
    end if
    if bMakeCalcTest then
        WriteTests ("calc    : ", true, GlobalTestLog)
    end if
    if bMakeImpressTest then
        WriteTests ("impress : ", true, GlobalTestLog)
    end if
    if bMakeDrawTest then
        WriteTests ("draw    : ", true, GlobalTestLog)
    end if
    if bMakeHTMLTest then
        WriteTests ("HTML    : ", true, GlobalTestLog)
    end if
    if bMakeChartTest then
        WriteTests ("chart   : ", false, GlobalTestLog)
    end if
    if bMakeMathTest then
        WriteTests ("math    : ", false, GlobalTestLog)
    end if
    if bMakeJavaTest then
        WriteTests ("Java    : ", false, GlobalTestLog)
    end if
    if bMakeDBTest then
        WriteDBTests ("Database    : ", GlobalTestLog)
    end if
  end if

  Print #GlobalTestLog, "testclosure : setup, write_status"

  Print #GlobalTestLog
  end Sub

  Sub WriteTests (sText as string, bTestAll as boolean)
  Dim sWriteStr as string

  sWriteStr = sText
  sWriteStr = sWriteStr + "new"
    if bTestAll then
    if bMakeSaveOpen8Test then
        sWriteStr = sWriteStr + ", save 8.0"
    end if
    if bMakeSaveOpen8Test then
        sWriteStr = sWriteStr + ", open 8.0"
    end if
    if bMakeMacrosTest then
        sWriteStr = sWriteStr + ", run macros"
    end if
    end if

    sWriteStr = sWriteStr + ", close"

    Print #GlobalTestLog, sWriteStr
end Sub

Sub WriteDBTests (sText as string, nFileChannel as integer)
    Dim sWriteStr as string

    sWriteStr = sText
    sWriteStr = sWriteStr + "open / services"
    sWriteStr = sWriteStr + ", insert"
    sWriteStr = sWriteStr + ", delete"
    sWriteStr = sWriteStr + ", seek"
    sWriteStr = sWriteStr + ", close"

    Print #nFileChannel, sWriteStr
end Sub

Sub WriteExtensionTests (sText as string, nFileChannel as integer)
    Dim sWriteStr as string

    sWriteStr = sText
    sWriteStr = sWriteStr + "services"
    sWriteStr = sWriteStr + ", install"
    sWriteStr = sWriteStr + ", uninstall"

    Print #nFileChannel, sWriteStr
end Sub

Sub MakeDocTest
    Dim oDoc as Object
    Dim sFileNameXML$, sFileName8$
    Dim bSuccess as Boolean

    On Local Error GoTo DOCTESTERROR
    gCurrentTestCase = cLogfileFailed
    LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest))
    gCurrentTestCase = cDocNew
    oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc))
    LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) )
    if not IsNull (oDoc) then
        gCurrentTestCase = cDocSaveOpen8
        if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then
            sFileName8 = sWorkPathURL+cTempFileName+"."+GetDocEndings(gCurrentDocTest or cFlt8)
            SaveDoc (sFileName8, oDoc, GetDocFilter(gCurrentDocTest or cFlt8))
        end if
        gCurrentTestCase = cDocClose
        bSuccess = CloseDoc( oDoc )
        LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess )
        gCurrentTestCase = cDocSaveOpen8
        if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then
            oDoc = LoadDoc (sFileName8)

'          oDoc = Documents.open(sFileName)
            LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, not IsNull (oDoc) )

            if not IsNull (oDoc) then
                gCurrentTestCase = cDocClose
                oDoc.close (true)
            end If
        end if

        gCurrentTestCase = cDocMacros
 ' Just one calc macro test for now
 ' To-Do split this into its own per-module/test .xml and add more
        if bMakeMacrosTest and gCurrentDocTest = frmCalc then
            oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc))
            oDocCtrl = oDoc.getCurrentController()
            oDocFrame = oDocCtrl.getFrame()
            oDispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

            dim args(0) as new com.sun.star.beans.PropertyValue

            args(0).Name = "ToPoint"
            args(0).Value = "$A$1"
            oDispatcher.executeDispatch(oDocFrame, ".uno:GoToCell", "", 0, args())
            args(0).Name = "By"
            args(0).Value = 5
            oDispatcher.executeDispatch(oDocFrame, ".uno:GoRightSel", "", 0, args())
            args(0).Name = "By"
            args(0).Value = 5
            oDispatcher.executeDispatch(oDocFrame, ".uno:GoDownSel", "", 0, args())

            oRangeAddr = oDoc.getCurrentSelection().getRangeAddress()

            bResult = oRangeAddr.StartColumn = 0 and oRangeAddr.EndColumn = 5 and oRangeAddr.StartRow = 0 and oRangeAddr.EndRow = 5

            LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageRunMacros, bResult )

            if not IsNull (oDoc) then
                gCurrentTestCase = cDocClose
                oDoc.close (true)
            end If
        end if

    end If
    Print #LocalTestLog, "---"
    Close #LocalTestLog%
    LocalTestLog = 0
    Exit Sub ' Without error

    DOCTESTERROR:
    If ( gCurrentTestCase = cLogfileFailed ) then
        LogTestResult( " ", False )
        Exit Sub
    else
        LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False )
        Close #LocalTestLog%
        LocalTestLog = 0
    End If
    Exit Sub ' With error
End Sub

Sub MakeNewDoc
    DIM oDoc as Object
    Dim bSuccess as Boolean
    On Local Error GoTo DOCTESTERROR2
    gCurrentTestCase = cLogfileFailed
    LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest))
    gCurrentTestCase = cDocNew
'  oDoc = Documents.Add(GetDocFilter(gCurrentDocTest))
    oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc))
    LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) )
    if not IsNull (oDoc) then
        gCurrentTestCase = cDocClose
        bSuccess = CloseDoc( oDoc )
        LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess )
    end If
    Print #LocalTestLog, "---"
    Close #LocalTestLog%
    LocalTestLog = 0
    Exit Sub ' Without error

    DOCTESTERROR2:
    If ( gCurrentTestCase = cLogfileFailed ) then
        LogTestResult( " ", False )
        Exit Sub
    else
        LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False )
        Close #LocalTestLog%
        LocalTestLog = 0
    End If
    Exit Sub ' With error
End Sub

Sub MakeChartTest
    Dim oCharts as Object
    Dim oDoc as Object
    Dim oRange(0) as New com.sun.star.table.CellRangeAddress
    Dim oRect as New com.sun.star.awt.Rectangle
    const cChartName="TestChart"
  Dim bSuccess as Boolean
  On Local Error GoTo CHARTTESTERROR
  gCurrentTestCase = cLogfileFailed
  LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest))
  gCurrentTestCase = cDocNew
  oDoc = LoadDoc ("private:factory/" + GetDocFilter(frmCalc or cFltNewDoc))
    if not IsNull (oDoc) then
        oCharts = oDoc.sheets(0).Charts
        oCharts.AddNewByName (cChartName, oRect, oRange(), true, true)
        bSuccess=oCharts.HasByName(cChartName)
        LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, bSuccess )
        gCurrentTestCase = cDocClose
        oDoc.close (true)
    else
        LogTestResult( GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, FALSE )
    End if
    Print #LocalTestLog, "---"
    Close #LocalTestLog%
    LocalTestLog = 0
    Exit Sub ' Without error

    CHARTTESTERROR:
    If ( gCurrentTestCase = cLogfileFailed ) then
        LogTestResult( " ", False )
        Exit Sub
    else
        LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), FALSE )
        Close #LocalTestLog%
        LocalTestLog = 0
    End If
    Exit Sub ' With error
End Sub

Sub LogState (bState as Boolean, sText as String, nLocaleFileChannel as integer)
    if bState then
        Print #nLocaleFileChannel, sText+" -> ok"
    else
        Print #nLocaleFileChannel, sText+" -> error"
    end If
end Sub

Function GetDocEndings (DocType as Integer) as String
    Select Case ( DocType )
        case frmWriter or cFlt8
            GetDocEndings = "odt" ' Textdokument
        case frmCalc or cFlt8
            GetDocEndings = "ods" 'Tabellendokument
        case frmImpress or cFlt8
            GetDocEndings = "odp" 'PrÕsentation
        case frmDraw or cFlt8
            GetDocEndings = "odg" 'Zeichen
        case frmHyperText, frmHyperText or cFltXML
            GetDocEndings = "html" 'Hypertext-Dokument
        case frmWriter or cFltXML
            GetDocEndings = "sxw" ' Textdokument
        case frmCalc or cFltXML
            GetDocEndings = "sxc" 'Tabellendokument
        case frmImpress or cFltXML
            GetDocEndings = "sxi" 'PrÕsentation
        case frmDraw or cFltXML
            GetDocEndings = "sxd" 'Zeichen
        case else
            GetDocEndings = ""
    end Select
end Function

Function GetDocFilter (DocType as Integer) as String
    Select Case ( DocType )
        case frmWriter or cFlt8
            GetDocFilter = "writer8" ' text document
        case frmCalc or cFlt8
            GetDocFilter = "calc8" ' spreadsheet document
        case frmImpress or cFlt8
            GetDocFilter = "impress8" ' presentation
        case frmDraw or cFlt8
            GetDocFilter = "draw8" ' drawing
        case frmMath or cFlt8
            GetDocFilter = "math8" ' formula

        case frmWriter or cFltXML
            GetDocFilter = "StarOffice XML (Writer)" ' text document
        case frmCalc or cFltXML
            GetDocFilter = "StarOffice XML (Calc)" ' spreadsheet document
        case frmImpress or cFltXML
            GetDocFilter = "StarOffice XML (Impress)" ' presentation
        case frmDraw or cFltXML
            GetDocFilter = "StarOffice XML (Draw)" ' drawing
        case frmMath or cFltXML
            GetDocFilter = "StarOffice XML (Math)" ' formula

        case frmHyperText, frmHyperText or cFltXML
            GetDocFilter = "HTML" ' HTML document

        case frmWriter or cFltNewDoc
            GetDocFilter = "swriter" ' text document
        case frmCalc or cFltNewDoc
            GetDocFilter = "scalc" ' spreadsheet document
        case frmImpress or cFltNewDoc
            GetDocFilter = "simpress" ' presentation
        case frmDraw or cFltNewDoc
            GetDocFilter = "sdraw" ' drawing
        case frmMath or cFltNewDoc
            GetDocFilter = "smath" ' formula
        case frmHyperText or cFltNewDoc
            GetDocFilter = "swriter/web" ' HTML document
        case frmChart or cFltNewDoc
            GetDocFilter = "schart" ' chart
        case else
            GetDocFilter = ""
    end Select
end Function

Function GetLogFileName (DocType as Integer) as String
    Select Case ( DocType )
        case frmWriter
            GetLogFileName = sSWLogFileName ' text document
        case frmCalc
            GetLogFileName = sSCLogFileName ' spreadsheet document
        case frmImpress
            GetLogFileName = sSDLogFileName ' presentation
        case frmDraw
            GetLogFileName = sSDrawLogFileName ' drawing
        case frmMath
            GetLogFileName = sSMathLogFileName ' formula
        case frmHyperText
            GetLogFileName = sSHptLogFileName ' HTML document
        case frmChart
            GetLogFileName = sSChartLogFileName ' chart
        case frmJava
            GetLogFileName = sJavaLogFileName 'Java
        case frmTestClosure
            GetLogFileName = sTestGlueLogFileName ' test framework
        case frmDataBase
            GetLogFileName = sSDBLogFileName 'Database
        case frmExtension
            GetLogFileName = sExtLogFileName 'Extension
        case else
            GetLogFileName = ""
    end Select
end Function

Function GetErrorMessageOnAction (nAction as Integer) as String
    Select Case ( nAction )
        case cDocNew
            GetErrorMessageOnAction = cMessageNewDoc
        case cDocSaveOpen8
            GetErrorMessageOnAction = cMessageSaveOpen8Doc
        case cDocMacros
            GetErrorMessageOnAction = cMessageRunMacros
        case cDocClose
            GetErrorMessageOnAction = cMessageCloseDoc
        case else
            GetErrorMessageOnAction = ""
    end Select
end Function

Function IsFilterAvailable (FilterType as Integer) as boolean
    IsFilterAvailable = true
    if (FilterType = (frmHyperText or cFltXML)) then
        IsFilterAvailable = false
    end if
End Function

Function TestJava
    Dim oObj as Object
    gCurrentTestCase = cLogfileFailed
    LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest))
    gCurrentTestCase = cDocNew
    oObj = createUnoService( cUnoJavaLoader )
    LogTestResult( "Java "+ cMessageNewDoc, not IsNull (oObj) )

    Print #LocalTestLog, "---"
    Close #LocalTestLog%
    LocalTestLog = 0

    TestJava = not IsNull (oObj)
End Function

Sub LoadLibrary( LibName as String )

    dim args(1)
    dim arg as new com.sun.star.beans.PropertyValue
    arg.Name = "LibraryName"
    arg.Value = LibName
    args(0) = arg

    dim url as new com.sun.star.util.URL
    dim trans as object
    trans = createUnoService("com.sun.star.util.URLTransformer" )
    url.Complete = "slot:6517"
    trans.parsestrict( url )

    dim disp as object
    disp = StarDesktop.currentFrame.queryDispatch( url, "", 0 )
    disp.dispatch( url, args() )

End Sub

Sub LoadDoc (DocName as String) as Object
    dim trans as object
    trans = createUnoService("com.sun.star.util.URLTransformer" )
    url = createUnoStruct("com.sun.star.util.URL" )
    url.Complete = DocName
    if Left(DocName, 5 ) <> "file:" then
    trans.parsestrict( url )
    endif

    Dim aPropArray(0) as Object
    aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")
    aPropArray(0).Name = "OpenFlags"
    aPropArray(0).Value = "S"

    dim doc as object
    dim noargs()
    doc = StarDesktop.loadComponentFromURL( url.Complete, "_blank", 0, aPropArray() ) ' XModel
    LoadDoc = doc
End Sub

Sub SaveDoc (DocName as String, oDoc as Object, sFilterName as string )
    dim trans as object
    trans = createUnoService("com.sun.star.util.URLTransformer" )
    url = createUnoStruct("com.sun.star.util.URL" )
    url.Complete = DocName
    if Left(DocName, 5 ) <> "file:" then
    trans.parsestrict( url )
    endif

    if not (sFilterName = "") then
        Dim aPropArray(0) as Object
        aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")
        aPropArray(0).Name = "FilterName"
        aPropArray(0).Value = sFilterName

        oDoc.storeAsURL( url.Complete, aPropArray() )
    else
        MessageBox "Filtername is unknown!"
    end if
end Sub

Function CloseDoc( oDoc as Object )
  Dim oListener as Object
  oListener = CreateUnoListener( "Events.closeListener_", "com.sun.star.util.XCloseListener" )
  oDoc.addCloseListener( oListener )

  Events.ResetCloseListenerFlag()
  oDoc.close( true )
  closeDoc = Events.HasCloseListenerBeenCalled()

  if ( Not Events.HasCloseListenerBeenCalled() ) Then
    ' do this only if closing was not successful - otherwise, we'd get a DisposedException
    oDoc.removeCloseListener( oListener )
  End If
End Function
</script:module>