summaryrefslogtreecommitdiff
path: root/wizards/source/tools/UCB.xba
blob: 524afe60c4d9491a044c2f58a73b909c578cdb65 (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
<?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="UCB" script:language="StarBasic">&apos;Option explicit
Public oDocument
Public oDocInfo as object
Const SBMAXDIRCOUNT = 10
Dim CurDirMaxCount as Integer
Dim sDirArray(SBMAXDIRCOUNT-1) as String
Dim DirIndex As Integer
Dim iDirCount as Integer
Public bInterruptSearch as Boolean
Public NoArgs()as New com.sun.star.beans.PropertyValue

Sub Main()
Dim LocsfileContent(0) as String
	LocsfileContent(0) = &quot;*&quot;
	ReadDirectories(&quot;file:///space&quot;, LocsfileContent(), True, False, false)
End Sub

&apos;        ReadDirectories(      sSourceDir,          bRecursive,          bCheckRealType, False, sFileContent(), sLocExtension)

Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean,  bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
Dim i as integer
Dim Status as Object
Dim FileCountinDir as Integer
Dim RealFileContent as String
Dim FileName as string
Dim oUcbObject as Object
Dim DirContent()
Dim CurIndex as Integer
Dim MaxIndex as Integer
Dim StartUbound as Integer
Dim FileExtension as String
	StartUbound = 5
	MaxIndex = StartUBound
	CurDirMaxCount = SBMAXDIRCOUNT
Dim sFileArray(StartUbound,1) as String
	On Local Error Goto FILESYSTEMPROBLEM:
	CurIndex = -1
	&apos; Todo: Is the last separator valid?
	DirIndex = 0
	sDirArray(iDirIndex) = AnchorDir
	iDirCount = 1
	oDocInfo = CreateUnoService(&quot;com.sun.star.document.DocumentProperties&quot;)
	oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	If oUcbObject.Exists(AnchorDir) Then
		Do
			AnchorDir = sDirArray(DirIndex)
			On Local Error Resume Next
			DirContent() = oUcbObject.GetFolderContents(AnchorDir,True)
			DirIndex = DirIndex + 1
			On Local Error Goto 0
			On Local Error Goto FILESYSTEMPROBLEM:
			If Ubound(DirContent()) &lt;&gt; -1 Then
				FileCountinDir = Ubound(DirContent())+ 1
				For i = 0 to FilecountinDir -1
					If bInterruptSearch = True Then
						Exit Do
					End If
					
					Filename = DirContent(i)
					If oUcbObject.IsFolder(FileName) Then
						If brecursive Then
							AddFoldertoList(FileName, DirIndex)
						End If
					Else
						If bcheckFileType Then
							RealFileContent = GetRealFileContent(FileName)
						Else
							RealFileContent = GetFileNameExtension(FileName)
						End If
						If RealFileContent &lt;&gt; &quot;&quot; Then
							&apos; Retrieve the Index in the Array, where a Filename is positioned
							If Not IsMissing(sFileContent()) Then
								If (FieldinArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then
									&apos; The extension of the current file passes the filter and is therefor admitted to the
									&apos; fileList
									If Not IsMissing(sExtension) Then
										If sExtension &lt;&gt; &quot;&quot; Then
											&apos; Consider that some Formats like old StarOffice Templates with the extension &quot;.vor&quot; can only be
											&apos; precisely identified by their mimetype and their extension
											FileExtension = GetFileNameExtension(FileName)
											If FileExtension = sExtension Then
												AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
											End If
										Else
											AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
										End If
									Else
										AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
									End If
								End If
							Else
								AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
							End If
							If CurIndex = MaxIndex Then
								MaxIndex = MaxIndex + StartUbound
								ReDim Preserve sFileArray(MaxIndex,1) as String
							End If
						End If
					End If
				Next i
			End If
		Loop Until DirIndex &gt;= iDirCount
		If CurIndex &gt; -1 Then
			ReDim Preserve sFileArray(CurIndex,1) as String
		Else
			ReDim sFileArray() as String
		End If
	Else
		Msgbox(&quot;Directory &apos;&quot; &amp; ConvertFromUrl(AnchorDir) &amp; &quot;&apos; does not exist!&quot;, 16, GetProductName())
	End If
	ReadDirectories() = sFileArray()
	Exit Function

	FILESYSTEMPROBLEM:
	Msgbox(&quot;Sorry, Filesystem Problem&quot;)
	ReadDirectories() = sFileArray()
	Resume LEAVEPROC
	LEAVEPROC:
End Function


Sub AddFoldertoList(sDirURL as String, iDirIndex)
	iDirCount = iDirCount + 1
	If iDirCount = CurDirMaxCount Then
		CurDirMaxCount = CurDirMaxCount + SBMAXDIRCOUNT
		ReDim Preserve sDirArray(CurDirMaxCount) as String
	End If
	sDirArray(iDirCount-1) = sDirURL
End Sub


Sub AddFileNameToList(sFileArray(), FileName as String, FileContent as String, bGetByTitle as Boolean, CurIndex)
Dim FileCount As Integer
	CurIndex = CurIndex + 1
	sFileArray(CurIndex,0) = FileName
	If bGetByTitle Then
		sFileArray(CurIndex,1) = RetrieveDocTitle(oDocInfo, FileName)
		&apos; Add the documenttitles to the Filearray
	Else
		sFileArray(CurIndex,1) = FileContent
	End If
End Sub


Function RetrieveDocTitle(oDocProps as Object, sFileName as String) As String
Dim sDocTitle as String
	On Local Error Goto NOFILE
	oDocProps.loadFromMedium(sFileName, NoArgs())
	sDocTitle = oDocProps.Title
	NOFILE:
	If Err &lt;&gt; 0 Then
		RetrieveDocTitle = &quot;&quot;
		RESUME CLR_ERROR
	End If
	CLR_ERROR:
	If sDocTitle = &quot;&quot; Then
		sDocTitle = GetFileNameWithoutExtension(sFilename, &quot;/&quot;)
	End If
	RetrieveDocTitle = sDocTitle
End Function


&apos; Retrieves The Filecontent of a Document by extracting the content
&apos; from the Header of the document
Function GetRealFileContent(FileName as String) As String
	On Local Error Goto NOFILE
	oTypeDetect = createUnoService(&quot;com.sun.star.document.TypeDetection&quot;)
	GetRealFileContent = oTypeDetect.queryTypeByURL(FileName)
	NOFILE:
	If Err &lt;&gt; 0 Then
		GetRealFileContent = &quot;&quot;
		resume CLR_ERROR
	End If
	CLR_ERROR:
End Function


Function CopyRecursively(SourceFilePath as String, SourceStemDir as String, TargetStemDir as String)
Dim TargetDir as String
Dim TargetFile as String

	TargetFile= ReplaceString(SourceFilePath, TargetStemDir, SourceStemDir)
	TargetFileName = FileNameoutofPath(TargetFile,&quot;/&quot;)
	TargetDir = DeleteStr(TargetFile, TargetFileName)
	CreateFolder(TargetDir)
	CopyRecursively() = TargetFile
End Function


&apos; Opens a help url referenced by a Help ID that is retrieved from the calling button tag
Sub ShowHelperDialog(aEvent)
Dim oSystemNode as Object
Dim sSystem as String
Dim oLanguageNode as Object
Dim sLocale as String
Dim sLocaleList() as String
Dim sLanguage as String
Dim sHelpUrl as String
Dim sDocType as String
	HelpID = aEvent.Source.Model.Tag
	oLocDocument = StarDesktop.ActiveFrame.Controller.Model
	sDocType = GetDocumentType(oLocDocument)
	oSystemNode = GetRegistryKeyContent(&quot;org.openoffice.Office.Common/Help&quot;)
	sSystem = oSystemNode.GetByName(&quot;System&quot;)
	oLanguageNode = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
	sLocale = oLanguageNode.getByName(&quot;ooLocale&quot;)
	sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
	sLanguage = sLocaleList(0)
	sHelpUrl = &quot;vnd.sun.star.help://&quot; &amp; sDocType &amp; &quot;/&quot; &amp; HelpID &amp; &quot;?Language=&quot; &amp; sLanguage &amp; &quot;&amp;System=&quot; &amp; sSystem
	StarDesktop.LoadComponentfromUrl(sHelpUrl, &quot;OFFICE_HELP&quot;, 63, NoArgs())
End Sub


Sub SaveDataToFile(FilePath as String, DataList())
Dim FileChannel as Integer
Dim i as Integer
Dim oFile as Object
Dim oOutputStream as Object
Dim oStreamString as Object
Dim oUcb as Object
Dim sCRLF as String

	sCRLF = CHR(13) &amp; CHR(10)
	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	oOutputStream = createUnoService(&quot;com.sun.star.io.TextOutputStream&quot;)
	If oUcb.Exists(FilePath) Then
		oUcb.Kill(FilePath)
	End If
	oFile = oUcb.OpenFileReadWrite(FilePath)
	oOutputStream.SetOutputStream(oFile.GetOutputStream)
	For i = 0 To Ubound(DataList())
		oOutputStream.WriteString(DataList(i) &amp; sCRLF)
	Next i
	oOutputStream.CloseOutput()
End Sub


Function LoadDataFromFile(FilePath as String, DataList()) as Boolean
Dim oInputStream as Object
Dim i as Integer
Dim oUcb as Object
Dim oFile as Object
Dim MaxIndex as Integer
	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	If oUcb.Exists(FilePath) Then
		MaxIndex = 10
		oInputStream = createUnoService(&quot;com.sun.star.io.TextInputStream&quot;)
		oFile = oUcb.OpenFileReadWrite(FilePath)
		oInputStream.SetInputStream(oFile.GetInputStream)
		i = -1
		Redim Preserve DataList(MaxIndex)
		While Not oInputStream.IsEOF
			i = i + 1
			If i &gt; MaxIndex Then
				MaxIndex = MaxIndex + 10
				Redim Preserve DataList(MaxIndex)
			End If
			DataList(i) = oInputStream.ReadLine
		Wend
		If i &gt; -1 And i &lt;&gt; MaxIndex Then
			Redim Preserve DataList(i)
		End If
		LoadDataFromFile() = True
		oInputStream.CloseInput()
	Else
		LoadDataFromFile() = False
	End If
End Function


Function CreateFolder(sNewFolder) as Boolean
Dim oUcb as Object
	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
	On Local Error Goto NOSPACEONDRIVE
	If Not oUcb.Exists(sNewFolder) Then
		oUcb.CreateFolder(sNewFolder)
	End If
	CreateFolder = True
NOSPACEONDRIVE:
	If Err &lt;&gt; 0 Then
		If InitResources(&quot;&quot;, &quot;dbw&quot;) Then
			ErrMsg = GetResText(500)
			ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
			ErrMsg = ReplaceString(ErrMsg, sNewFolder, &quot;%1&quot;)
			Msgbox(ErrMsg, 48, GetProductName())
		End If
		CreateFolder = False
		Resume GOON
	End If
GOON:
End Function
</script:module>