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
|
<?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 bInsertRow as Boolean
Function ReadApplicationDirectories(ApplIndex as Integer, FilesList(),bIsDocument as Boolean, sFiltername()) as Integer
Dim bCheckDocuType as Boolean
Dim FilterIndex as Integer
Dim bRecursive as Boolean
Dim sSourceDir as String
Dim bCheckRealType as Boolean
Dim a as Integer
Dim sFileContent() as String
Dim NewList() as String
Dim Index as Integer
Dim sLocExtension as String
Index = Applications(ApplIndex,SBAPPLKEY)
sLocExtension = ""
If bIsDocument Then
bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT)
bCheckRealType = False
bRecursive = Applications(ApplIndex,SBDOCRECURSIVE)
FilterIndex = Index
sSourceDir = Applications(ApplIndex,SBDOCSOURCE)
Else
' Templates
bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT)
' In SO the documenttype cannot be derived from the extension name
bCheckRealType = WizardMode = SBXMLMODE
If bCheckRealType Then
' Note: StarOffice-Math-Documents cannot be treated like templates
bCheckRealType = Index <> 3
If bCheckRealType Then
sLocExtension = "vor"
End If
bIsDocument = Not bCheckRealType
End If
bRecursive = Applications(ApplIndex,SBTEMPLRECURSIVE)
FilterIndex = Index + MaxApplCount
sSourceDir = Applications(ApplIndex,SBTEMPLSOURCE)
End If
If bCheckDocuType Then
sFileContent() = GetMimeTypeList(sFilterName(FilterIndex))
NewList() = ReadDirectories(sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension)
If Ubound(NewList()) > -1 Then
AddListtoFilesList(FilesList(), NewList(), ApplIndex)
ImportDialog.LabelRetrieval.Label = sProgressPage_2 & " " & ReplaceString(sProgressPage_5, Str(Ubound(FilesList()) + 1) & " ", "%1")
End If
End If
ReadApplicationDirectories() = Ubound(NewList(),1) + 1
End Function
Sub ShowCurrentProgress(bIsDocument as Boolean, CurFound as Integer)
If bIsDocument Then
AbsDocuFound = AbsDocuFound + CurFound
ImportDialog.LabelCurDocumentRetrieval.Label = sProgressFound & " " & CStr(AbsDocuFound) & " " & sProgressMoreDocs
Else
AbsTemplateFound = AbsTemplateFound + CurFound
ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound & " " & CStr(AbsTemplateFound) & " " & sProgressMoreTemplates
End If
End Sub
Sub ConvertAllDocuments(sFilterName())
Dim FileProperties(0) as new com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
Dim OpenProperties(1) as new com.sun.star.beans.PropertyValue
Dim FilesList(0,2) as String
Dim sViewPath as String
Dim i as Integer
Dim FilterIndex as Integer
Dim sFullName as String
Dim sFileName 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 TargetFile as String
Dim CurFilterName as String
Dim ApplIndex as Integer
Dim Index as Integer
Dim bIsDocument as Boolean
Dim iOverWrite as Integer
Dim bDoSave as Boolean
Dim sCurFileExists as String
Dim oTaskEnum as Object
Dim oTask as Object
Dim oModel as Object
Dim oTaskController as Object
Dim MaxFileIndex as Integer
Dim sOldExtension as String
bConversionIsRunnig = True
AbsTemplateFound = 0
AbsDocuFound = 0
For i = 0 To ApplCount-1
'templates
bIsDocument = False
CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
ShowCurrentProgress(bIsDocument, CurFound)
Next i
For i = 0 To ApplCount-1
'documents
bIsDocument = True
CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
ShowCurrentProgress(bIsDocument, CurFound)
Next i
TotFound = AbsTemplateFound + AbsDocuFound
CreateLogDocument(OpenProperties())
If TotFound > 0 Then
InitializeProgressPage(ImportDialog)
OpenProperties(0).Name = "Hidden"
OpenProperties(0).Value = True
OpenProperties(1).Name = "AsTemplate"
MaxFileIndex = Ubound(FilesList(),1)
For i = 0 To MaxFileIndex
If bCancelTask Then
bConversionIsRunnig = False
Exit Sub
End if
bDoSave = True
sFullName = FilesList(i,0)
CurFiltername = GetFilterName(FilesList(i,1), sFilterName(), sExtension, FilterIndex)
ApplIndex = FilesList(i,2)
sViewPath = CutPathView(sFullName, 60)
ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & " (" & sViewPath & ")"
sOldExtension = GetFileNameExtension(sFullName, "/")
Select Case sOldExtension
Case "vor", "dot", "xlt", "pot"
OpenProperties(1).Value = False
Case Else
OpenProperties(1).Value = True
End Select
oDocument = StarDesktop.LoadComponentFromURL(sFullName, "_blank", 0, OpenProperties())
If bSetFonts Then
CheckScripts(oDocument, 1)
End If
If Not IsNull(oDocument) Then
Select Case sExtension
Case "sxw", "sxc", "sxi", "sxd", "sxs", "sxm"
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
TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir)
sFileName = GetFileNameWithoutExtension(TargetFile, "/")
OldExtension = GetFileNameExtension(TargetFile)
TargetFile = RTrimStr(TargetFile, OldExtension)
TargetFile = TargetFile & sExtension
TargetDir = RTrimStr(TargetFile, sFileName & "." & sExtension)
If Not oUcb.Exists(TargetDir) Then
oUcb.CreateFolder(TargetDir)
End If
If oUcb.Exists(TargetFile) Then
sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), "<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
If bDoSave Then
InsertDocNamesToLogDocument(sFullName, TargetFile)
On Local Error Resume Next
FileProperties(0).Name = "FilterName"
FileProperties(0).Value = CurFilterName
oDocument.StoreAsUrl(TargetFile,FileProperties())
oDocument.Dispose()
On Local Error Goto 0
End If
' oTaskenum = StarDesktop.Tasks.CreateEnumeration
' While oTaskEnum.HasmoreElements
' oTask = oTaskenum.NextElement
' If oTask.Name <> "" Then
' oTaskController = oTask.Controller
' PrintdbgInfo oTaskController
' If hasUnoInterfaces(oTaskController,"com.sun.star.frame.XModel") then
' oModel = oTaskController.Model
' If Ucase(oModel.Url) = Ucase(sFullName) Then
' oTask.Close
' End If
' End If
' End If
' Wend
End If
Next i
End If
ImportDialog.cbCancel.Label = sCloseButton
ImportDialog.cbGoOn.Label = sReady
ImportDialog.cbGoOn.Enabled = True
bConversionIsRunnig = False
Exit Sub
RTError:
Msgbox sRTErrorDesc, 16, sRTErrorHeader
End Sub
Sub AddListtoFilesList(FirstList(), SecList(), ApplIndex as Integer)
Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, 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)
FirstList(i,2) = CStr(ApplIndex)
s = s + 1
Next i
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 a as Integer
Dim sLocExtensionList() as String
a = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex)
GetFilterName = sLocFilterList(a)
sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex)
sExtension = sLocExtensionList(a)
End If
Exit For
End If
Next
FilterIndex = i
End Function
Function SearchArrayforPartString(SearchString as String, LocList()) as Integer
Dim i as integer
For i = Lbound(LocList(),1) to Ubound(LocList(),1)
If Instr(1,LocList(i), SearchString) <> 0 Then
SearchArrayForPartString() = i
Exit Function
End if
Next
IndexinArray = -1
End Function
Function GetMimeTypeList(BigFiltername as STring)
Dim sBigList() as String
Dim sSmallList() as String
Dim sMimeTypeList()
Dim BigMaxIndex as Integer
Dim n as Integer
sBigList() = ArrayoutofString(BigFilterName,"|", BigMaxIndex)
For n = 0 To BigMaxIndex
sSmallList() = ArrayoutofString(sBigList(n),";")
sMimeTypeList() = AddListToList(sMimeTypeList(), sSmallList())
Next n
GetMimetypeList() = sMimeTypeList()
End Function
Sub CreateLogDocument(HiddenProperties())
Dim oTableCursor as Object
Dim oLogCursor as Object
Dim oLogRows as Object
Dim sLogUrl as String
Dim NoArgs()
Dim i as Integer
Dim bLogExists as Boolean
If ImportDialog.chkLogfile.State = 1 Then
i = 2
'Dim oArg() as new com.sun.star.beans.PropertyValue
'Dim oUrl as new com.sun.star.util.URL
'Dim oDisp as Object
' oUrl.Complete = "private:factory/swriter"
' oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)
' oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)
' oDisp.dispatch(oUrl, oArg())
oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 4, NoArgs())' HiddenProperties()) ' HiddenProperties())
oLogCursor = oLogDocument.Text.CreateTextCursor
oLogTable = oLogDocument.CreateInstance("com.sun.star.text.TextTable")
oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor
oLogCursor.SetString(sSourceDocuments)
oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor
oLogCursor.SetString(sTargetDocuments)
bInsertRow = False
' Todo: Strings in Resourcen
sLogUrl = SOWorkPath & "/Logfile.sxw"
Do
bLogExists = oUcb.Exists(sLogUrl)
If bLogExists Then
If i = 2 Then
sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.sxw", "/Logfile.sxw")
Else
sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".sxw", "/Logfile_" & cStr(i-1) & ".sxw")
End If
i = i + 1
End If
Loop Until Not bLogExists
oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
EndIf
End Sub
Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String)
Dim oCell as Object
Dim oLogCursor as Object
Dim UrlList(1) as String
Dim LocFileName as String
Dim LocUrl as String
Dim i as Integer
If ImportDialog.chkLogfile.State = 1 Then
If bInsertRow Then
oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
Else
bInsertRow = True
End If
UrlList(0) = SourceUrl
UrlList(1) = TargetUrl
For i = 0 To 1
oCell = oLogTable.GetCellbyPosition(i,oLogTable.Rows.Count-1)
oLogCursor = oCell.createTextCursor()
LocUrl = UrlList(i)
oLogCursor.HyperLinkURL = LocUrl
oLogCursor.HyperLinkName = LocUrl
oLogCursor.HyperLinkTarget = LocUrl
LocFileName = FileNameOutOfPath(LocUrl)
oCell.InsertString(oLogCursor, LocFileName,False)
Next i
oLogDocument.Store()
End If
End Sub</script:module>
|