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
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FilesModul" script:language="StarBasic">Option Explicit
Public AbsTemplateFound as Integer
Public AbsDocuFound as Integer
Public oLogDocument as Object
Public oLogTable as Object
Public bLogExists as Boolean
Public sComment as String
Public MaxCollectIndex as Integer
Public bInsertRow as Boolean
Public sLogUrl as String
Public sCurPassWord as String
Public FileCount as Integer
Public XMLTemplateCount as Integer
Public PathCollection(7,3) as String
Public bIsFirstLogTable as Boolean
Public bFilterTracerIsinsideTable as Boolean
Function ReadCollectionPaths(FilesList() as String, sFilterName() as String)
Dim FilterIndex as Integer
Dim bRecursive as Boolean
Dim SearchDir as String
Dim i as Integer
Dim n as Integer
Dim a as Integer
Dim s as Integer
Dim t as Integer
Dim sFileContent() as String
Dim NewList(0,1) as String
Dim Index as Integer
Dim CurFileName as String
Dim CurExtension as String
Dim CurFileContent as String
Dim XMLTemplateContentList() as String
Dim bIsTemplatePath as Boolean
Dim MaxIndex as Integer
Dim NewContentList() as String
Dim XMLTemplateContentString as String
Dim ApplIndex as Integer
Dim bAssignFileName as Boolean
Dim bInterruptSearch as Boolean
bInterruptSearch = False
For i = 0 To MaxCollectIndex
SearchDir = PathCollection(i,0)
bRecursive = PathCollection(i,1)
sFileContent() = ArrayoutofString(PathCollection(i,2), "|")
NewList() = ReadDirectories(SearchDir, bRecursive, False, False, sFileContent(), "")
If InterruptProcess Then
ReadCollectionPaths() = False
Exit Function
End If
If Ubound(NewList()) > -1 Then
bIsTemplatePath = FieldInList("vor", sFileContent)
If bIsTemplatePath Then
XMLTemplateContentString = PathCollection(i,3)
XMLTemplateContentList() = ArrayoutofString(XMLTemplateContentString, "|")
If Ubound(XMLTemplateContentList()) > -1 Then
MaxIndex = Ubound(NewList())
ReDim Preserve NewList(MaxIndex, 1) as String
ReDim Preserve NewContentList(MaxIndex) as String
a = -1
For n = 0 To MaxIndex
bAssignFileName = True
If InterruptProcess() Then
ReadCollectionPaths() = False
Exit Function
End If
CurFileContent = ""
CurFileName = NewList(n,0)
If (FieldInList(NewList(n,1), XMLTemplateList())) Then
CurFileContent = GetRealFileContent(CurFileName)
t = SearchArrayforPartString(CurFileContent, XMLTemplateContentList())
bAssignFileName = (t > -1)
If bAssignFileName Then
CurFileContent = XMLTemplateContentList(t)
End If
NewList(n,1) = CurFileContent
End If
CurExtension = NewList(n,1)
If bAssignFileName Then
If a < n Then
a = a + 1
NewList(a,0) = CurFileName
NewList(a,1) = CurExtension
If CurFileContent = "" Then
CurFileContent = CurExtension
End If
ApplIndex = GetApplicationIndex(CurFileContent, sFiltername())
NewContentList(a) = ApplIndex
End If
End If
Next n
If a < MaxIndex And a > -1 Then
ReDim Preserve NewList(a, 1) as String
End If
If a > -1 Then
AddListtoFilesList(FilesList(), NewList(), NewContentList())
End If
End If
Else
MaxIndex = Ubound(NewList())
ReDim Preserve NewContentList(MaxIndex) as String
For s = 0 To MaxIndex
CurExtension = NewList(s,1)
NewContentList(s) = GetApplicationIndex(CurExtension, sFiltername())
Next s
AddListtoFilesList(FilesList(), NewList(), NewContentList())
End If
End If
Next i
ReadCollectionPaths() = Ubound(FilesList()) > -1
End Function
Function GetApplicationIndex(CurFileContent as String, sFilterName() as String) as Integer
Dim Index as Integer
Dim i as Integer
Index = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
If Index >= MaxApplCount Then
Index = Index - MaxApplCount
End If
For i = 0 To MaxApplCount - 1
If Applications(i, SBAPPLKEY) = Index Then
GetApplicationIndex() = i
Exit Function
End If
Next i
GetApplicationIndex() = - 1
End Function
Function InterruptProcess() as Boolean
If bCancelTask Or RetValue = 0 Then
bConversionIsRunning = False
InterruptProcess() = True
Exit Function
End if
InterruptProcess() = False
End Function
Sub AddCollectionPath(ApplIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
MaxCollectIndex = MaxCollectIndex + 1
PathCollection(MaxCollectIndex, 0) = Applications(ApplIndex, DocIndex)
PathCollection(MaxCollectIndex, 1) = Applications(ApplIndex, RecursiveIndex)
AddFilterNameToPathItem(ApplIndex, MaxCollectIndex, sFiltername(), DistIndex)
End Sub
Function SetExtension(LocExtension) as String
if (Instr(LocExtension, "vnd.sun.xml.impress")) > 0 then
SetExtension() = "vor|sti|std"
elseif (Instr(LocExtension, "vnd.sun.xml.writer")) > 0 then
SetExtension() = "vor|stw"
elseif (Instr(LocExtension, "vnd.sun.xml.calc")) > 0 then
SetExtension() = "vor|stc"
elseif (Instr(LocExtension, "vnd.sun.xml.draw")) > 0 then
SetExtension() = "vor|std|sti"
endif
End Function
Sub AddFilterNameToPathItem(ApplIndex as Integer, CollectIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim iKey as Integer
Dim CurListString as String
Dim LocExtension as String
Dim LocContentString as String
Dim LocXMLTemplateContent as String
iKey = Applications(ApplIndex, SBAPPLKEY)
CurListString = PathCollection(CollectIndex, 2)
LocExtension = sFilterName(iKey +DistIndex, 0)
If Len(LocExtension) > SBMAXEXTENSIONLENGTH Then ' 7 == Length of two extensions like 'sda|sdd
LocExtension = SetExtension(LocExtension)
LocContentString = sFilterName(iKey +DistIndex, 0)
LocContentString = ReplaceString(LocContentString, "|", ";")
LocXMLTemplateContent = PathCollection(CollectIndex, 3)
If LocXMLTemplateContent = "" Then
LocXMLTemplateContent = LocContentString
Else
LocXMLTemplateContent = LocXMLTemplateContent & "|" & LocContentString
End If
PathCollection(CollectIndex, 3) = LocXMLTemplateContent
End If
If CurListString = "" Then
PathCollection(CollectIndex, 2) = LocExtension
Else
If Instr(CurListString, LocExtension) = 0 Then
PathCollection(CollectIndex, 2) = CurListString & "|" & LocExtension
End If
End If
End Sub
Sub CheckIfToAddPathToCollection(ApplIndex as Integer, bDoConvertIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim CollectIndex as Integer
Dim bCheckDocuType as Boolean
bCheckDocuType = Applications(ApplIndex, bDoConvertIndex)
If bCheckDocuType Then
CollectIndex = GetIndexInMultiArray(PathCollection(), Applications(ApplIndex,DocIndex), 0)
If (CollectIndex >-1) Then
If Applications(ApplIndex, RecursiveIndex) <> PathCollection(CollectIndex, 1) Then
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
Else
AddFilterNameToPathItem(ApplIndex, CollectIndex, sFilterName(), DistIndex)
End If
Else
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
End If
End If
End Sub
Sub CollectPaths(sFiltername() as String)
Dim i as Integer
Dim XMLTemplateContentString as String
MaxCollectIndex = -1
For i = 0 To ApplCount-1
CheckIfToAddPathToCollection(i, SBDOCCONVERT, SBDOCSOURCE, SBDOCRECURSIVE, sFilterName(), 0)
Next i
XMLTemplateCount = 0
XMLTemplateContentString = ""
For i = 0 To ApplCount-1
If WizardMode = SBXMLMODE Then
XMLTemplateCount = XMLTemplateCount + 1
End If
CheckIfToAddPathToCollection(i, SBTEMPLCONVERT, SBTEMPLSOURCE, SBTEMPLRECURSIVE, sFilterName(), MaxApplCount)
Next i
End Sub
Sub ConvertAllDocuments(sFilterName() as String)
Dim FileProperties(1) as new com.sun.star.beans.PropertyValue
Dim PWFileProperties(2) as New com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
Dim OpenProperties(4) as new com.sun.star.beans.PropertyValue
Dim oInteractionHandler as Object
Dim InteractionTypes(0) as Long
Dim FilesList(0,2) as String
Dim sViewPath as String
Dim i as Integer
Dim FilterIndex as Integer
Dim sSourceUrl as String
Dim CurFilename as String
Dim oDocument as Object
Dim sExtension as String
Dim OldExtension as String
Dim CurFound as Integer
Dim TotFound as Integer
Dim TargetStemDir as String
Dim SourceStemDir as String
Dim TargetDir as String
Dim sTargetUrl as String
Dim CurFilterName as String
Dim ApplIndex as Integer
Dim Index as Integer
Dim bIsDocument as Boolean
Dim bDoSave as Boolean
Dim sCurFileExists as String
Dim MaxFileIndex as Integer
Dim bContainsBasicMacro as Boolean
Dim bIsPassWordProtected as Boolean
Dim iOverwrite as Integer
Dim sMimeTypeorExtension as String
Dim sPrevMimeTypeorExtension as String
bConversionisrunning = True
InteractionTypes(0) = com.sun.star.task.PasswordRequestMode.PASSWORD_REENTER
oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler")
oInteractionHandler.initialize(InteractionTypes())
iGeneralOverwrite = SBOVERWRITEUNDEFINED
bConversionIsRunning = True
bLogExists = false
AbsTemplateFound = 0
AbsDocuFound = 0
CollectPaths(sFiltername())
If Not ReadCollectionPaths(FilesList(), sFilterName()) Then
TotFound = 0
SetProgressDisplay(0)
bConversionisrunning = false
FinalizeDialogButtons()
Exit Sub
End If
TotFound = Ubound(FilesList()) + 1
If FilesList(0,0) = "" Then ' Querying the number of fields in a multidimensionl Array is unsecure
TotFound = 0 ' because it will return the value 0 (and not -1) even when the Array is empty
SetProgressDisplay(0)
End If
BubbleSortList(FilesList(), true)
If TotFound > 0 Then
CreateLogDocument(OpenProperties())
InitializeProgressPage(ImportDialog)
OpenProperties(0).Name = "Hidden"
OpenProperties(0).Value = True
OpenProperties(1).Name = "AsTemplate"
OpenProperties(1).Value = False
OpenProperties(2).Name = "MacroExecutionMode"
OpenProperties(2).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE
OpenProperties(3).Name = "UpdateDocMode"
OpenProperties(3).Value = com.sun.star.document.UpdateDocMode.NO_UPDATE
OpenProperties(4).Name = "InteractionHandler"
OpenProperties(4).Value = oInteractionHandler
MaxFileIndex = Ubound(FilesList(),1)
FileCount = 0
For i = 0 To MaxFileIndex
sComment = ""
If InterruptProcess() Then
Exit For
End If
bDoSave = True
sSourceUrl = FilesList(i,0)
sPrevMimeTypeorExtension = sMimeTypeorExtension
sMimeTypeorExtension = FilesList(i,1)
CurFiltername = GetFilterName(sMimeTypeorExtension, sFilterName(), sExtension, FilterIndex)
ApplIndex = FilesList(i,2)
If sMimeTypeorExtension <> sPrevMimeTypeorExtension Then
CreateLogTable(ApplIndex, sMimeTypeOrExtension, sFiltername()
End If
If ApplIndex > Ubound(Applications) or (ApplIndex < 0) Then
Msgbox "Applicationindex out of bounds:" & sSourcUrl
End If
sViewPath = ConvertFromUrl(sSourceUrl) ' CutPathView(sSourceUrl, 70)
ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & " (" & sViewPath & ")"
Select Case lcase(sExtension)
Case "odt", "ods", "odp", "odg", "odm", "odf"
SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), "/")
TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), "/")
Case Else ' Templates and Helper-Applications remain
SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), "/")
TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), "/")
End Select
sTargetUrl = ReplaceString(sSourceUrl, TargetStemDir, SourceStemDir)
CurFilename = GetFileNameWithoutExtension(sTargetUrl, "/")
OldExtension = GetFileNameExtension(sTargetUrl)
sTargetUrl = RTrimStr(sTargetUrl, OldExtension)
sTargetUrl = sTargetUrl & sExtension
TargetDir = RTrimStr(sTargetUrl, CurFilename & "." & sExtension)
If (oUcb.Exists(sTargetUrl)) Then
If (iGeneralOverwrite <> SBOVERWRITEALWAYS) Then
If (iGeneralOverwrite = SBOVERWRITEUNDEFINED) Then
ShowOverwriteAllDialog(sTargetUrl, sTitle)
bDoSave = (iGeneralOverwrite = SBOVERWRITEQUERY) Or (iGeneralOverwrite = SBOVERWRITEALWAYS)
Elseif iGeneralOverwrite = SBOVERWRITENEVER Then
bDoSave = False
ElseIf ((iGeneralOverWrite = SBOVERWRITEQUERY) OR (iGeneralOverwrite = SBOVERWRITECANCEL)) Then
' Todo: According to AS there might come a new feature that storeasUrl could possibly rise a UI dialog.
' In this case my own UI becomes obsolete
sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(sTargetUrl), "<1>")
sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>")
iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle)
Select Case iOverWrite
Case 1 ' OK
' In the FileProperty-Bean this is already default
bDoSave = True
Case 2 ' Abort
CancelTask(False)
bDoSave = False
Case 7 ' No
bDoSave = False
End Select
End If
End If
End If
If bDoSave Then
If Not oUcb.Exists(TargetDir) Then
bDoSave = CreateFolder(TargetDir)
End If
If bDoSave Then
oDocument = StarDesktop.LoadComponentFromURL(sSourceUrl, "_default", 0, OpenProperties())
If Not IsNull(oDocument) Then
InsertSourceUrlToLogDocument(sSourceUrl, "")
bIsPassWordProtected = CheckPassWordProtection(oDocument)
CheckIfMacroExists(oDocument.BasicLibraries, sComment)
On Local Error Goto NOSAVING
If bIsPassWordProtected Then
PWFileProperties(0).Name = "FilterName"
PWFileProperties(0).Value = CurFilterName
PWFileProperties(1).Name = "Overwrite"
PWFileProperties(1).Value = True
PWFileProperties(2).Name = "Password"
PWFileProperties(2).Value = sCurPassWord
oDocument.StoreAsUrl(sTargetUrl, PWFileProperties())
Else
FileProperties(0).Name = "FilterName"
FileProperties(0).Value = CurFilterName
FileProperties(1).Name = "Overwrite"
FileProperties(1).Value = True
oDocument.StoreAsUrl(sTargetUrl,FileProperties())
End If
' Todo: Make sure that an errorbox pops up when saving fails
NOSAVING:
If Err <> 0 Then
sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(sTargetUrl), "<1>")
sComment = ConcatComment(sComment, sCurCouldnotsaveDocument)
Resume LETSGO
LETSGO:
Else
FileCount = FileCount + 1
End If
oDocument.Dispose()
InsertTargetUrlToLogDocument(sTargetUrl, sComment, ApplIndex)
Else
sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sSourceUrl), "<1>")
sComment = ConcatComment(sComment, sCurCouldnotopenDocument)
InsertSourceUrlToLogDocument(sSourceUrl, sComment)
End If
End If
End If
Next i
End If
AddLogStatistics()
FinalizeDialogButtons()
bConversionIsRunning = False
Exit Sub
RTError:
Msgbox sRTErrorDesc, 16, sRTErrorHeader
End Sub
Sub AddListtoFilesList(FirstList(), SecList(), NewContentList() as String)
Dim sLocExtension as String
Dim FirstStart as Integer
Dim FirstEnd as Integer
Dim i as Integer
Dim s as Integer
If FirstList(0,0) = "" Then
FirstStart = Ubound(FirstList(),1)
Else
FirstStart = Ubound(FirstList(),1) + 1
End If
FirstEnd = FirstStart + Ubound(SecList(),1)
ReDim Preserve FirstList(FirstEnd,2)
s = 0
For i = FirstStart To FirstEnd
FirstList(i,0) = SecList(s,0)
FirstList(i,1) = SecList(s,1)
sLocExtension = lcase(FirstList(i,1))
Select Case sLocExtension
Case "sdw", "sdc", "sda", "sdd", "smf", "sgl", "doc", "xls", "ppt", "sxi" , "sxw" , "sxd" , "sxg" , "sxm" , "sxc" , "pps"
AbsDocuFound = AbsDocuFound + 1
Case else
AbsTemplateFound = AbsTemplateFound + 1
End Select
FirstList(i,2) = CStr(NewContentList(s))
s = s + 1
Next i
SetProgressDisplay(Ubound(FirstList()) + 1)
End Sub
Function GetTargetTemplatePath(Index as Integer)
Select Case WizardMode
Case SBMICROSOFTMODE
GetTargetTemplatePath() = SOTemplatePath & "/" & sTemplateGroupName
Case SBXMLMODE
If Index = 3 Then
' Helper Application
GetTargetTemplatePath = SOWorkPath
Else
GetTargetTemplatePath = SOTemplatePath
End If
End Select
End Function
' Retrieves the second value for a next to 'SearchString' in
' a two-dimensional string-Array
Function GetFilterName(sMimetypeorExtension as String, sFilterName(), sExtension as string, FilterIndex as Integer) as String
Dim i as Integer
Dim MaxIndex as Integer
Dim sLocFilterlist() as String
For i = 0 To Ubound(sFiltername(),1)
If Instr(1,sFilterName(i,0),sMimeTypeOrExtension) <> 0 Then
sLocFilterList() = ArrayoutofString(sFiltername(i,0),"|", MaxIndex)
If MaxIndex = 0 Then
sExtension = sFiltername(i,2)
GetFilterName = sFilterName(i,1)
Else
Dim b as Integer
Dim sLocExtensionList() as String
b = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex)
GetFilterName = sLocFilterList(b)
sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex)
sExtension = sLocExtensionList(b)
End If
Exit For
End If
Next
FilterIndex = i
End Function
Function SearchArrayforPartString(SearchString as String, LocList()) as Integer
Dim i as Integer
Dim a as Integer
Dim StringList() as String
For i = Lbound(LocList(),1) to Ubound(LocList(),1)
StringList() = ArrayoutofString(LocList(i), "|")
For a = 0 To Ubound(StringList())
If (Instr(1, SearchString, StringList(a)) <> 0) Then
SearchArrayForPartString() = i
Exit Function
End If
Next a
Next i
SearchArrayForPartString() = -1
End Function
Sub CreateLogTable(ApplIndex as Integer, CurFileContent as String, sFilterName() as String)
Dim oLogCursor as Object
Dim oLogRows as Object
Dim FilterIndex as Integer
Dim sDocumentType as String
Dim oTextCursor
Dim oCell
If Not bLogExists Then
Exit Sub
End If
bFilterTracerIsinsideTable = False
FilterIndex = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
sDocumentType = sFiltername(FilterIndex,3)
oLogCursor = oLogDocument.Text.createTextCursor()
oLogCursor.GotoEnd(False)
If Not bIsFirstLogTable Then
oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
Else
bisFirstLogTable = False
End If
oLogCursor.HyperLinkURL = ""
oLogCursor.HyperLinkName = ""
oLogCursor.HyperLinkTarget = ""
oLogCursor.ParaStyleName = "Heading 1"
oLogCursor.setString(sDocumentType)
If WizardMode = SBMICROSOFTMODE Then
If bFilterTracingAvailable Then
If bMSApplFilterTracingAvailable(ApplIndex) Then
Dim CurFilterTracingPath as String
CurFilterTracingPath = FilterTracingLogPath(ApplIndex)
bFilterTracerIsinsideTable = (bTakeOverTargetName(ApplIndex) Or bTakeOverPathName(ApplIndex))
If Not bFilterTracerIsinsideTable Then
oLogCursor.CollapseToEnd()
oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
InsertCommandButtonatViewCursor(oLogDocument, oLogCursor, CurFilterTracingPath)
End If
End If
End If
End If
oLogCursor.CollapsetoEnd()
oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oLogTable = oLogDocument.CreateInstance("com.sun.star.text.TextTable")
oLogTable.RepeatHeadline = true
If bFilterTracerIsinsideTable Then
oLogTable.initialize(2,3)
End If
oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
oTextCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor()
oTextCursor.SetString(sSourceDocuments)
oTextCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor()
oTextCursor.SetString(sTargetDocuments)
If bFilterTracerIsinsideTable Then
oTextCursor = oLogTable.GetCellbyPosition(2,0).createTextCursor()
oTextCursor.SetString("FilterTracer")
End If
bInsertRow = False
End Sub
Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
Dim aSize As New com.sun.star.awt.Size
aSize.Width = iWidth
aSize.Height = iHeight
GetSize() = aSize
End Function
Sub InsertCommandButtonatViewCursor(oLocDocument, oLocCursor, TargetUrl as String, Optional aSize)
Dim oDocument
Dim oController
Dim oCommandButton
Dim oShape
Dim oDrawPage
Dim oCommandControl
Dim oEvent
Dim oCell
oCommandButton = oLocDocument.createInstance("com.sun.star.form.component.CommandButton")
oShape = oLocDocument.CreateInstance ("com.sun.star.drawing.ControlShape")
If IsMissing(aSize) Then
oShape.Size = GetSize(4000, 600)
End If
oCommandButton.Label = FileNameoutofPath(Targeturl)
oCommandButton.TargetFrame = "_default"
oCommandButton.ButtonType = com.sun.star.form.FormButtonType.URL
oCommandbutton.DispatchUrlInternal = True
oCommandButton.TargetURL = ConverttoUrl(TargetUrl)
oShape.Control = oCommandbutton
oLocCursor.Text.InsertTextContent(oLocCursor, oShape, True)
End Sub
Sub CreateLogDocument(HiddenProperties())
Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue
Dim NoArgs()
Dim i as Integer
Dim bLogIsThere as Boolean
If ImportDialog.chkLogfile.State = 1 Then
i = 2
OpenProperties(0).Name = "Hidden"
OpenProperties(0).Value = True
oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_default", 4, OpenProperties())
SOWorkPath = RTrimStr(SOWorkPath,"/")
sLogUrl = SOWorkPath & "/Logfile.odt"
Do
bLogIsThere = oUcb.Exists(sLogUrl)
If bLogIsThere Then
If i = 2 Then
sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.odt", "/Logfile.odt")
Else
sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".odt", "/Logfile_" & cStr(i-1) & ".odt")
End If
i = i + 1
End If
Loop Until Not bLogIsThere
bLogExists = True
oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
End If
End Sub
Function GetFilterTracingLogPath(sTargetUrl as String, ApplIndex) as String
Dim TargetFileName as String
Dim sTargetFolder as String
Dim CurFilterTracingPath as String
Dim CurFilterTracingname as String
Dim CurFilterFolder as String
CurFilterTracingPath = FilterTracingLogPath(ApplIndex)
If bTakeOverTargetName(ApplIndex) Then
TargetFilename = GetFileNameWithoutextension(sTargetUrl, "/")
CurFilterFolder = DirectoryNameoutofPath(FilterTracingLogPath(ApplIndex), "/")
CurFilterTracingpath = CurFilterFolder & "/" & TargetFilename & ".log"
End If
If bTakeOverPathName(ApplIndex) Then 'Replace the Folder in the FilterTracerpath by the Folder of the targetUrl
sTargetFolder = DirectoryNameoutofPath(sTargetUrl,"/")
CurFilterTracingPath = sTargetFolder & "/" & FileNameoutofPath(CurFilterTracingPath, "/")
End If
GetFilterTracingLogPath() = CurFilterTracingPath
End Function
Sub InsertTargetUrlToLogDocument(sTargetUrl as String, sComment as String, ApplIndex as Integer)
Dim oCell
Dim oTextCursor
Dim CurFilterTracingpath as String
If (bLogExists) And (sTargetUrl <> "") Then
If sTargetUrl <> "" Then
oCell = oLogTable.GetCellbyPosition(1,oLogTable.Rows.Count-1)
InsertCommentToLogCell(sComment, oCell)
InsertHyperLinkToLogCell(sTargetUrl, oCell)
If bFilterTracerIsinsideTable Then
oCell = oLogTable.getCellByPosition(2, oLogTable.Rows.Count-1)
oTextCursor = oCell.Text.CreateTextCursor()
CurFilterTracingpath = GetFilterTracingLogPath(sTargetUrl, ApplIndex)
InsertCommandButtonatViewCursor(oLogDocument, oTextCursor, CurFilterTracingPath)
End If
oLogDocument.Store()
End If
End If
End Sub
Sub InsertSourceUrlToLogDocument(SourceUrl as String, sComment) '
Dim oCell as Object
If bLogExists Then
If bInsertRow Then
oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
Else
bInsertRow = True
End If
oCell = oLogTable.GetCellbyPosition(0,oLogTable.Rows.Count-1)
InsertCommentToLogCell(sComment, oCell)
InsertHyperLinkToLogCell(SourceUrl, oCell)
oLogDocument.Store()
End If
End Sub
Sub InsertHyperLinkToLogCell(sUrl as String, oCell as Object)
Dim oLogCursor as Object
Dim LocFileName as String
oLogCursor = oCell.createTextCursor()
oLogCursor.CollapseToStart()
oLogCursor.HyperLinkURL = sUrl
oLogCursor.HyperLinkName = sUrl
oLogCursor.HyperLinkTarget = sUrl
LocFileName = FileNameOutOfPath(sUrl)
oCell.InsertString(oLogCursor, LocFileName,False)
End Sub
Sub InsertCommentToLogCell(sComment as string, oCell as Object)
Dim oCommentCursor as Object
If sComment <> "" Then
oCommentCursor = oCell.createTextCursor()
oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oCell.insertString(oCommentCursor, sComment, false)
End If
End Sub
Sub AddLogStatistics()
Dim oCell as Object
Dim oLogCursor as Object
Dim MaxRowIndex as Integer
If bLogExists Then
MaxRowIndex = oLogTable.Rows.Count
sLogSummary = ReplaceString(sLogSummary, FileCount, "<COUNT>")
' oLogTable.Rows.InsertByIndex(MaxRowIndex, 1)
' oCell = oLogTable.GetCellbyPosition(0, MaxRowIndex)
' oLogCursor = oCell.createTextCursor()
' oCell.InsertString(oLogCursor, sLogSummary,False)
' MergeRange(oLogTable, oCell, 1)
oLogCursor = oLogDocument.Text.CreateTextCursor
oLogCursor.gotoEnd(False)
oLogCursor.HyperLinkURL = ""
oLogCursor.HyperLinkName = ""
oLogCursor.HyperLinkTarget = ""
oLogCursor.SetString(sLogSummary)
oLogDocument.Store()
oLogDocument.Dispose()
bLogExists = False
End If
End Sub
Function CheckIfMacroExists(oBasicLibraries as Object, sComment as String) as Boolean
Dim ModuleNames() as String
Dim ModuleName as String
Dim MaxLibIndex as Integer
Dim MaxModuleIndex as Integer
Dim bMacroExists as Boolean
Dim n as Integer
Dim m as Integer
Dim LibName as String
Dim sBasicCode as String
Dim oLibrary as Object
bMacroExists = False
bMacroExists = oBasicLibraries.hasElements
If bMacroExists Then
MaxLibIndex = Ubound(oBasicLibraries.ElementNames())
For n = 0 To MaxLibIndex
LibName = oBasicLibraries.ElementNames(n)
If oBasicLibraries.isLibraryLoaded(LibName) Then
oLibrary = oBasicLibraries.getbyName(LibName)
If oLibrary.hasElements() Then
MaxModuleIndex = Ubound(oLibrary.ElementNames())
For m = 0 To MaxModuleIndex
ModuleName = oLibrary.ElementNames(m)
sBasicCode = oLibrary.getbyName(ModuleName)
If sBasicCode <> "" Then
ConcatComment(sComment, sReeditMacro)
CheckIfMacroExists() = True
Exit Function
End If
Next m
End If
End If
Next n
End If
CheckIfMacroExists() = False
End Function
Function CheckPassWordProtection(oDocument as Object)
Dim bIsPassWordProtected as Boolean
Dim i as Integer
Dim oArgs()
Dim MaxIndex as Integer
Dim sblabla as String
bIsPassWordProtected = false
oArgs() = oDocument.getArgs()
MaxIndex = Ubound(oArgs())
For i = 0 To MaxIndex
sblabla = oArgs(i).Name
If oArgs(i).Name = "Password" Then
bIsPassWordProtected = True
sCurPassWord = oArgs(i).Value
Exit For
End If
Next i
CheckPassWordProtection() = bIsPassWordProtected
End Function
Sub OpenLogDocument()
bShowLogFile = True
ImportDialogArea.endexecute()
End Sub
Sub MergeRange(oTable as Object, oCell as Object, MergeCount as Integer)
Dim oTableCursor as Object
oTableCursor = oTable.createCursorByCellName(oCell.CellName)
oTableCursor.goRight(MergeCount, True)
oTableCursor.mergeRange()
End Sub
Function ConcatComment(sComment as String, AdditionalComment as String)
If sComment = "" Then
sComment = AdditionalComment
Else
sComment = sComment & chr(13) + AdditionalComment
End If
ConcatComment = sComment
End Function
</script:module>
|