1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
|
<?xml version="1.0" encoding="UTF-8"?>
<!--**********************************************************************
*
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
*
* Copyright 2000, 2010 Oracle and/or its affiliates.
*
* OpenOffice.org - a multi-platform office productivity suite
*
* This file is part of OpenOffice.org.
*
* OpenOffice.org is free software: you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License version 3
* only, as published by the Free Software Foundation.
*
* OpenOffice.org is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License version 3 for more details
* (a copy is included in the LICENSE file that accompanied this code).
*
* You should have received a copy of the GNU Lesser General Public License
* version 3 along with OpenOffice.org. If not, see
* <http://www.openoffice.org/license.html>
* for a copy of the LGPLv3 License.
*
**********************************************************************-->
<!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 cMessageSaveOpenXMLDoc = "Save/Open Document XML (6/7)"
const cMessageNewDoc = "New Document"
const cMessageCloseDoc = "Close Document"
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
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter or cFltXML)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc or cFltXML)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress or cFltXML)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw or cFltXML)
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)
GlobalTestLog = OpenLogDat (sLogFileName)
call WriteTestSequence
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
if bMakeExtensionTest then
gCurrentDocTest = frmExtension
call Test_Ext.TestExtensions
end if
Close #GlobalTestLog
GlobalTestLog = 0
end Sub
Sub WriteTestSequence
Print #GlobalTestLog, "Sequence of testing"
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
if bMakeExtensionTest then
WriteExtensionTests ("Extension : ", GlobalTestLog)
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 bMakeSaveOpenXMLTest then
sWriteStr = sWriteStr + ", save XML"
end if
if bMakeSaveOpen8Test then
sWriteStr = sWriteStr + ", open 8.0"
end if
if bMakeSaveOpenXMLTest then
sWriteStr = sWriteStr + ", open XML"
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 = cDocSaveOpenXML
if bMakeSaveOpenXMLTest and IsFilterAvailable (gCurrentDocTest or cFltXML) then
sFileNameXML = sWorkPathURL+cTempFileName+"."+GetDocEndings(gCurrentDocTest or cFltXML)
SaveDoc (sFileNameXML, oDoc, GetDocFilter(gCurrentDocTest or cFltXML))
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 = cDocSaveOpenXML
if bMakeSaveOpenXMLTest and IsFilterAvailable (gCurrentDocTest or cFltXML) then
oDoc = LoadDoc (sFileNameXML)
' oDoc = Documents.open(sFileName)
LogTestResult( GetDocFilter(gCurrentDocTest or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, not IsNull (oDoc) )
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 cDocSaveOpenXML
GetErrorMessageOnAction = cMessageSaveOpenXMLDoc
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>
|