wizards/source/tools/UCB.xba

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