REM ***** BASIC ***** const cMaxErrorStates = 14 const cCoGreen = 4057917, cCoRed = 16711680, cCoGrey = 12632256 const cParagraphBreak = 0 global const cExtensionFileName = "TestExtension.oxt" global const cDocNew = 0, cDocSaveOpen8 = 1, cDocSaveOpenXML = 2, cDocClose = 3 global const cDBService = 0, cDBOpen = 1, cDBInsert = 2, cDBDelete = 3, cDBSeek = 4, cDBClose = 5 global const cEXTService = 0, cEXTInstall = 1, cEXTUninstall = 2 global const cTestClosureSetupDoc = 0, cTestClosureWriteStatus = 1 global const cLogfileFailed = 255 global const cStWriter = 0, cStCalc = 1, cStPraesentation = 2, cStZeichnen = 3 global const cStHTML = 6, cStChart = 4, cStJava = 7 global const cStMath = 5, cStDataBase = 9 global const cStExtension = 11 global const cStTestGlue = 12 global const cStNone = -1 global const cFlt8 = 0, cFlt50 = 32, cFltNewDoc = 64, cFltXML = 128 global const frmWriter = 1, frmCalc = 2, frmImpress = 4 global const frmMath = 5, frmChart = 7, frmHyperText = 8, frmDraw = 9 global const frmDataBase = 10, frmJava = 13 global const frmExtension = 14 global const frmTestClosure = 15 Global gCurrentDocTest As Integer Global gCurrentTestCase As Integer global const cLogUnknown = 0, cLogFalse = 1, cLogTrue = 2 'UserFieldKennungen Global const cYes = "y", cNo = "n" Global const cStateNo = 0, cStateYes = 1 'Feldtypen Global const cFtExtUser = 21, cFtPageNum = 5, cFtStatistic = 8, cFtDateTime = 27, cFtDatabase = 31 'UnoStrings Global const cUnoSeparator = "." Global const cUnoPrefix = "com.sun.star." Global const cUnoUserField = cUnoPrefix + "text.FieldMaster.User" Global const cUnoExtUserField = cUnoPrefix + "text.TextField.ExtendedUser" Global const cUnoMasterDataBase = cUnoPrefix + "text.FieldMaster.Database" Global const cUnoDataBase = cUnoPrefix + "text.TextField.Database" Global const cUnoDateTime = cUnoPrefix + "text.TextField.DateTime" Global const cUnoTextGraphi2 = cUnoPrefix + "text.Graphic" Global const cUnoJavaLoader = cUnoPrefix + "loader.Java" Global const cUnoDatabaseContext = cUnoPrefix + "sdb.DatabaseContext" Global const cUnoRowSet = cUnoPrefix + "sdb.RowSet" Global const cUnoSmoketestTestExtension = cUnoPrefix + "comp.smoketest.TestExtension" Global const cUnoSmoketestCommandEnvironment = cUnoPrefix + "deployment.test.SmoketestCommandEnvironment" Global const cExtensionManager = cUnoPrefix + "deployment.ExtensionManager" 'UserFieldNames Global const cUserFieldTestWriter = "Writer", cUserFieldTestCalc = "Calc", cUserFieldTestImpress = "Impress" Global const cUserFieldTestDraw = "Draw", cUserFieldTestMath = "Math", cUserFieldTestChart = "Chart" Global const cUserFieldTestHTML = "HTML", cUserFieldTestJava = "Java", cUserFieldTestDatabase = "Database" Global const cUserFieldTestExtension = "Extension" Global const cUserFieldTestOpenSaveXML = "SaveOpenXML" Global const cUserFieldTestTerminateAfterTest = "Terminate", cUserFieldTestOpenSave8 = "SaveOpen8" Global const cOptionsDialogName = "OptionsDlg", cTest10Modul = "Standard" Global const cDlgCancel = 1, cDlgOk = 0, cDlgStartTest = 2 global gErrorState (cMaxErrorStates, 5) as integer Global gTestCaseAnnotations( cMaxErrorStates, 5 ) As String global gOutputDoc as Object global gOutputDocNotUno as Object global gOptionsDialog as Object Global bMakeWriterTest as boolean, bMakeCalcTest as boolean, bMakeImpressTest as boolean Global bMakeDrawTest as Boolean, bMakeMathTest as boolean, bMakeChartTest as boolean Global bMakeHTMLTest as boolean, bMakeJavaTest as boolean, bMakeDBTest as boolean Global bMakeExtensionTest as boolean Global bMakeSaveOpenXMLTest as boolean Global bMakeTerminateAfterTest as boolean, bShowTable as boolean Global bMakeSaveOpen8Test as boolean global sExtensionURL as string Dim gDlgState as Integer Sub SetGlobalDoc gOutputDoc = ThisComponent end Sub Sub ClearStatus for j% = 0 to cMaxErrorStates for i% = 0 to 5 gErrorState (j%, i%) = cLogUnknown gTestCaseAnnotations( J%, i% ) = "" next i% next j% end Sub Sub ClearAllText call SetGlobalDoc call ClearDoc (gOutputDoc) call ClearStatus end Sub Sub AssertionHandler( sMessage as String ) LogTestResult( "assertion caught: " + sMessage, FALSE ) End Sub Sub Main On Local Error Goto MainError gCurrentDocTest = frmTestClosure gCurrentTestCase = cLogfileFailed DeleteAllSavedFiles() DeleteAllLogFiles() SetupWorkPath() if GetSystem (sWorkPath) = "windows" then sWorkPath = ConvertPathToWin (sWorkPath) end if LocalTestLog% = OpenLogDat( GetLogFileName( gCurrentDocTest ) ) gCurrentTestCase = cTestClosureSetupDoc CaptureAssertions( "AssertionHandler" ) call SetGlobalDoc Dim bWasModified as Boolean bWasModified = gOutputDoc.isModified() if bShowTable then call ClearDoc (gOutputDoc) end If call ClearStatus LogTestResult( GetTestGlueDescription( gCurrentTestCase ), TRUE ) Dim nPreserveFileHandle% nPreserveFileHandle% = LocalTestLog% Call Test_10er.Main LocalTestLog% = nPreserveFileHandle% gCurrentDocTest = frmTestClosure gCurrentTestCase = cTestClosureWriteStatus if bShowTable then call CreateStatusTable2 call CreateStatusTable call CreateDocState LogTestResult( GetTestGlueDescription( gCurrentTestCase ), TRUE ) ' do this LogTestResult call before CreateSecondState, since the latter accesses (and displays) the result call CreateSecondState gOutputDoc.CurrentController.ViewCursor.JumpToFirstPage Else LogTestResult( GetTestGlueDescription( gCurrentTestCase ), TRUE ) End If ' print the 'test complete' marker Print #LocalTestLog%, "---" LocalTestLog% = 0 gOutputDoc.setModified( bWasModified ) CaptureAssertions( "" ) Exit Sub MainError: If ( gCurrentTestCase = cLogfileFailed ) then LogTestResult( "", False ) Exit Sub else LogTestResult( "testclosure " + GetTestGlueDescription( gCurrentTestCase ), FALSE ) Close #LocalTestLog% LocalTestLog = 0 End If End Sub Function GetTestGlueDescription( nTestCase as Integer ) Select Case ( nTestCase ) case cTestClosureSetupDoc GetTestGlueDescription = "setup" case cTestClosureWriteStatus GetTestGlueDescription = "write_status" case Else GetTestGlueDescription = "" End Select End Function Sub CreateStatusTable dim tableHeaders(7) as string tableHeaders(cStWriter) = "Writer" tableHeaders(cStCalc) = "Calc" tableHeaders(cStPraesentation) = "Präsen- tation" tableHeaders(cStZeichnen) = "Zeichn." tableHeaders(cStChart) = "Diagr." tableHeaders(cStMath) = "Math" tableHeaders(cStHTML) = "HTML" tableHeaders(cStJava) = "Java" dim tableRows(3) as string tableRows(cDocNew) = "new" tableRows(cDocSaveOpen8) = "V8.0" tableRows(cDocSaveOpenXML) = "XML" tableRows(cDocClose) = "close" aDoc = gOutputDoc xText = aDoc.Text xCursor = xText.createTextCursor() xCursor.gotoStart(FALSE) xCursor.GoRight (4, False) SetParagraphBreak (xCursor) xCursor.GoRight (1, False) SetParagraphBreak (xCursor) xCursor.GoRight (1, False) table = aDoc.createInstance("com.sun.star.text.TextTable") table.initialize(5,9) table.Name = "StTab1" table.BackColor = cCoGrey xText.insertTextContent(xCursor, table, FALSE) for i% = 0 to 7 tableCell = table.getCellByPosition( i% + 1, 0 ) tableCell.String = tableHeaders( i% ) next i% for i% = LBound( tableRows ) to UBound( tableRows ) tableCell = table.getCellByPosition( 0, i% + 1 ) tableCell.String=tableRows(i%) next i% end Sub Sub CreateStatusTable2 dim tableHeaders(4) as string tableHeaders(0) = "Database" tableHeaders(1) = "" tableHeaders(2) = "Extension" tableHeaders(3) = "" tableHeaders(4) = "Other" dim tableRows(5) as string tableRows(cDBService ) = "services" tableRows(cDBOpen ) = "open" tableRows(cDBInsert ) = "insert" tableRows(cDBDelete ) = "delete" tableRows(cDBSeek ) = "seek" tableRows(cDBClose ) = "close" dim tableRows2(2) as string tableRows2(cEXTService ) = "services" tableRows2(cEXTInstall ) = "install" tableRows2(cEXTUninstall ) = "uninstall" dim tableRows3(1) as string tableRows3(cTestClosureSetupDoc ) = "setup test" tableRows3(cTestClosureWriteStatus ) = "write test result" aDoc = gOutputDoc xText = aDoc.Text xCursor = xText.createTextCursor() xCursor.gotoStart(FALSE) xCursor.GoRight (4, False) SetParagraphBreak (xCursor) SetParagraphBreak (xCursor) xCursor.gotoEnd(FALSE) table = aDoc.createInstance("com.sun.star.text.TextTable") table.initialize(7,6) table.Name = "StTab2" table.BackColor = cCoGrey xText.insertTextContent(xCursor, table, FALSE) for i% = LBound( tableHeaders ) to UBound( tableHeaders ) tableCell = table.getCellByPosition( i% + 1, 0 ) tableCell.String = tableHeaders(i%) next i% for i% = LBound( tableRows ) to UBound( tableRows ) tableCell = table.getCellByPosition( 0, i% + 1 ) tableCell.String=tableRows(i%) next i% for i% = LBound( tableRows2 ) to UBound( tableRows2 ) tableCell = table.getCellByPosition( 2, i% + 1 ) tableCell.String=tableRows2(i%) next i% for i% = LBound( tableRows3 ) to UBound( tableRows3 ) tableCell = table.getCellByPosition( 4, i% + 1 ) tableCell.String=tableRows3(i%) next i% end Sub Sub CreateDocState aDoc = gOutputDoc table = aDoc.TextTables.GetByIndex (1) for j% = 0 to 7 for i% = 0 to 3 sRangeName = GetRangeName(j%, i%+1) tableCursor = table.createCursorByCellName(sRangeName) cName = tableCursor.getRangeName() xCell = table.getCellByName(cName) xCell.BackTransparent = False If gErrorState (j%, i%) = cLogTrue Then xCell.BackColor = cCoGreen else If gErrorState (j%, i%) = cLogFalse Then xCell.BackColor = cCoRed If ( gTestCaseAnnotations( j%, i% ) <> "" ) Then Dim annotation as Object annotation = aDoc.createInstance( "com.sun.star.text.TextField.Annotation" ) annotation.Author = "smoketest" annotation.Content = gTestCaseAnnotations( j%, i% ) xCell.insertTextContent( xCell, annotation, false ) End If else xCell.BackColor = cCoGrey end If end If next i% next j% end Sub Sub CreateSecondState aDoc = gOutputDoc table = aDoc.TextTables.GetByIndex (0) Dim stateIndex(2) as Integer stateIndex(0) = cStDataBase stateIndex(1) = cStExtension stateIndex(2) = cStTestGlue Dim j as Integer For j = LBound( stateIndex ) To UBound( stateIndex ) for i% = 1 to 6 tableCell = table.getCellByPosition( 2 * j + 1, i% ) tableCell.BackTransparent = False if gErrorState( stateIndex(j), i% - 1 ) = cLogTrue then tableCell.BackColor = cCoGreen else if gErrorState ( stateIndex(j), i% - 1 ) = cLogFalse then tableCell.BackColor = cCoRed If ( gTestCaseAnnotations( stateIndex(j), i% - 1 ) <> "" ) Then Dim annotation as Object annotation = aDoc.createInstance( "com.sun.star.text.TextField.Annotation" ) annotation.Author = "smoketest" annotation.Content = gTestCaseAnnotations( stateIndex(j), i% - 1 ) tableCell.insertTextContent( tableCell, annotation, false ) End If else tableCell.BackColor = cCoGrey end If end If next i% next j% end Sub Function GetRangeName (nColumn as integer, nRow as integer) as string GetRangeName = chr (nColumn+66) + Trim(Str(nRow+1)) end Function Sub LogTestResult( sTestCaseDescription as String, bSuccess as Boolean ) If ( gCurrentTestCase = cLogfileFailed ) Then Dim sAnnotation as String sAnnotation = "creating logfile '" + GetLogFileName( gCurrentDocTest ) + "' failed" LogState( FALSE, sAnnotation, GlobalTestLog ) RecordTestCaseStatus( 0, FALSE, sAnnotation ) Else bSuccess = RecordTestCaseStatus( gCurrentTestCase, bSuccess, sTestCaseDescription ) If ( LocalTestLog <> 0 ) Then LogState( bSuccess, sTestCaseDescription, LocalTestLog ) EndIf if ( GlobalTestLog <> 0 ) Then LogState( bSuccess, sTestCaseDescription, GlobalTestLog ) EndIf End If End Sub Function RecordTestCaseStatus( nAction as Integer, bState as Boolean, sFailureAnnotation as String ) as Boolean Dim nStatusType as Integer Dim nState as integer nStatusType = GetStatusType( gCurrentDocTest ) If nStatusType = cStNone then Exit Function If ( gErrorState( nStatusType, nAction ) = cLogFalse ) Then ' don't overwrite a previous "failed" state for this test bState = FALSE End If if bState then nState = cLogTrue else nState = cLogFalse end If gErrorState (nStatusType, nAction) = nState If ( nState = cLogFalse ) And ( sFailureAnnotation <> "" ) Then gTestCaseAnnotations( nStatusType, nAction ) = gTestCaseAnnotations( nStatusType, nAction ) + sFailureAnnotation + chr(13) End If RecordTestCaseStatus = bState End Function Function GetStatusType (nDocType as Integer) as Integer Select Case ( nDocType ) case frmWriter GetStatusType = cStWriter ' text document case frmCalc GetStatusType = cStCalc ' spreadsheet document case frmImpress GetStatusType = cStPraesentation ' presentation case frmDraw GetStatusType = cStZeichnen ' drawing case frmMath GetStatusType = cStMath ' formula case frmHyperText GetStatusType = cStHTML ' HTML document case frmChart GetStatusType = cStChart ' chart case frmJava GetStatusType = cStJava 'Java case frmTestClosure GetStatusType = cStTestGlue ' test framework case frmDataBase GetStatusType = cStDataBase 'DataBase case frmExtension GetStatusType = cStExtension 'Extension case else GetStatusType = cStNone end Select end Function Sub SetParagraphBreak (aCursor as Object) aCursor.Text.InsertControlCharacter (aCursor, cParagraphBreak, True) end Sub Sub ClearDoc (aDoc as Object) Dim aText as Object Dim i% for i%=1 to aDoc.TextTables.count aDoc.TextTables.GetByIndex(0).dispose next aText = aDoc.Text.CreateTextCursor aText.GotoStart (False) aText.GoRight (3, False) SetParagraphBreak (aText) aText.GotoEnd (True) aText.String="" end Sub Sub ClearDocFull (aDoc as Object) Dim aText as Object Dim i% for i%=1 to aDoc.TextTables.count aDoc.TextTables.GetByIndex(0).dispose next aText = aDoc.Text.CreateTextCursor aText.GotoStart (False) aText.GotoEnd (True) aText.String="" end Sub Sub SetGlobalOptionsDialog () Dim oLibContainer As Object, oLib As Object Dim oInputStreamProvider As Object Dim oDialog As Object Const sLibName = cTest10Modul Const sDialogName = cOptionsDialogName REM get library and input stream provider oLibContainer = DialogLibraries REM load the library oLibContainer.loadLibrary( sLibName ) oLib = oLibContainer.getByName( sLibName ) oInputStreamProvider = oLib.getByName( sDialogName ) REM create dialog control gOptionsDialog = CreateUnoDialog( oInputStreamProvider ) end Sub Sub ShowOptionsDlg call SetGlobalDoc call SetGlobalOptionsDialog call GetOptions REM show the dialog gOptionsDialog.execute() ' jetzt läuft der Dialog, bis ein Button gedrückt wird Select Case (gDlgState) case cDlgOk call SetOptions () case cDlgStartTest call SetOptions () call StartTestByOptions () end Select gOptionsDialog.dispose() end Sub Sub SetOptions call SetGlobalDoc SetUserFieldState (cUserFieldTestWriter, -(gOptionsDialog.getControl("cbWriterTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestCalc, -(gOptionsDialog.getControl("cbCalcTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestImpress, -(gOptionsDialog.getControl("cbImpressTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestDraw, -(gOptionsDialog.getControl("cbDrawTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestHTML, -(gOptionsDialog.getControl("cbHTMLTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestMath, -(gOptionsDialog.getControl("cbMathTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestChart, -(gOptionsDialog.getControl("cbChartTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestJava, -(gOptionsDialog.getControl("cbJavaTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestDatabase, -(gOptionsDialog.getControl("cbDatabaseTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestExtension, -(gOptionsDialog.getControl("cbExtensionTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestOpenSaveXML, -(gOptionsDialog.getControl("cbSaveOpenXMLTest").getState), gOutputDoc) SetUserFieldState (cUserFieldTestOpenSave8, -(gOptionsDialog.getControl("cbSaveOpen8Test").getState), gOutputDoc) SetUserFieldState (cUserFieldTestTerminateAfterTest, -(gOptionsDialog.getControl("cbTerminateAfterTest").getState), gOutputDoc) end Sub Sub GetOptions call SetGlobalDoc gOptionsDialog.getControl("cbWriterTest").setState( -( GetUserFieldState (cUserFieldTestWriter, gOutputDoc))) gOptionsDialog.getControl("cbCalcTest").setState ( -( GetUserFieldState (cUserFieldTestCalc, gOutputDoc))) gOptionsDialog.getControl("cbImpressTest").setState( -( GetUserFieldState (cUserFieldTestImpress, gOutputDoc))) gOptionsDialog.getControl("cbDrawTest").setState( -( GetUserFieldState (cUserFieldTestDraw, gOutputDoc))) gOptionsDialog.getControl("cbHTMLTest").setState( -( GetUserFieldState (cUserFieldTestHTML, gOutputDoc))) gOptionsDialog.getControl("cbMathTest").setState( -( GetUserFieldState (cUserFieldTestMath, gOutputDoc))) gOptionsDialog.getControl("cbChartTest").setState( -( GetUserFieldState (cUserFieldTestChart, gOutputDoc))) gOptionsDialog.getControl("cbJavaTest").setState( -( GetUserFieldState (cUserFieldTestJava, gOutputDoc))) gOptionsDialog.getControl("cbDatabaseTest").setState( -( GetUserFieldState (cUserFieldTestDatabase, gOutputDoc))) gOptionsDialog.getControl("cbExtensionTest").setState( -( GetUserFieldState (cUserFieldTestExtension, gOutputDoc))) gOptionsDialog.getControl("cbSaveOpenXMLTest").setState( -( GetUserFieldState (cUserFieldTestOpenSaveXML, gOutputDoc))) gOptionsDialog.getControl("cbSaveOpen8Test").setState( -( GetUserFieldState (cUserFieldTestOpenSave8, gOutputDoc))) gOptionsDialog.getControl("cbTerminateAfterTest").setState( -( GetUserFieldState (cUserFieldTestTerminateAfterTest, gOutputDoc))) End Sub Sub ReadOptions call SetGlobalDoc bMakeWriterTest = GetUserFieldState (cUserFieldTestWriter, gOutputDoc) bMakeCalcTest = GetUserFieldState (cUserFieldTestCalc, gOutputDoc) bMakeImpressTest = GetUserFieldState (cUserFieldTestImpress, gOutputDoc) bMakeDrawTest = GetUserFieldState (cUserFieldTestDraw, gOutputDoc) bMakeHTMLTest = GetUserFieldState (cUserFieldTestHTML, gOutputDoc) bMakeMathTest = GetUserFieldState (cUserFieldTestMath, gOutputDoc) bMakeChartTest = GetUserFieldState (cUserFieldTestChart, gOutputDoc) bMakeJavaTest = GetUserFieldState (cUserFieldTestJava, gOutputDoc) bMakeDBTest = GetUserFieldState (cUserFieldTestDatabase, gOutputDoc) bMakeExtensionTest = GetUserFieldState (cUserFieldTestExtension, gOutputDoc) bMakeSaveOpenXMLTest = GetUserFieldState (cUserFieldTestOpenSaveXML, gOutputDoc) bMakeSaveOpen8Test = GetUserFieldState (cUserFieldTestOpenSave8, gOutputDoc) bMakeTerminateAfterTest = GetUserFieldState (cUserFieldTestTerminateAfterTest, gOutputDoc) end Sub Sub SetDefaultOptions bMakeWriterTest = true bMakeCalcTest = true bMakeImpressTest = true bMakeDrawTest = true bMakeHTMLTest = true bMakeMathTest = true bMakeChartTest = true if Environ("SOLAR_JAVA") = "" then bMakeJavaTest = false bMakeDBTest = false bMakeExtensionTest = false else bMakeJavaTest = true bMakeDBTest = true bMakeExtensionTest = true End If bMakeSaveOpenXMLTest = true REM Disable StarOffice 5.0 tests in case binfilter has not been included bMakeSaveOpen8Test = true bMakeTerminateAfterTest = false end Sub Sub StartTestByOptions bShowTable = true call ReadOptions call Main if bMakeTerminateAfterTest then ClearDocFull (gOutputDoc) gOutputDoc.dispose 'StarDesktop.Terminate 'EnableReschedule( false ) 'DispatchSlot( 5300 ) stop End If end Sub Function StartTestWithDefaultOptions bShowTable = false call SetDefaultOptions call Main dim component(cMaxErrorStates) as string component(cStWriter) = "Writer" component(cStCalc) = "Calc" component(cStPraesentation) = "Impress" component(cStZeichnen) = "Draw" component(cStChart) = "Chart" component(cStMath) = "Math" component(cStHTML) = "HTML" component(cStJava) = "Java" component(cStDataBase) = "Base" component(cStExtension) = "Extensions" dim action(3) as string action(cDocNew) = "new" action(cDocSaveOpen8) = "V8.0" action(cDocSaveOpenXML) = "XML" action(cDocClose) = "close" dim baseAction(5) as string baseAction(cDBService) = "services" baseAction(cDBOpen) = "open" baseAction(cDBInsert) = "insert" baseAction(cDBDelete) = "delete" baseAction(cDBSeek) = "seek" baseAction(cDBClose) = "close" dim extAction(2) as string extAction(cEXTService) = "services" extAction(cEXTInstall) = "install" extAction(cEXTUninstall) = "uninstall" dim result as string for i = 0 to cMaxErrorStates for j = 0 to 5 if gErrorState(i, j) = cLogFalse then result = result & " " & component(i) & ":" if i = cStDataBase then result = result & baseAction(j) else if i = cStExtension then result = result & extAction(j) else result = result & action(j) end if end if end if next j next i StartTestWithDefaultOptions = result end Function Sub DispatchSlot(SlotID as Integer) Dim oArg() as new com.sun.star.beans.PropertyValue Dim oUrl as new com.sun.star.util.URL Dim oTrans as Object Dim oDisp as Object oTrans = createUNOService("com.sun.star.util.URLTransformer") oUrl.Complete = "slot:" & CStr(SlotID) oTrans.parsestrict(oUrl) oDisp = StarDesktop.queryDispatch(oUrl, "_self", 0) oDisp.dispatch(oUrl, oArg()) End Sub 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 ExecuteSlot( SlotNr As String, oDoc as Object ) dim args() dim url as new com.sun.star.util.URL dim trans as object dim disp as object trans = createUnoService("com.sun.star.util.URLTransformer" ) url.Complete = "slot:" + SlotNr trans.parsestrict( url ) disp = oDoc.CurrentController.Frame.queryDispatch( url, "", 0 ) disp.dispatch( url, args() ) End Sub Sub DelAllUserFields (aDoc as Object) Dim aFieldType as Object Dim aElements as Variant Dim i% Dim aFieldMasters, aFieldMaster as Object Dim sElement$ aFieldMasters = aDoc.TextFieldMasters aElements = aFieldMasters.ElementNames for i = 0 to UBound(aElements) sElement$ = aElements(i) if 0 <> instr(sElement$, cUnoUserField ) then aFieldMaster = aFieldMasters.GetByName(sElement$) aFieldMaster.Dispose endif next end Sub Function GetUserFieldState (sName as String, aDoc as Object) as boolean Dim sFieldText as String Dim bState as boolean sFieldText = ReadUserField (sName, aDoc) if LCase(sFieldText) = cYes then bState = true else bState = false end IF GetUserFieldState = bState end Function Sub SetUserFieldState (sName as String, nState as boolean, aDoc as Object) Dim sFieldText as String sFieldText = cNo 'default Select case nState case true sFieldText = cYes case false sFieldText = cNo end Select WriteUserField (sFieldText, sName, aDoc) end Sub Function ReadUserField(sFieldName as String, aDoc as Object) as String Dim aMasters as Object aMasters = aDoc.TextFieldMasters if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then ReadUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName).Content else ReadUserField = "" end If End Function Sub WriteUserField(sValue as String, sFieldName as String, aDoc as Object, optional aCursor as Object) Dim aMasters, aUserField, aTxtCursor as Object aMasters = aDoc.TextFieldMasters if aMasters.HasByName (cUnoUserField+cUnoSeparator+sFieldName) then aUserField = aMasters.GetByName (cUnoUserField+cUnoSeparator+sFieldName) else aUserField = aDoc.CreateInstance (cUnoUserField) aUserField.Name = sFieldName end if aUserField.Content = sValue End Sub Sub WriteExtUserField(nIndex as Integer, aCursor as Object, aDoc as Object) Dim aUserField as Object aUserField = aDoc.CreateInstance (cUnoExtUserField) aUserField.UserDataType = nIndex aCursor.Text.InsertTextContent (aCursor, aUserField, True) aUserField.Fix = True End Sub