1<?xml version="1.0" encoding="UTF-8"?> 2<!--********************************************************************** 3* 4* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. 5* 6* Copyright 2000, 2010 Oracle and/or its affiliates. 7* 8* OpenOffice.org - a multi-platform office productivity suite 9* 10* This file is part of OpenOffice.org. 11* 12* OpenOffice.org is free software: you can redistribute it and/or modify 13* it under the terms of the GNU Lesser General Public License version 3 14* only, as published by the Free Software Foundation. 15* 16* OpenOffice.org is distributed in the hope that it will be useful, 17* but WITHOUT ANY WARRANTY; without even the implied warranty of 18* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19* GNU Lesser General Public License version 3 for more details 20* (a copy is included in the LICENSE file that accompanied this code). 21* 22* You should have received a copy of the GNU Lesser General Public License 23* version 3 along with OpenOffice.org. If not, see 24* <http://www.openoffice.org/license.html> 25* for a copy of the LGPLv3 License. 26* 27**********************************************************************--> 28<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> 29<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Test_10er" script:language="StarBasic">REM 10er Test 30 31const sSWLogFileName = "swlog.dat", sSCLogFileName = "sclog.dat" 32const sSDLogFileName = "sdlog.dat", sSMathLogFileName = "smalog.dat" 33const sSChartLogFileName = "schlog.dat" 34const sSHptLogFileName = "shptlog.dat" 35const sSDrawLogFileName = "sdrwlog.dat", sJavaLogFileName = "javalog.dat" 36const sSDBLogFileName = "dblog.dat", sExtLogFileName = "extlog.dat" 37const sTestGlueLogFileName = "testclosure.log" 38const sLogFileName = "smoketest.log" 39const cTempFileName = "smoketest_file" 40 41const cMessageSaveOpen8Doc = "Save/Open open Documents (8.0)" 42const cMessageSaveOpenXMLDoc = "Save/Open Document XML (6/7)" 43const cMessageNewDoc = "New Document" 44const cMessageCloseDoc = "Close Document" 45 46Global sWorkPath$ 47Global sWorkPathURL$ 48Global LocalTestLog% 49Global GlobalTestLog% 50 51Sub Main 52 call TestAllDocs() 53end Sub 54 55Sub DeleteAllSavedFiles() 56 Dim sFileName as String 57 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter) 58 If FileExists (sFileName) then 59 Kill (sFileName) 60 End If 61 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc) 62 If FileExists (sFileName) then 63 Kill (sFileName) 64 End If 65 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress) 66 If FileExists (sFileName) then 67 Kill (sFileName) 68 End If 69 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw) 70 If FileExists (sFileName) then 71 Kill (sFileName) 72 End If 73 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmHyperText) 74 If FileExists (sFileName) then 75 Kill (sFileName) 76 End If 77 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter or cFltXML) 78 If FileExists (sFileName) then 79 Kill (sFileName) 80 End If 81 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc or cFltXML) 82 If FileExists (sFileName) then 83 Kill (sFileName) 84 End If 85 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress or cFltXML) 86 If FileExists (sFileName) then 87 Kill (sFileName) 88 End If 89 sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw or cFltXML) 90 If FileExists (sFileName) then 91 Kill (sFileName) 92 End If 93End Sub 94 95Sub DeleteAllLogFiles() 96 If FileExists (sWorkPath+sLogFileName) then 97 Kill (sWorkPath+sLogFileName) 98 End If 99 If FileExists (sWorkPath+sSWLogFileName) then 100 Kill (sWorkPath+sSWLogFileName) 101 End If 102 If FileExists (sWorkPath+sSCLogFileName) then 103 Kill (sWorkPath+sSCLogFileName) 104 End If 105 If FileExists (sWorkPath+sSDLogFileName) then 106 Kill (sWorkPath+sSDLogFileName) 107 End If 108 If FileExists (sWorkPath+sSMathLogFileName) then 109 Kill (sWorkPath+sSMathLogFileName) 110 End If 111 If FileExists (sWorkPath+sSChartLogFileName) then 112 Kill (sWorkPath+sSChartLogFileName) 113 End If 114 If FileExists (sWorkPath+sSHptLogFileName) then 115 Kill (sWorkPath+sSHptLogFileName) 116 End If 117 If FileExists (sWorkPath+sSDrawLogFileName) then 118 Kill (sWorkPath+sSDrawLogFileName) 119 End If 120 If FileExists (sWorkPath+sJavaLogFileName) then 121 Kill (sWorkPath+sJavaLogFileName) 122 End If 123 If FileExists (sWorkPath+sTestGlueLogFileName) then 124 Kill (sWorkPath+sTestGlueLogFileName) 125 End If 126 If FileExists (sWorkPath+sSDBLogFileName) then 127 Kill (sWorkPath+sSDBLogFileName) 128 End If 129 If FileExists (sWorkPath+sExtLogFileName) then 130 Kill (sWorkPath+sExtLogFileName) 131 End If 132end Sub 133 134Function OpenLogDat (sFileName as String) as Integer 135 Dim LocaleFileChannel% 136 If FileExists (sWorkPath+sFileName) then 137 Kill (sWorkPath+sFileName) 138 End If 139 LocaleFileChannel% = Freefile 140 Open sWorkPath+sFileName For Output As LocaleFileChannel% 141 OpenLogDat = LocaleFileChannel% 142end Function 143 144Sub SetupWorkPath 145 Dim configManager as Object 146 configManager = CreateUnoService( "com.sun.star.config.SpecialConfigManager" ) 147 148 sWorkPath = configManager.SubstituteVariables( "$(userpath)/temp/" ) 149 sWorkPathURL = configManager.SubstituteVariables( "$(userurl)/temp/" ) 150End Sub 151 152Function GetSystem (sTmpWorkPath as string) as string 153 GetSystem = "" 154 if InStr (sTmpWorkPath, ":") then 155 GetSystem = "windows" 156 else 157 GetSystem = "unix" 158 End If 159end Function 160 161Function ConvertPathToWin (sTmpWorkPath as string) as string 162 for i%=1 to Len(sTmpWorkPath) 163 sTemp = Mid (sTmpWorkPath, i%, 1) 164 if sTemp = "/" then 165 sTmpWorkPath = Left (sTmpWorkPath, i%-1) + "\" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%) 166 else 167 if sTemp = "|" then 168 sTmpWorkPath = Left (sTmpWorkPath, i%-1) + ":" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%) 169 end If 170 end If 171 next i% 172 ConvertPathToWin = sTmpWorkPath 173end Function 174 175Sub TestAllDocs() 176DIM sDocURL as String, sDocPath as String 177DIM nStrPos as Long 178 179 'search ExtensionURL 180 sDocURL = gOutputDoc.URL 181 CompatibilityMode(true) 182 nStrPos = InStrRev (sDocURL, "/" ) 183 CompatibilityMode(false) 184 sExtensionURL = Left (sDocURL, nStrPos) 185 186 GlobalTestLog = OpenLogDat (sLogFileName) 187 call WriteTestSequence 188 if bMakeWriterTest then 189 gCurrentDocTest = frmWriter 190 call MakeDocTest 191 end if 192 if bMakeCalcTest then 193 gCurrentDocTest = frmCalc 194 call MakeDocTest 195 end if 196 if bMakeImpressTest then 197 gCurrentDocTest = frmImpress 198 call MakeDocTest 199 end if 200 if bMakeDrawTest then 201 gCurrentDocTest = frmDraw 202 call MakeDocTest 203 end if 204 if bMakeHTMLTest then 205 gCurrentDocTest = frmHyperText 206 call MakeDocTest 207 end if 208 if bMakeChartTest then 209 gCurrentDocTest = frmChart 210 call MakeChartTest 211 end if 212 if bMakeMathTest then 213 gCurrentDocTest = frmMath 214 call MakeNewDoc 215 end if 216 if bMakeJavaTest then 217 gCurrentDocTest = frmJava 218 call TestJava 219 end if 220 if bMakeDBTest then 221 gCurrentDocTest = frmDataBase 222 call Test_DB.TestDB 223 end if 224 if bMakeExtensionTest then 225 gCurrentDocTest = frmExtension 226 call Test_Ext.TestExtensions 227 end if 228 229 Close #GlobalTestLog 230 GlobalTestLog = 0 231end Sub 232 233Sub WriteTestSequence 234 Print #GlobalTestLog, "Sequence of testing" 235 236 if bMakeWriterTest then 237 WriteTests ("writer : ", true, GlobalTestLog) 238 end if 239 if bMakeCalcTest then 240 WriteTests ("calc : ", true, GlobalTestLog) 241 end if 242 if bMakeImpressTest then 243 WriteTests ("impress : ", true, GlobalTestLog) 244 end if 245 if bMakeDrawTest then 246 WriteTests ("draw : ", true, GlobalTestLog) 247 end if 248 if bMakeHTMLTest then 249 WriteTests ("HTML : ", true, GlobalTestLog) 250 end if 251 if bMakeChartTest then 252 WriteTests ("chart : ", false, GlobalTestLog) 253 end if 254 if bMakeMathTest then 255 WriteTests ("math : ", false, GlobalTestLog) 256 end if 257 if bMakeJavaTest then 258 WriteTests ("Java : ", false, GlobalTestLog) 259 end if 260 if bMakeDBTest then 261 WriteDBTests ("Database : ", GlobalTestLog) 262 end if 263 if bMakeExtensionTest then 264 WriteExtensionTests ("Extension : ", GlobalTestLog) 265 end if 266 267 Print #GlobalTestLog, "testclosure : setup, write_status" 268 269 Print #GlobalTestLog 270 end Sub 271 272 Sub WriteTests (sText as string, bTestAll as boolean) 273 Dim sWriteStr as string 274 275 sWriteStr = sText 276 sWriteStr = sWriteStr + "new" 277 if bTestAll then 278 if bMakeSaveOpen8Test then 279 sWriteStr = sWriteStr + ", save 8.0" 280 end if 281 if bMakeSaveOpenXMLTest then 282 sWriteStr = sWriteStr + ", save XML" 283 end if 284 if bMakeSaveOpen8Test then 285 sWriteStr = sWriteStr + ", open 8.0" 286 end if 287 if bMakeSaveOpenXMLTest then 288 sWriteStr = sWriteStr + ", open XML" 289 end if 290 end if 291 292 sWriteStr = sWriteStr + ", close" 293 294 Print #GlobalTestLog, sWriteStr 295end Sub 296 297Sub WriteDBTests (sText as string, nFileChannel as integer) 298 Dim sWriteStr as string 299 300 sWriteStr = sText 301 sWriteStr = sWriteStr + "open / services" 302 sWriteStr = sWriteStr + ", insert" 303 sWriteStr = sWriteStr + ", delete" 304 sWriteStr = sWriteStr + ", seek" 305 sWriteStr = sWriteStr + ", close" 306 307 Print #nFileChannel, sWriteStr 308end Sub 309 310Sub WriteExtensionTests (sText as string, nFileChannel as integer) 311 Dim sWriteStr as string 312 313 sWriteStr = sText 314 sWriteStr = sWriteStr + "services" 315 sWriteStr = sWriteStr + ", install" 316 sWriteStr = sWriteStr + ", uninstall" 317 318 Print #nFileChannel, sWriteStr 319end Sub 320 321Sub MakeDocTest 322 Dim oDoc as Object 323 Dim sFileNameXML$, sFileName8$ 324 Dim bSuccess as Boolean 325 326 On Local Error GoTo DOCTESTERROR 327 gCurrentTestCase = cLogfileFailed 328 LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) 329 gCurrentTestCase = cDocNew 330 oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc)) 331 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) ) 332 if not IsNull (oDoc) then 333 gCurrentTestCase = cDocSaveOpen8 334 if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then 335 sFileName8 = sWorkPathURL+cTempFileName+"."+GetDocEndings(gCurrentDocTest or cFlt8) 336 SaveDoc (sFileName8, oDoc, GetDocFilter(gCurrentDocTest or cFlt8)) 337 end if 338 gCurrentTestCase = cDocSaveOpenXML 339 if bMakeSaveOpenXMLTest and IsFilterAvailable (gCurrentDocTest or cFltXML) then 340 sFileNameXML = sWorkPathURL+cTempFileName+"."+GetDocEndings(gCurrentDocTest or cFltXML) 341 SaveDoc (sFileNameXML, oDoc, GetDocFilter(gCurrentDocTest or cFltXML)) 342 end if 343 gCurrentTestCase = cDocClose 344 bSuccess = CloseDoc( oDoc ) 345 LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess ) 346 gCurrentTestCase = cDocSaveOpen8 347 if bMakeSaveOpen8Test and IsFilterAvailable (gCurrentDocTest or cFlt8) then 348 oDoc = LoadDoc (sFileName8) 349 350' oDoc = Documents.open(sFileName) 351 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, not IsNull (oDoc) ) 352 353 if not IsNull (oDoc) then 354 gCurrentTestCase = cDocClose 355 oDoc.close (true) 356 end If 357 end if 358 359 gCurrentTestCase = cDocSaveOpenXML 360 if bMakeSaveOpenXMLTest and IsFilterAvailable (gCurrentDocTest or cFltXML) then 361 oDoc = LoadDoc (sFileNameXML) 362 363' oDoc = Documents.open(sFileName) 364 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, not IsNull (oDoc) ) 365 366 if not IsNull (oDoc) then 367 gCurrentTestCase = cDocClose 368 oDoc.close (true) 369 end If 370 end if 371 372 end If 373 Print #LocalTestLog, "---" 374 Close #LocalTestLog% 375 LocalTestLog = 0 376 Exit Sub ' Without error 377 378 DOCTESTERROR: 379 If ( gCurrentTestCase = cLogfileFailed ) then 380 LogTestResult( " ", False ) 381 Exit Sub 382 else 383 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False ) 384 Close #LocalTestLog% 385 LocalTestLog = 0 386 End If 387 Exit Sub ' With error 388End Sub 389 390Sub MakeNewDoc 391 DIM oDoc as Object 392 Dim bSuccess as Boolean 393 On Local Error GoTo DOCTESTERROR2 394 gCurrentTestCase = cLogfileFailed 395 LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) 396 gCurrentTestCase = cDocNew 397' oDoc = Documents.Add(GetDocFilter(gCurrentDocTest)) 398 oDoc = LoadDoc ("private:factory/" + GetDocFilter(gCurrentDocTest or cFltNewDoc)) 399 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, not IsNull (oDoc) ) 400 if not IsNull (oDoc) then 401 gCurrentTestCase = cDocClose 402 bSuccess = CloseDoc( oDoc ) 403 LogTestResult( GetDocFilter(gCurrentDocTest)+" "+ cMessageCloseDoc, bSuccess ) 404 end If 405 Print #LocalTestLog, "---" 406 Close #LocalTestLog% 407 LocalTestLog = 0 408 Exit Sub ' Without error 409 410 DOCTESTERROR2: 411 If ( gCurrentTestCase = cLogfileFailed ) then 412 LogTestResult( " ", False ) 413 Exit Sub 414 else 415 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), False ) 416 Close #LocalTestLog% 417 LocalTestLog = 0 418 End If 419 Exit Sub ' With error 420End Sub 421 422Sub MakeChartTest 423 Dim oCharts as Object 424 Dim oDoc as Object 425 Dim oRange(0) as New com.sun.star.table.CellRangeAddress 426 Dim oRect as New com.sun.star.awt.Rectangle 427 const cChartName="TestChart" 428 Dim bSuccess as Boolean 429 On Local Error GoTo CHARTTESTERROR 430 gCurrentTestCase = cLogfileFailed 431 LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) 432 gCurrentTestCase = cDocNew 433 oDoc = LoadDoc ("private:factory/" + GetDocFilter(frmCalc or cFltNewDoc)) 434 if not IsNull (oDoc) then 435 oCharts = oDoc.sheets(0).Charts 436 oCharts.AddNewByName (cChartName, oRect, oRange(), true, true) 437 bSuccess=oCharts.HasByName(cChartName) 438 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageNewDoc, bSuccess ) 439 gCurrentTestCase = cDocClose 440 oDoc.close (true) 441 else 442 LogTestResult( GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, FALSE ) 443 End if 444 Print #LocalTestLog, "---" 445 Close #LocalTestLog% 446 LocalTestLog = 0 447 Exit Sub ' Without error 448 449 CHARTTESTERROR: 450 If ( gCurrentTestCase = cLogfileFailed ) then 451 LogTestResult( " ", False ) 452 Exit Sub 453 else 454 LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ GetErrorMessage(gCurrentTestCase), FALSE ) 455 Close #LocalTestLog% 456 LocalTestLog = 0 457 End If 458 Exit Sub ' With error 459End Sub 460 461Sub LogState (bState as Boolean, sText as String, nLocaleFileChannel as integer) 462 if bState then 463 Print #nLocaleFileChannel, sText+" -> ok" 464 else 465 Print #nLocaleFileChannel, sText+" -> error" 466 end If 467end Sub 468 469Function GetDocEndings (DocType as Integer) as String 470 Select Case ( DocType ) 471 case frmWriter or cFlt8 472 GetDocEndings = "odt" ' Textdokument 473 case frmCalc or cFlt8 474 GetDocEndings = "ods" 'Tabellendokument 475 case frmImpress or cFlt8 476 GetDocEndings = "odp" 'PrÕsentation 477 case frmDraw or cFlt8 478 GetDocEndings = "odg" 'Zeichen 479 case frmHyperText, frmHyperText or cFltXML 480 GetDocEndings = "html" 'Hypertext-Dokument 481 case frmWriter or cFltXML 482 GetDocEndings = "sxw" ' Textdokument 483 case frmCalc or cFltXML 484 GetDocEndings = "sxc" 'Tabellendokument 485 case frmImpress or cFltXML 486 GetDocEndings = "sxi" 'PrÕsentation 487 case frmDraw or cFltXML 488 GetDocEndings = "sxd" 'Zeichen 489 case else 490 GetDocEndings = "" 491 end Select 492end Function 493 494Function GetDocFilter (DocType as Integer) as String 495 Select Case ( DocType ) 496 case frmWriter or cFlt8 497 GetDocFilter = "writer8" ' text document 498 case frmCalc or cFlt8 499 GetDocFilter = "calc8" ' spreadsheet document 500 case frmImpress or cFlt8 501 GetDocFilter = "impress8" ' presentation 502 case frmDraw or cFlt8 503 GetDocFilter = "draw8" ' drawing 504 case frmMath or cFlt8 505 GetDocFilter = "math8" ' formula 506 507 case frmWriter or cFltXML 508 GetDocFilter = "StarOffice XML (Writer)" ' text document 509 case frmCalc or cFltXML 510 GetDocFilter = "StarOffice XML (Calc)" ' spreadsheet document 511 case frmImpress or cFltXML 512 GetDocFilter = "StarOffice XML (Impress)" ' presentation 513 case frmDraw or cFltXML 514 GetDocFilter = "StarOffice XML (Draw)" ' drawing 515 case frmMath or cFltXML 516 GetDocFilter = "StarOffice XML (Math)" ' formula 517 518 case frmHyperText, frmHyperText or cFltXML 519 GetDocFilter = "HTML" ' HTML document 520 521 case frmWriter or cFltNewDoc 522 GetDocFilter = "swriter" ' text document 523 case frmCalc or cFltNewDoc 524 GetDocFilter = "scalc" ' spreadsheet document 525 case frmImpress or cFltNewDoc 526 GetDocFilter = "simpress" ' presentation 527 case frmDraw or cFltNewDoc 528 GetDocFilter = "sdraw" ' drawing 529 case frmMath or cFltNewDoc 530 GetDocFilter = "smath" ' formula 531 case frmHyperText or cFltNewDoc 532 GetDocFilter = "swriter/web" ' HTML document 533 case frmChart or cFltNewDoc 534 GetDocFilter = "schart" ' chart 535 case else 536 GetDocFilter = "" 537 end Select 538end Function 539 540Function GetLogFileName (DocType as Integer) as String 541 Select Case ( DocType ) 542 case frmWriter 543 GetLogFileName = sSWLogFileName ' text document 544 case frmCalc 545 GetLogFileName = sSCLogFileName ' spreadsheet document 546 case frmImpress 547 GetLogFileName = sSDLogFileName ' presentation 548 case frmDraw 549 GetLogFileName = sSDrawLogFileName ' drawing 550 case frmMath 551 GetLogFileName = sSMathLogFileName ' formula 552 case frmHyperText 553 GetLogFileName = sSHptLogFileName ' HTML document 554 case frmChart 555 GetLogFileName = sSChartLogFileName ' chart 556 case frmJava 557 GetLogFileName = sJavaLogFileName 'Java 558 case frmTestClosure 559 GetLogFileName = sTestGlueLogFileName ' test framework 560 case frmDataBase 561 GetLogFileName = sSDBLogFileName 'Database 562 case frmExtension 563 GetLogFileName = sExtLogFileName 'Extension 564 case else 565 GetLogFileName = "" 566 end Select 567end Function 568 569Function GetErrorMessageOnAction (nAction as Integer) as String 570 Select Case ( nAction ) 571 case cDocNew 572 GetErrorMessageOnAction = cMessageNewDoc 573 case cDocSaveOpen8 574 GetErrorMessageOnAction = cMessageSaveOpen8Doc 575 case cDocSaveOpenXML 576 GetErrorMessageOnAction = cMessageSaveOpenXMLDoc 577 case cDocClose 578 GetErrorMessageOnAction = cMessageCloseDoc 579 case else 580 GetErrorMessageOnAction = "" 581 end Select 582end Function 583 584Function IsFilterAvailable (FilterType as Integer) as boolean 585 IsFilterAvailable = true 586 if ((FilterType = (frmHyperText or cFltXML))) then 587 IsFilterAvailable = false 588 end if 589End Function 590 591Function TestJava 592 Dim oObj as Object 593 gCurrentTestCase = cLogfileFailed 594 LocalTestLog% = OpenLogDat (GetLogFileName(gCurrentDocTest)) 595 gCurrentTestCase = cDocNew 596 oObj = createUnoService( cUnoJavaLoader ) 597 LogTestResult( "Java "+ cMessageNewDoc, not IsNull (oObj) ) 598 599 Print #LocalTestLog, "---" 600 Close #LocalTestLog% 601 LocalTestLog = 0 602 603 TestJava = not IsNull (oObj) 604End Function 605 606Sub LoadLibrary( LibName as String ) 607 608 dim args(1) 609 dim arg as new com.sun.star.beans.PropertyValue 610 arg.Name = "LibraryName" 611 arg.Value = LibName 612 args(0) = arg 613 614 dim url as new com.sun.star.util.URL 615 dim trans as object 616 trans = createUnoService("com.sun.star.util.URLTransformer" ) 617 url.Complete = "slot:6517" 618 trans.parsestrict( url ) 619 620 dim disp as object 621 disp = StarDesktop.currentFrame.queryDispatch( url, "", 0 ) 622 disp.dispatch( url, args() ) 623 624End Sub 625 626Sub LoadDoc (DocName as String) as Object 627 dim trans as object 628 trans = createUnoService("com.sun.star.util.URLTransformer" ) 629 url = createUnoStruct("com.sun.star.util.URL" ) 630 url.Complete = DocName 631 if Left(DocName, 5 ) <> "file:" then 632 trans.parsestrict( url ) 633 endif 634 635 Dim aPropArray(0) as Object 636 aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue") 637 aPropArray(0).Name = "OpenFlags" 638 aPropArray(0).Value = "S" 639 640 dim doc as object 641 dim noargs() 642 doc = StarDesktop.loadComponentFromURL( url.Complete, "_blank", 0, aPropArray() ) ' XModel 643 LoadDoc = doc 644End Sub 645 646Sub SaveDoc (DocName as String, oDoc as Object, sFilterName as string ) 647 dim trans as object 648 trans = createUnoService("com.sun.star.util.URLTransformer" ) 649 url = createUnoStruct("com.sun.star.util.URL" ) 650 url.Complete = DocName 651 if Left(DocName, 5 ) <> "file:" then 652 trans.parsestrict( url ) 653 endif 654 655 if not (sFilterName = "") then 656 Dim aPropArray(0) as Object 657 aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue") 658 aPropArray(0).Name = "FilterName" 659 aPropArray(0).Value = sFilterName 660 661 oDoc.storeAsURL( url.Complete, aPropArray() ) 662 else 663 MessageBox "Filtername is unknown!" 664 end if 665end Sub 666 667Function CloseDoc( oDoc as Object ) 668 Dim oListener as Object 669 oListener = CreateUnoListener( "Events.closeListener_", "com.sun.star.util.XCloseListener" ) 670 oDoc.addCloseListener( oListener ) 671 672 Events.ResetCloseListenerFlag() 673 oDoc.close( true ) 674 closeDoc = Events.HasCloseListenerBeenCalled() 675 676 if ( Not Events.HasCloseListenerBeenCalled() ) Then 677 ' do this only if closing was not successful - otherwise, we'd get a DisposedException 678 oDoc.removeCloseListener( oListener ) 679 End If 680End Function 681</script:module> 682