diff options
| author | Behrend Cornelius <bc@openoffice.org> | 2001-11-12 16:40:44 +0000 |
|---|---|---|
| committer | Behrend Cornelius <bc@openoffice.org> | 2001-11-12 16:40:44 +0000 |
| commit | f27135e6f0e410170875eefa1b08f486da7117f4 (patch) | |
| tree | 1e4ffec0baf00d7e6f5758eee65d5c69d65b6dfa /wizards/source/tools/UCB.xba | |
| parent | 980ef79c70d22761f6c3497df1243bb779ab0fe9 (diff) | |
#94501# CreateFolder Function added
Diffstat (limited to 'wizards/source/tools/UCB.xba')
| -rw-r--r-- | wizards/source/tools/UCB.xba | 120 |
1 files changed, 71 insertions, 49 deletions
diff --git a/wizards/source/tools/UCB.xba b/wizards/source/tools/UCB.xba index 26edd1bf2d3d..94f8a31fc399 100644 --- a/wizards/source/tools/UCB.xba +++ b/wizards/source/tools/UCB.xba @@ -1,6 +1,6 @@ <?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="Recursive" script:language="StarBasic">'Option explicit +<script:module xmlns:script="http://openoffice.org/2000/script" script:name="UCB" script:language="StarBasic">'Option explicit Public oDocument Dim oDocInfo as object Const SBMAXDIRCOUNT = 10 @@ -18,7 +18,6 @@ End Sub ' Prozedur, die die rekursive Auslesefunktion anwirft 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 @@ -41,63 +40,67 @@ Dim sFileArray(StartUbound,1) as String iDirCount = 1 oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties") oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") - Do - AnchorDir = sDirArray(DirIndex) - DirContent() = oUcbObject.GetFolderContents(AnchorDir,True) - DirIndex = DirIndex + 1 - If Ubound(DirContent()) <> -1 Then - FileCountinDir = Ubound(DirContent())+ 1 - For i = 0 to FilecountinDir -1 - Filename = DirContent(i) - If oUcbObject.IsFolder(FileName) Then - If brecursive Then - AddFoldertoList(FileName, DirIndex) - End If - Else - If bcheckFileType Then - RealFileContent = GetRealFileContent(oDocInfo, FileName) + If oUcbObject.Exists(AnchorDir) Then + Do + AnchorDir = sDirArray(DirIndex) + DirContent() = oUcbObject.GetFolderContents(AnchorDir,True) + DirIndex = DirIndex + 1 + If Ubound(DirContent()) <> -1 Then + FileCountinDir = Ubound(DirContent())+ 1 + For i = 0 to FilecountinDir -1 + Filename = DirContent(i) + If oUcbObject.IsFolder(FileName) Then + If brecursive Then + AddFoldertoList(FileName, DirIndex) + End If Else - RealFileContent = GetFileNameExtension(FileName) - End If - If RealFileContent <> "" Then - ' Retrieve the Index in the Array, where a Filename is positioned - If Not IsMissing(sFileContent()) Then - If (FieldinArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then - ' The extension of the current file passes the filter and is therefor admitted to the - ' fileList - If Not IsMissing(sExtension) Then - If sExtension <> "" Then - ' Consider that some Formats like old StarOffice Templates with the extension ".vor" can only be - ' precisely identified by their mimetype and their extension - FileExtension = GetFileNameExtension(FileName) - If FileExtension = sExtension Then - AddFileNameToList(sFileArray(), FileName, RealFileContent, bGetByTitle, CurIndex) + If bcheckFileType Then + RealFileContent = GetRealFileContent(oDocInfo, FileName) + Else + RealFileContent = GetFileNameExtension(FileName) + End If + If RealFileContent <> "" Then + ' Retrieve the Index in the Array, where a Filename is positioned + If Not IsMissing(sFileContent()) Then + If (FieldinArray(sFileContent(), Ubound(sFileContent), RealFileContent)) Then + ' The extension of the current file passes the filter and is therefor admitted to the + ' fileList + If Not IsMissing(sExtension) Then + If sExtension <> "" Then + ' Consider that some Formats like old StarOffice Templates with the extension ".vor" can only be + ' 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) + 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 + If CurIndex = MaxIndex Then + MaxIndex = MaxIndex + StartUbound + ReDim Preserve sFileArray(MaxIndex,1) as String 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 + Next i + End If + Loop Until DirIndex >= iDirCount + If CurIndex > -1 Then + ReDim Preserve sFileArray(CurIndex,1) as String + Else + ReDim sFileArray() as String End If - Loop Until DirIndex >= iDirCount - If CurIndex > -1 Then - ReDim Preserve sFileArray(CurIndex,1) as String - Else - ReDim sFileArray() as String + Else + Msgbox("Directory '" & ConvertFromUrl(AnchorDir) & "' does not exist!", 16, GetProductName()) End If - ReadDirectories = sFileArray() + ReadDirectories() = sFileArray() End Function @@ -252,4 +255,23 @@ Dim MaxIndex as Integer LoadDataFromFile() = False End If End Function + + +Function CreateFolder(sNewFolder) as Boolean +Dim oUcb as Object + oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") + On Local Error Goto NOSPACEONDRIVE + If Not oUcb.Exists(sNewFolder) Then + oUcb.CreateFolder(sNewFolder) + End If + CreateFolder = True +NOSPACEONDRIVE: + If Err <> 0 Then + Msgbox "Folder '" & ConvertFromUrl(sNewFolder) & "' could not be created! Probably your harddisk is out of space!" + CreateFolder() = False + Resume LETSGO + LETSGO: + End If +End Function + </script:module>
\ No newline at end of file |