summaryrefslogtreecommitdiff
path: root/wizards/source/importwizard/FilesModul.xba
blob: f89a74cdc490f09e4a7038c47625210c1f505976 (plain)
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
<?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


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 = &quot;&quot;
	If bIsDocument Then
		bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT)
		bCheckRealType = False
		bRecursive = Applications(ApplIndex,SBDOCRECURSIVE)
		FilterIndex = Index
		sSourceDir = Applications(ApplIndex,SBDOCSOURCE)
	Else
		&apos; Templates
		bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT)
		&apos; In SO the documenttype cannot be derived from the extension name
		bCheckRealType = WizardMode = SBXMLMODE
		If bCheckRealType Then
			&apos; Note: StarOffice-Math-Documents cannot be treated like templates
			bCheckRealType = Index &lt;&gt; 3
			If bCheckRealType Then
				sLocExtension = &quot;vor&quot;
			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()) &gt; -1 Then
			AddListtoFilesList(FilesList(), NewList(), ApplIndex)
			ImportDialog.LabelRetrieval.Label = sProgressPage_2 &amp;  &quot;  &quot; &amp; ReplaceString(sProgressPage_5, Str(Ubound(FilesList()) + 1) &amp; &quot; &quot;, &quot;%1&quot;)
		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 &amp; &quot; &quot; &amp; CStr(AbsDocuFound) &amp;  &quot; &quot; &amp; sProgressMoreDocs
	Else
		AbsTemplateFound = AbsTemplateFound + CurFound
		ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound &amp; &quot; &quot; &amp; CStr(AbsTemplateFound) &amp; &quot; &quot; &amp; sProgressMoreTemplates
  End If
End Sub


Sub ConvertAllDocuments(sFilterName())
Dim FileProperties() as new com.sun.star.beans.PropertyValue
Dim OpenProperties(0) 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

	AbsTemplateFound = 0
	AbsDocuFound = 0
	For i = 0 To ApplCount-1
		&apos;templates
		bIsDocument = False
		CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
		ShowCurrentProgress(bIsDocument, CurFound)
	Next i

	For i = 0 To ApplCount-1
		&apos;documents
		bIsDocument = True
		CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
		ShowCurrentProgress(bIsDocument, CurFound)
	Next i
	TotFound = AbsTemplateFound + AbsDocuFound
	If TotFound &gt; 0 Then
		bCallCancelMsg = True
		InitializeProgressPage(ImportDialog)
		OpenProperties(0).Name = &quot;Hidden&quot;
		OpenProperties(0).Value = True
		MaxFileIndex = Ubound(FilesList(),1)
		For i = 0 To MaxFileIndex
			bDoSave = True
			If bCancelTask Then
				Call CancelTask()
			End if
			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) &amp; &quot;/&quot; &amp; MaxFileIndex + 1 &amp; &quot;  (&quot; &amp; sViewPath &amp; &quot;)&quot;
			If i = 0 Then
				CreateLogDocument(OpenProperties())
			End If
			oDocument = StarDesktop.LoadComponentFromURL(sFullName, &quot;_blank&quot;, 0, OpenProperties())
			If bSetFonts Then
				CheckScripts(oDocument, 1)
			End If

			If Not IsNull(oDocument) Then
				Select Case sExtension
					Case &quot;sxw&quot;, &quot;sxc&quot;, &quot;sxi&quot;, &quot;sxd&quot;, &quot;sxs&quot;, &quot;mml&quot;
						SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), &quot;/&quot;)
						TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), &quot;/&quot;)
					Case Else 								&apos; Templates and Helper-Applications remain
						SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), &quot;/&quot;)
						TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), &quot;/&quot;)
				End Select

				TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir)
				sFileName = GetFileNameWithoutExtension(TargetFile, &quot;/&quot;)
				OldExtension = GetFileNameExtension(TargetFile)

				TargetFile = RTrimStr(TargetFile, OldExtension)
				TargetFile = TargetFile &amp; sExtension
				TargetDir = RTrimStr(TargetFile, sFileName &amp; &quot;.&quot; &amp; sExtension)
				If Not oUcb.Exists(TargetDir) Then
					oUcb.CreateFolder(TargetDir)
				End If
				If oUcb.Exists(TargetFile) Then
					sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), &quot;&lt;1&gt;&quot;)
					sCurFileExists = ReplaceString(sCurFileExists, chr(13), &quot;&lt;CR&gt;&quot;)
					iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle)
					Select Case iOverWrite
						Case 1	&apos; OK
							&apos; In the FileProperty-Bean this is already default
							bDoSave = True
						Case 2 	&apos; Abort
							bCallCancelMsg = False
							Exit For
&apos;							Call CancelTask()
						Case 7 	&apos; No
							bDoSave = False
					End Select
				End If
				If bDoSave Then
					InsertDocNamesToLogDocument(i+1, sFullName, TargetFile)
					On Local Error Resume Next
