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