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