&apos; Note:	 Files are automatically stored in Default format
&apos;					FileProperties(0).Name = &quot;FilterName&quot;
&apos;					FileProperties(0).Value = CurFilterName
					oDocument.StoreToUrl(TargetFile,FileProperties())
					oDocument.Dispose()
					On Local Error Goto 0
				End If
&apos;				oTaskenum = StarDesktop.Tasks.CreateEnumeration
&apos;				While oTaskEnum.HasmoreElements
&apos;					oTask = oTaskenum.NextElement
&apos;					If oTask.Name &lt;&gt; &quot;&quot; Then
&apos;						oTaskController = oTask.Controller
&apos;						PrintdbgInfo oTaskController
&apos;						If hasUnoInterfaces(oTaskController,&quot;com.sun.star.frame.XModel&quot;) then
&apos;							oModel = oTaskController.Model
&apos;							If Ucase(oModel.Url) = Ucase(sFullName) Then
&apos;								oTask.Close
&apos;							End If
&apos;						End If
&apos;					End If
&apos;				Wend
			End If
		Next i
	End If
	ImportDialog.cbCancel.Label = sCloseButton
	ImportDialog.cbGoOn.Label = sReady
	ImportDialog.cbGoOn.Enabled = True
	bCallCancelMsg = False

&apos;	oLogDocument.Dispose()
&apos;	ImportDialogArea.endExecute
&apos;	ImportDialogArea.Dispose	
	End

	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) = &quot;&quot; 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 &amp; &quot;/&quot; &amp; sTemplateGroupName
		Case SBXMLMODE
			If Index = 3 Then
				&apos; Helper Application
				GetTargetTemplatePath = SOWorkPath
			Else
				GetTargetTemplatePath = SOTemplatePath
			End If
	End Select
End Function


&apos; Retrieves the second value for a next to &apos;SearchString&apos; in
&apos; 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) &lt;&gt; 0 Then
			sLocFilterList() = ArrayoutofString(sFiltername(i,0),&quot;|&quot;, 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),&quot;|&quot;, MaxIndex)
				GetFilterName = sLocFilterList(a)
				sLocExtensionList() = ArrayoutofString(sFilterName(i,2), &quot;|&quot;, 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) &lt;&gt; 0 Then
			SearchArrayForPartString() = i
			Exit Function
		End if
	Next
	IndexinArray = -1
End Function


Function GetMimeTypeList(BigFiltername as STring)
Dim sMimeTypeList()
	sMimeTypeList() = ArrayoutofString(BigFilterName,&quot;;&quot;)
	If Instr(sMimetypeList(0), &quot;|&quot;) &lt;&gt; 0 Then
		sMimeTypeList() = ArrayoutofString(sMimeTypeList(0),&quot;|&quot;)
	End If
	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
		oLogDocument = StarDesktop.LoadComponentFromURL(&quot;private:factory/swriter&quot;, &quot;_blank&quot;, 0, NoArgs())&apos; HiddenProperties()) &apos; HiddenProperties())
		oLogCursor = oLogDocument.Text.CreateTextCursor
		oLogTable =  oLogDocument.CreateInstance(&quot;com.sun.star.text.TextTable&quot;)
		oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
		oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor
&apos; Todo: Strings in Resourcen
		oLogCursor.SetString(sSourceDocuments)
		oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor
		oLogCursor.SetString(sTargetDocuments)
		sLogUrl = SOWorkPath &amp; &quot;/Logfile.sxw&quot;
		Do
			bLogExists = oUcb.Exists(sLogUrl)
			If bLogExists Then
				If i = 2 Then
					sLogUrl = ReplaceString(sLogUrl, &quot;/Logfile_2.sxw&quot;, &quot;/Logfile.sxw&quot;)
				Else
					sLogUrl = ReplaceString(sLogUrl, &quot;/Logfile_&quot; &amp; cStr(i) &amp; &quot;.sxw&quot;, &quot;/Logfile_&quot; &amp; cStr(i-1) &amp; &quot;.sxw&quot;)
				End If
				i = i + 1
			End If
		Loop Until Not bLogExists
&apos; Todo Für das Logdokument einen sinnigen Titel festlegen!	
		oLogDocument.StoreToUrl(sLogUrl, NoArgs())
	EndIf
End Sub


Sub InsertDocNamesToLogDocument(iRow as Integer, SourceUrl as String, TargetUrl as String)
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 iRow &gt; 1 Then
			oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
		End If
		UrlList(0) = SourceUrl
		UrlList(1) = TargetUrl
		For i = 0 To 1
			oLogCursor = oLogTable.GetCellbyPosition(i,iRow).createTextCursor
			LocUrl = UrlList(i)
			oLogCursor.HyperLinkURL = LocUrl
			oLogCursor.HyperLinkName = LocUrl
			oLogCursor.HyperLinkTarget = LocUrl
			LocFileName = FileNameOutOfPath(LocUrl, &quot;/&quot;)
			oLogTable.GetCellbyPosition(i,iRow).InsertString(oLogCursor, LocFileName,False)
		Next i 
		oLogDocument.Store()
	End If
End Sub</script:module>