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