xref: /aoo42x/main/wizards/source/tools/UCB.xba (revision 3e02b54d)
1<?xml version="1.0" encoding="UTF-8"?>
2<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
3<!--***********************************************************
4 *
5 * Licensed to the Apache Software Foundation (ASF) under one
6 * or more contributor license agreements.  See the NOTICE file
7 * distributed with this work for additional information
8 * regarding copyright ownership.  The ASF licenses this file
9 * to you under the Apache License, Version 2.0 (the
10 * "License"); you may not use this file except in compliance
11 * with the License.  You may obtain a copy of the License at
12 *
13 *   http://www.apache.org/licenses/LICENSE-2.0
14 *
15 * Unless required by applicable law or agreed to in writing,
16 * software distributed under the License is distributed on an
17 * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
18 * KIND, either express or implied.  See the License for the
19 * specific language governing permissions and limitations
20 * under the License.
21 *
22 ***********************************************************-->
23<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UCB" script:language="StarBasic">&apos;Option explicit
24Public oDocument
25Public oDocInfo as object
26Const SBMAXDIRCOUNT = 10
27Dim CurDirMaxCount as Integer
28Dim sDirArray(SBMAXDIRCOUNT-1) as String
29Dim DirIndex As Integer
30Dim iDirCount as Integer
31Public bInterruptSearch as Boolean
32Public NoArgs()as New com.sun.star.beans.PropertyValue
33
34Sub Main()
35Dim LocsfileContent(0) as String
36	LocsfileContent(0) = &quot;*&quot;
37	ReadDirectories(&quot;file:///space&quot;, LocsfileContent(), True, False, false)
38End Sub
39
40&apos;        ReadDirectories(      sSourceDir,          bRecursive,          bCheckRealType, False, sFileContent(), sLocExtension)
41
42Function ReadDirectories(ByVal AnchorDir As String, bRecursive as Boolean,  bcheckFileType as Boolean, bGetByTitle as Boolean, Optional sFileContent(), Optional sExtension as String)
43Dim i as integer
44Dim Status as Object
45Dim FileCountinDir as Integer
46Dim RealFileContent as String
47Dim FileName as string
48Dim oUcbObject as Object
49Dim DirContent()
50Dim CurIndex as Integer
51Dim MaxIndex as Integer
52Dim StartUbound as Integer
53Dim FileExtension as String
54	StartUbound = 5
55	MaxIndex = StartUBound
56	CurDirMaxCount = SBMAXDIRCOUNT
57Dim sFileArray(StartUbound,1) as String
58	On Local Error Goto FILESYSTEMPROBLEM:
59	CurIndex = -1
60	&apos; Todo: Is the last separator valid?
61	DirIndex = 0
62	sDirArray(iDirIndex) = AnchorDir
63	iDirCount = 1
64	oDocInfo = CreateUnoService(&quot;com.sun.star.document.DocumentProperties&quot;)
65	oUcbObject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
66	If oUcbObject.Exists(AnchorDir) Then
67		Do
68			AnchorDir = sDirArray(DirIndex)
69			On Local Error Resume Next
70			DirContent() = oUcbObject.GetFolderContents(AnchorDir,True)
71			DirIndex = DirIndex + 1
72			On Local Error Goto 0
73			On Local Error Goto FILESYSTEMPROBLEM:
74			If Ubound(DirContent()) &lt;&gt; -1 Then
75				FileCountinDir = Ubound(DirContent())+ 1
76				For i = 0 to FilecountinDir -1
77					If bInterruptSearch = True Then
78						Exit Do
79					End If
80
81					Filename = DirContent(i)
82					If oUcbObject.IsFolder(FileName) Then
83						If brecursive Then
84							AddFoldertoList(FileName, DirIndex)
85						End If
86					Else
87						If bcheckFileType Then
88							RealFileContent = GetRealFileContent(FileName)
89						Else
90							RealFileContent = GetFileNameExtension(FileName)
91						End If
92						If RealFileContent &lt;&gt; &quot;&quot; Then
93							&apos; Retrieve the Index in the Array, where a Filename is positioned
94							If Not IsMissing(sFileContent()) Then
95								If (FieldinArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then
96									&apos; The extension of the current file passes the filter and is therefor admitted to the
97									&apos; fileList
98									If Not IsMissing(sExtension) Then
99										If sExtension &lt;&gt; &quot;&quot; Then
100											&apos; Consider that some Formats like old StarOffice Templates with the extension &quot;.vor&quot; can only be
101											&apos; precisely identified by their mimetype and their extension
102											FileExtension = GetFileNameExtension(FileName)
103											If FileExtension = sExtension Then
104												AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
105											End If
106										Else
107											AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
108										End If
109									Else
110										AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
111									End If
112								End If
113							Else
114								AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex)
115							End If
116							If CurIndex = MaxIndex Then
117								MaxIndex = MaxIndex + StartUbound
118								ReDim Preserve sFileArray(MaxIndex,1) as String
119							End If
120						End If
121					End If
122				Next i
123			End If
124		Loop Until DirIndex &gt;= iDirCount
125		If CurIndex &gt; -1 Then
126			ReDim Preserve sFileArray(CurIndex,1) as String
127		Else
128			ReDim sFileArray() as String
129		End If
130	Else
131		Msgbox(&quot;Directory &apos;&quot; &amp; ConvertFromUrl(AnchorDir) &amp; &quot;&apos; does not exist!&quot;, 16, GetProductName())
132	End If
133	ReadDirectories() = sFileArray()
134	Exit Function
135
136	FILESYSTEMPROBLEM:
137	Msgbox(&quot;Sorry, Filesystem Problem&quot;)
138	ReadDirectories() = sFileArray()
139	Resume LEAVEPROC
140	LEAVEPROC:
141End Function
142
143
144Sub AddFoldertoList(sDirURL as String, iDirIndex)
145	iDirCount = iDirCount + 1
146	If iDirCount = CurDirMaxCount Then
147		CurDirMaxCount = CurDirMaxCount + SBMAXDIRCOUNT
148		ReDim Preserve sDirArray(CurDirMaxCount) as String
149	End If
150	sDirArray(iDirCount-1) = sDirURL
151End Sub
152
153
154Sub AddFileNameToList(sFileArray(), FileName as String, FileContent as String, bGetByTitle as Boolean, CurIndex)
155Dim FileCount As Integer
156	CurIndex = CurIndex + 1
157	sFileArray(CurIndex,0) = FileName
158	If bGetByTitle Then
159		sFileArray(CurIndex,1) = RetrieveDocTitle(oDocInfo, FileName)
160		&apos; Add the documenttitles to the Filearray
161	Else
162		sFileArray(CurIndex,1) = FileContent
163	End If
164End Sub
165
166
167Function RetrieveDocTitle(oDocProps as Object, sFileName as String) As String
168Dim sDocTitle as String
169	On Local Error Goto NOFILE
170	oDocProps.loadFromMedium(sFileName, NoArgs())
171	sDocTitle = oDocProps.Title
172	NOFILE:
173	If Err &lt;&gt; 0 Then
174		RetrieveDocTitle = &quot;&quot;
175		RESUME CLR_ERROR
176	End If
177	CLR_ERROR:
178	If sDocTitle = &quot;&quot; Then
179		sDocTitle = GetFileNameWithoutExtension(sFilename, &quot;/&quot;)
180	End If
181	RetrieveDocTitle = sDocTitle
182End Function
183
184
185&apos; Retrieves The Filecontent of a Document by extracting the content
186&apos; from the Header of the document
187Function GetRealFileContent(FileName as String) As String
188	On Local Error Goto NOFILE
189	oTypeDetect = createUnoService(&quot;com.sun.star.document.TypeDetection&quot;)
190	GetRealFileContent = oTypeDetect.queryTypeByURL(FileName)
191	NOFILE:
192	If Err &lt;&gt; 0 Then
193		GetRealFileContent = &quot;&quot;
194		resume CLR_ERROR
195	End If
196	CLR_ERROR:
197End Function
198
199
200Function CopyRecursively(SourceFilePath as String, SourceStemDir as String, TargetStemDir as String)
201Dim TargetDir as String
202Dim TargetFile as String
203
204	TargetFile= ReplaceString(SourceFilePath, TargetStemDir, SourceStemDir)
205	TargetFileName = FileNameoutofPath(TargetFile,&quot;/&quot;)
206	TargetDir = DeleteStr(TargetFile, TargetFileName)
207	CreateFolder(TargetDir)
208	CopyRecursively() = TargetFile
209End Function
210
211
212&apos; Opens a help url referenced by a Help ID that is retrieved from the calling button tag
213Sub ShowHelperDialog(aEvent)
214Dim oSystemNode as Object
215Dim sSystem as String
216Dim oLanguageNode as Object
217Dim sLocale as String
218Dim sLocaleList() as String
219Dim sLanguage as String
220Dim sHelpUrl as String
221Dim sDocType as String
222	HelpID = aEvent.Source.Model.Tag
223	oLocDocument = StarDesktop.ActiveFrame.Controller.Model
224	sDocType = GetDocumentType(oLocDocument)
225	oSystemNode = GetRegistryKeyContent(&quot;org.openoffice.Office.Common/Help&quot;)
226	sSystem = oSystemNode.GetByName(&quot;System&quot;)
227	oLanguageNode = GetRegistryKeyContent(&quot;org.openoffice.Setup/L10N/&quot;)
228	sLocale = oLanguageNode.getByName(&quot;ooLocale&quot;)
229	sLocaleList() = ArrayoutofString(sLocale, &quot;-&quot;)
230	sLanguage = sLocaleList(0)
231	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
232	StarDesktop.LoadComponentfromUrl(sHelpUrl, &quot;OFFICE_HELP&quot;, 63, NoArgs())
233End Sub
234
235
236Sub SaveDataToFile(FilePath as String, DataList())
237Dim FileChannel as Integer
238Dim i as Integer
239Dim oFile as Object
240Dim oOutputStream as Object
241Dim oStreamString as Object
242Dim oUcb as Object
243Dim sCRLF as String
244
245	sCRLF = CHR(13) &amp; CHR(10)
246	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
247	oOutputStream = createUnoService(&quot;com.sun.star.io.TextOutputStream&quot;)
248	If oUcb.Exists(FilePath) Then
249		oUcb.Kill(FilePath)
250	End If
251	oFile = oUcb.OpenFileReadWrite(FilePath)
252	oOutputStream.SetOutputStream(oFile.GetOutputStream)
253	For i = 0 To Ubound(DataList())
254		oOutputStream.WriteString(DataList(i) &amp; sCRLF)
255	Next i
256	oOutputStream.CloseOutput()
257End Sub
258
259
260Function LoadDataFromFile(FilePath as String, DataList()) as Boolean
261Dim oInputStream as Object
262Dim i as Integer
263Dim oUcb as Object
264Dim oFile as Object
265Dim MaxIndex as Integer
266	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
267	If oUcb.Exists(FilePath) Then
268		MaxIndex = 10
269		oInputStream = createUnoService(&quot;com.sun.star.io.TextInputStream&quot;)
270		oFile = oUcb.OpenFileReadWrite(FilePath)
271		oInputStream.SetInputStream(oFile.GetInputStream)
272		i = -1
273		Redim Preserve DataList(MaxIndex)
274		While Not oInputStream.IsEOF
275			i = i + 1
276			If i &gt; MaxIndex Then
277				MaxIndex = MaxIndex + 10
278				Redim Preserve DataList(MaxIndex)
279			End If
280			DataList(i) = oInputStream.ReadLine
281		Wend
282		If i &gt; -1 And i &lt;&gt; MaxIndex Then
283			Redim Preserve DataList(i)
284		End If
285		LoadDataFromFile() = True
286		oInputStream.CloseInput()
287	Else
288		LoadDataFromFile() = False
289	End If
290End Function
291
292
293Function CreateFolder(sNewFolder) as Boolean
294Dim oUcb as Object
295	oUcb = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
296	On Local Error Goto NOSPACEONDRIVE
297	If Not oUcb.Exists(sNewFolder) Then
298		oUcb.CreateFolder(sNewFolder)
299	End If
300	CreateFolder = True
301NOSPACEONDRIVE:
302	If Err &lt;&gt; 0 Then
303		If InitResources(&quot;&quot;, &quot;dbw&quot;) Then
304			ErrMsg = GetResText(500)
305			ErrMsg = ReplaceString(ErrMsg, chr(13), &quot;&lt;BR&gt;&quot;)
306			ErrMsg = ReplaceString(ErrMsg, sNewFolder, &quot;%1&quot;)
307			Msgbox(ErrMsg, 48, GetProductName())
308		End If
309		CreateFolder = False
310		Resume GOON
311	End If
312GOON:
313End Function
314</script:module>
315