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
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
|
<?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 sSImDLogFileName = "simlog.dat", sSChartLogFileName = "schlog.dat"
const sSHptLogFileName = "shptlog.dat", sSMessageLogFileName = "smeslog.dat"
const sSDrawLogFileName = "sdrwlog.dat", sJavaLogFileName = "javalog.dat"
const sSDBLogFileName = "dblog.dat", sExtLogFileName = "extlog.dat"
const sLogFileName = "log.dat"
const cTempFileName = "ttt"
const cMessageSaveOpen8Doc = "Save/Open open Documents (8.0)"
const cMessageSaveOpenXMLDoc = "Save/Open Document XML (6/7)"
const cMessageOpen50Doc = "Open Document 5.0"
const cMessageNewDoc = "New Document"
const cMessageCloseDoc = "Close Document"
const cMessageCutObj = "Cut Object"
const cMessagePasteObj = "Paste Object"
Global sWorkPath$
Global sWorkPathURL$
Global FileChannel%
Global MainFileChannel%
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
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter or cFlt50)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc or cFlt50)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress or cFlt50)
If FileExists (sFileName) then
Kill (sFileName)
End If
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw or cFlt50)
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+sSImDLogFileName) then
Kill (sWorkPath+sSImDLogFileName)
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+sSMessageLogFileName) then
Kill (sWorkPath+sSMessageLogFileName)
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+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
Function GetWorkPath as string
sTemp = "$(userpath)/temp/"
GetWorkPath = CreateUnoService("com.sun.star.config.SpecialConfigManager").SubstituteVariables(sTemp)
End Function
Function GetWorkURL as string
sTemp = "$(userurl)/temp/"
GetWorkURL = CreateUnoService("com.sun.star.config.SpecialConfigManager").SubstituteVariables(sTemp)
End Function
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
sWorkPath = GetWorkPath
sWorkPathURL = GetWorkURL
if GetSystem (sWorkPath) = "windows" then
sWorkPath = ConvertPathToWin (sWorkPath)
end if
'search ExtensionURL
sDocURL = gOutPutDoc.URL
CompatibilityMode(true)
nStrPos = InStrRev (sDocURL, "/" )
CompatibilityMode(false)
sExtensionURL = Left (sDocURL, nStrPos)
call DeleteAllSavedFiles()
call DeleteAllLogFiles()
MainFileChannel = OpenLogDat (sLogFileName)
call WriteTestSequence (MainFileChannel)
if bMakeWriterTest then
call MakeDocTest (frmWriter)
end if
if bMakeCalcTest then
call MakeDocTest (frmCalc)
end if
if bMakeImpressTest then
call MakeDocTest (frmImpress)
end if
if bMakeDrawTest then
call MakeDocTest (frmDraw)
end if
if bMakeHTMLTest then
call MakeDocTest (frmHyperText)
end if
if bMakeChartTest then
call MakeChartTest (frmChart)
end if
if bMakeMathTest then
call MakeNewDoc (frmMath)
end if
if bMakeJavaTest then
call TestJava (frmJava)
end if
if bMakeDBTest then
call Test_DB.TestDB (frmDataBase)
end if
if bMakeExtensionTest then
call Test_Ext.TestExtensions (frmExtension)
end if
Close #MainFileChannel
end Sub
Sub WriteTestSequence (FileChannel as integer)
Print #FileChannel, "Sequence of testing"
if bMakeWriterTest then
WriteTests ("writer : ", true, FileChannel)
end if
if bMakeCalcTest then
WriteTests ("calc : ", true, FileChannel)
end if
if bMakeImpressTest then
WriteTests ("impress : ", true, FileChannel)
end if
if bMakeDrawTest then
WriteTests ("draw : ", true, FileChannel)
end if
if bMakeHTMLTest then
WriteTests ("HTML : ", true, FileChannel)
end if
if bMakeChartTest then
WriteTests ("chart : ", false, FileChannel)
end if
if bMakeMathTest then
WriteTests ("math : ", false, FileChannel)
end if
if bMakeJavaTest then
WriteTests ("Java : ", false, FileChannel)
end if
if bMakeDBTest then
WriteDBTests ("Database : ", FileChannel)
end if
if bMakeExtensionTest then
WriteExtensionTests ("Extension : ", FileChannel)
end if
Print #FileChannel
end Sub
Sub WriteTests (sText as string, bTestAll as boolean, nFileChannel as integer)
Dim sWriteStr as string
sWriteStr = sText
sWriteStr = sWriteStr + "new"
if bTestAll then
if bMakeCutTest then
sWriteStr = sWriteStr + ", cut"
end if
if bMakePasteTest then
sWriteStr = sWriteStr + ", paste"
end if
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
if bMakeOpen50Test then
sWriteStr = sWriteStr + ", open 5.0"
end if
end if
sWriteStr = sWriteStr + ", close"
Print #nFileChannel, 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 (FilterType as Integer)
Dim oDoc as Object
Dim sFileNameXML$, sFileName50$, sFileName8$
Dim bError as Boolean
Dim nCurrentAction as Integer
On Local Error GoTo DOCTESTERROR
nCurrentAction = cLogfileFailed
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
nCurrentAction = cDocNew
oDoc = LoadDoc ("private:factory/" + GetDocFilter(FilterType or cFltNewDoc))
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
SetStatus (FilterType, cDocNew, not IsNull (oDoc))
if not IsNull (oDoc) then
nCurrentAction = cDocCut
call CutAndPaste(FilterType, oDoc)
' bError = oDoc.CurrentController.frame.close
nCurrentAction = cDocSaveOpen8
if bMakeSaveOpen8Test and IsFilterAvailable (FilterType or cFlt8) then
sFileName8 = sWorkPathURL+cTempFileName+"."+GetDocEndings(FilterType or cFlt8)
SaveDoc (sFileName8, oDoc, GetDocFilter(FilterType or cFlt8))
end if
nCurrentAction = cDocSaveOpenXML
if bMakeSaveOpenXMLTest and IsFilterAvailable (FilterType or cFltXML) then
sFileNameXML = sWorkPathURL+cTempFileName+"."+GetDocEndings(FilterType or cFltXML)
SaveDoc (sFileNameXML, oDoc, GetDocFilter(FilterType or cFltXML))
end if
nCurrentAction = cDocOpen50
' oDoc.dispose
nCurrentAction = cDocClose
oDoc.close (true)
' bError = true ' nur zum ¦bergang, weil bError = oDoc.CurrentController.frame.close nicht geht
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, FileChannel)
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, MainFileChannel)
' SetStatus (FilterType, cDocClose, bError)
nCurrentAction = cDocSaveOpen8
if bMakeSaveOpen8Test and IsFilterAvailable (FilterType or cFlt8) then
oDoc = LoadDoc (sFileName8)
' oDoc = Documents.open(sFileName)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, FileChannel)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, MainFileChannel)
SetStatus (FilterType, cDocSaveOpen8, not IsNull (oDoc))
if not IsNull (oDoc) then
' oDoc.dispose
nCurrentAction = cDocClose
oDoc.close (true)
end If
end if
nCurrentAction = cDocSaveOpenXML
if bMakeSaveOpenXMLTest and IsFilterAvailable (FilterType or cFltXML) then
oDoc = LoadDoc (sFileNameXML)
' oDoc = Documents.open(sFileName)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, FileChannel)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, MainFileChannel)
SetStatus (FilterType, cDocSaveOpenXML, not IsNull (oDoc))
if not IsNull (oDoc) then
' oDoc.dispose
nCurrentAction = cDocClose
oDoc.close (true)
end If
end if
nCurrentAction = cDocOpen50
if bMakeOpen50Test and IsFilterAvailable (FilterType or cFlt50) then
SOLARSRC = ConvertToURL(Environ("SOLARSRC"))
sFileName50 = SOLARSRC+"/qadevOOo/testdocs/"+cTempFileName+"."+GetDocEndings(FilterType or cFlt50)
oDoc = LoadDoc (sFileName50)
' oDoc = Documents.open(sFileName)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSave50Doc, FileChannel)
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageOpen50Doc, MainFileChannel)
SetStatus (FilterType, cDocOpen50, not IsNull (oDoc))
if not IsNull (oDoc) then
' oDoc.dispose
nCurrentAction = cDocClose
oDoc.close (true)
end If
end if
end If
Print #FileChannel, "---"
Close #FileChannel%
Exit Sub ' Without error
DOCTESTERROR:
If (nCurrentAction = cLogfileFailed) then
SetStatus (FilterType, cDocNew, False)
Exit Sub
else
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
SetStatus (FilterType, nCurrentAction, False)
Close #FileChannel%
End If
Exit Sub ' With error
End Sub
Sub MakeNewDoc (FilterType as Integer)
DIM oDoc as Object
Dim bError as Boolean
Dim nCurrentAction as Integer
On Local Error GoTo DOCTESTERROR2
nCurrentAction = cLogfileFailed
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
nCurrentAction = cDocNew
' oDoc = Documents.Add(GetDocFilter(FilterType))
oDoc = LoadDoc ("private:factory/" + GetDocFilter(FilterType or cFltNewDoc))
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
SetStatus (FilterType, cDocNew, not IsNull (oDoc))
if not IsNull (oDoc) then
nCurrentAction = cDocClose
' oDoc.dispose
oDoc.close (true)
' bError = true ' nur zum ¦bergang, weil bError = oDoc.CurrentController.frame.close nicht geht
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, FileChannel)
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, MainFileChannel)
' SetStatus (FilterType, cDocClose, bError)
end If
Print #FileChannel, "---"
Close #FileChannel%
Exit Sub ' Without error
DOCTESTERROR2:
If (nCurrentAction = cLogfileFailed) then
SetStatus (FilterType, cDocNew, False)
Exit Sub
else
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
SetStatus (FilterType, nCurrentAction, False)
Close #FileChannel%
End If
Exit Sub ' With error
End Sub
Sub MakeChartTest (FilterType as Integer)
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 bError as Boolean
Dim nCurrentAction as Integer
On Local Error GoTo CHARTTESTERROR
nCurrentAction = cLogfileFailed
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
nCurrentAction = 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)
bError=oCharts.HasByName(cChartName)
LogState (bError, GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
LogState (bError, GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
SetStatus (FilterType, cDocNew, bError)
' oDoc.dispose
nCurrentAction = cDocClose
oDoc.close (true)
else
LogState (not IsNull (oDoc), GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
LogState (not IsNull (oDoc), GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
SetStatus (frmCalc, cDocNew, not IsNull (oDoc))
End if
Print #FileChannel, "---"
Close #FileChannel%
Exit Sub ' Without error
CHARTTESTERROR:
If (nCurrentAction = cLogfileFailed) then
SetStatus (FilterType, cDocNew, False)
Exit Sub
else
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
SetStatus (FilterType, nCurrentAction, False)
Close #FileChannel%
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 cFlt50, frmHyperText or cFltXML
GetDocEndings = "html" 'Hypertext-Dokument
case frmWriter or cFlt50
GetDocEndings = "sdw" ' Textdokument 5.0
case frmCalc or cFlt50
GetDocEndings = "sdc" 'Tabellendokument 5.0
case frmImpress or cFlt50
GetDocEndings = "sdd" 'PrÕsentation 5.0
case frmDraw or cFlt50
GetDocEndings = "sda" 'Zeichen 5.0
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" ' Textdokument
case frmCalc or cFlt8
GetDocFilter = "calc8" 'Tabellendokument
case frmImpress or cFlt8
GetDocFilter = "impress8" 'Präsentation
case frmDraw or cFlt8
GetDocFilter = "draw8" 'Zeichen
case frmMath or cFlt8
GetDocFilter = "math8" 'Formel
case frmWriter or cFltXML
GetDocFilter = "StarOffice XML (Writer)" ' Textdokument
case frmCalc or cFltXML
GetDocFilter = "StarOffice XML (Calc)" 'Tabellendokument
case frmImpress or cFltXML
GetDocFilter = "StarOffice XML (Impress)" 'Präsentation
case frmDraw or cFltXML
GetDocFilter = "StarOffice XML (Draw)" 'Zeichen
case frmMath or cFltXML
GetDocFilter = "StarOffice XML (Math)" 'Formel
case frmHyperText, frmHyperText or cFlt50, frmHyperText or cFltXML
GetDocFilter = "HTML" 'Hypertext-Dokument
case frmWriter or cFlt50
GetDocFilter = "StarWriter 5.0" ' Textdokument 5.0
case frmCalc or cFlt50
GetDocFilter = "StarCalc 5.0" 'Tabellendokument 5.0
case frmImpress or cFlt50
GetDocFilter = "StarImpress 5.0" 'Präsentation 5.0
case frmDraw or cFlt50
GetDocFilter = "StarDraw 5.0" 'Zeichen 5.0
case frmMath or cFlt50
GetDocFilter = "StarMath 5.0" 'Formel 5.0
case frmWriter or cFltNewDoc
GetDocFilter = "swriter" ' Textdokument
case frmCalc or cFltNewDoc
GetDocFilter = "scalc" 'Tabellendokument
case frmMessage or cFltNewDoc
GetDocFilter = "Message" 'Nachricht
case frmImpress or cFltNewDoc
GetDocFilter = "simpress" 'Präsentation
case frmDraw or cFltNewDoc
GetDocFilter = "sdraw" 'Zeichen
case frmMath or cFltNewDoc
GetDocFilter = "smath" 'Formel
case frmImage or cFltNewDoc
GetDocFilter = "simage" 'Bild
case frmHyperText or cFltNewDoc
GetDocFilter = "swriter/web" 'Hypertext-Dokument
case frmChart or cFltNewDoc
GetDocFilter = "schart" 'Diagramm
case else
GetDocFilter = ""
end Select
end Function
Function GetLogFileName (DocType as Integer) as String
Select Case ( DocType )
case frmWriter
GetLogFileName = sSWLogFileName ' Textdokument
case frmCalc
GetLogFileName = sSCLogFileName 'Tabellendokument
case frmMessage
GetLogFileName = sSMessageLogFileName 'Nachricht
case frmImpress
GetLogFileName = sSDLogFileName 'PrÕsentation
case frmDraw
GetLogFileName = sSDrawLogFileName 'Zeichnen
case frmMath
GetLogFileName = sSMathLogFileName 'Formel
case frmImage
GetLogFileName = sSImDLogFileName 'Bild
case frmHyperText
GetLogFileName = sSHptLogFileName 'Hypertext-Dokument
case frmChart
GetLogFileName = sSChartLogFileName 'Diagramm
case frmJava
GetLogFileName = sJavaLogFileName 'Java
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 cDocCut
GetErrorMessageOnAction = cMessageCutObj
case cDocPaste
GetErrorMessageOnAction = cMessagePasteObj
case cDocSaveOpen8
GetErrorMessageOnAction = cMessageSaveOpen8Doc
case cDocSaveOpenXML
GetErrorMessageOnAction = cMessageSaveOpenXMLDoc
case cDocOpen50
GetErrorMessageOnAction = cMessageOpen50Doc
case cDocClose
GetErrorMessageOnAction = cMessageCloseDoc
case else
GetErrorMessageOnAction = ""
end Select
end Function
Function IsFilterAvailable (FilterType as Integer) as boolean
IsFilterAvailable = true
if ((FilterType = (frmHyperText or cFlt50)) or (FilterType = (frmHyperText or cFltXML))) then
IsFilterAvailable = false
end if
End Function
Function TestJava (FilterType as Integer) as boolean
Dim oObj as Object
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
oObj = createUnoService(cUnoJavaLoader)
LogState (not IsNull (oObj), "Java "+ cMessageNewDoc, FileChannel)
LogState (not IsNull (oObj), "Java "+ cMessageNewDoc, MainFileChannel)
SetStatus (FilterType, cDocNew, not IsNull (oObj))
Print #FileChannel, "---"
Close #FileChannel%
TestJava = not IsNull (oObj)
End Function
Sub CutAndPaste (DocType as Integer, oDoc as Object)
Dim sText as String
Dim oWin as Object
Dim oText as Object
Dim oView as Object
Dim bCutState as boolean, bPasteState as boolean
Select Case ( DocType )
case frmWriter
Dim oCursor as Object
sText = "AutomaticText"
oText = oDoc.GetText
oCursor = oText.CreateTextCursor
oText.InsertString(oCursor, sText, true) ' Cursor selektiert den Text
oView = oDoc.getCurrentController
oView.Select(oCursor)
if bMakeCutTest then
call CutText (oDoc)
if oText.GetString = "" Then
bCutState = True
else
bCutState = False
end If
SetStatus (DocType, cDocCut, bCutState)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
end if
if bMakePasteTest and bMakeCutTest then
call PasteText (oDoc)
if oText.GetString = sText Then
bPasteState = True
else
bPasteState = False
end If
SetStatus (DocType, cDocPaste, bPasteState)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
end if
case frmCalc
DIM oCell as Object
sText = "AutomaticText"
oCell = oDoc.Sheets(0).GetCellByPosition(0, 0)
oCell.String = sText
oView = oDoc.getCurrentController
oView.Select(oCell)
if bMakeCutTest then
call CutText (oDoc)
if oCell.String = "" Then
bCutState = True
else
bCutState = False
end If
SetStatus (DocType, cDocCut, bCutState)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
end if
if bMakePasteTest and bMakeCutTest then
call PasteText (oDoc)
if oCell.String = sText Then
bPasteState = True
else
bPasteState = False
end If
SetStatus (DocType, cDocPaste, bPasteState)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
end if
case frmMessage
case frmImpress, frmDraw
Dim oPage as Object
Dim oRect as Object
Dim xSize as Object
Dim xPoint as Object
Dim bObjState as Boolean
xSize = CreateUnoStruct ("com.sun.star.awt.Size")
xPoint = CreateUnoStruct ("com.sun.star.awt.Point")
xSize.Width = 2000
xSize.Height = 2000
xPoint.x = 10000
xPoint.y = 10000
oPage = oDoc.DrawPages(0)
if DocType = frmImpress Then
oPage.Layout = 20 ' set page layot to none
end If
oRect = oDoc.CreateInstance("com.sun.star.drawing.RectangleShape")
oRect.Size = xSize
oRect.Position = xPoint
oPage.add(oRect)
oView = oDoc.getCurrentController
oView.Select(oRect)
' Prüft ob überhaupt ein Object angelegt wurde
if oPage.count = 1 Then
bObjState = True
else
bObjState = False
end If
if bMakeCutTest then
call CutText (oDoc)
if (oPage.count = 0) and bObjState Then
bCutState = True
else
bCutState = False
end If
SetStatus (DocType, cDocCut, bCutState)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
end if
wait (1000) 'wait after cut
if bMakePasteTest and bMakeCutTest then
call PasteText (oDoc)
if (oPage.count = 1) and bObjState Then
bPasteState = True
else
bPasteState = False
end If
SetStatus (DocType, cDocPaste, bPasteState)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
end if
case frmMath
case frmImage
case frmHyperText
case frmChart
end Select
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 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
</script:module>
|