diff options
Diffstat (limited to 'wizards/source/tools/UCB.xba')
| -rw-r--r-- | wizards/source/tools/UCB.xba | 294 |
1 files changed, 0 insertions, 294 deletions
diff --git a/wizards/source/tools/UCB.xba b/wizards/source/tools/UCB.xba deleted file mode 100644 index 524afe60c..000000000 --- a/wizards/source/tools/UCB.xba +++ /dev/null @@ -1,294 +0,0 @@ -<?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="UCB" script:language="StarBasic">'Option explicit -Public oDocument -Public oDocInfo as object -Const SBMAXDIRCOUNT = 10 -Dim CurDirMaxCount as Integer -Dim sDirArray(SBMAXDIRCOUNT-1) as String -Dim DirIndex As Integer -Dim iDirCount as Integer -Public bInterruptSearch as Boolean -Public NoArgs()as New com.sun.star.beans.PropertyValue - -Sub Main() -Dim LocsfileContent(0) as String - LocsfileContent(0) = "*" - ReadDirectories("file:///space", LocsfileContent(), True, False, false) -End Sub - -' ReadDirectories( sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension) - -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 -Dim RealFileContent as String -Dim FileName as string -Dim oUcbObject as Object -Dim DirContent() -Dim CurIndex as Integer -Dim MaxIndex as Integer -Dim StartUbound as Integer -Dim FileExtension as String - StartUbound = 5 - MaxIndex = StartUBound - CurDirMaxCount = SBMAXDIRCOUNT -Dim sFileArray(StartUbound,1) as String - On Local Error Goto FILESYSTEMPROBLEM: - CurIndex = -1 - ' Todo: Is the last separator valid? - DirIndex = 0 - sDirArray(iDirIndex) = AnchorDir - iDirCount = 1 - oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties") - oUcbObject = createUnoService("com.sun.star.ucb.SimpleFileAccess") - If oUcbObject.Exists(AnchorDir) Then - Do - AnchorDir = sDirArray(DirIndex) - On Local Error Resume Next - DirContent() = oUcbObject.GetFolderContents(AnchorDir,True) - DirIndex = DirIndex + 1 - On Local Error Goto 0 - On Local Error Goto FILESYSTEMPROBLEM: - If Ubound(DirContent()) <> -1 Then - FileCountinDir = Ubound(DirContent())+ 1 - For i = 0 to FilecountinDir -1 - If bInterruptSearch = True Then - Exit Do - End If - - Filename = DirContent(i) - If oUcbObject.IsFolder(FileName) Then - If brecursive Then - AddFoldertoList(FileName, DirIndex) - End If - Else - If bcheckFileType Then - RealFileContent = GetRealFileContent(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) - End If - 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 - End If - Loop Until DirIndex >= iDirCount - If CurIndex > -1 Then - ReDim Preserve sFileArray(CurIndex,1) as String - Else - ReDim sFileArray() as String - End If - Else - Msgbox("Directory '" & ConvertFromUrl(AnchorDir) & "' does not exist!", 16, GetProductName()) - End If - ReadDirectories() = sFileArray() - Exit Function - - FILESYSTEMPROBLEM: - Msgbox("Sorry, Filesystem Problem") - ReadDirectories() = sFileArray() - Resume LEAVEPROC - LEAVEPROC: -End Function - - -Sub AddFoldertoList(sDirURL as String, iDirIndex) - iDirCount = iDirCount + 1 - If iDirCount = CurDirMaxCount Then - CurDirMaxCount = CurDirMaxCount + SBMAXDIRCOUNT - ReDim Preserve sDirArray(CurDirMaxCount) as String - End If - sDirArray(iDirCount-1) = sDirURL -End Sub - - -Sub AddFileNameToList(sFileArray(), FileName as String, FileContent as String, bGetByTitle as Boolean, CurIndex) -Dim FileCount As Integer - CurIndex = CurIndex + 1 - sFileArray(CurIndex,0) = FileName - If bGetByTitle Then - sFileArray(CurIndex,1) = RetrieveDocTitle(oDocInfo, FileName) - ' Add the documenttitles to the Filearray - Else - sFileArray(CurIndex,1) = FileContent - End If -End Sub - - -Function RetrieveDocTitle(oDocProps as Object, sFileName as String) As String -Dim sDocTitle as String - On Local Error Goto NOFILE - oDocProps.loadFromMedium(sFileName, NoArgs()) - sDocTitle = oDocProps.Title - NOFILE: - If Err <> 0 Then - RetrieveDocTitle = "" - RESUME CLR_ERROR - End If - CLR_ERROR: - If sDocTitle = "" Then - sDocTitle = GetFileNameWithoutExtension(sFilename, "/") - End If - RetrieveDocTitle = sDocTitle -End Function - - -' Retrieves The Filecontent of a Document by extracting the content -' from the Header of the document -Function GetRealFileContent(FileName as String) As String - On Local Error Goto NOFILE - oTypeDetect = createUnoService("com.sun.star.document.TypeDetection") - GetRealFileContent = oTypeDetect.queryTypeByURL(FileName) - NOFILE: - If Err <> 0 Then - GetRealFileContent = "" - resume CLR_ERROR - End If - CLR_ERROR: -End Function - - -Function CopyRecursively(SourceFilePath as String, SourceStemDir as String, TargetStemDir as String) -Dim TargetDir as String -Dim TargetFile as String - - TargetFile= ReplaceString(SourceFilePath, TargetStemDir, SourceStemDir) - TargetFileName = FileNameoutofPath(TargetFile,"/") - TargetDir = DeleteStr(TargetFile, TargetFileName) - CreateFolder(TargetDir) - CopyRecursively() = TargetFile -End Function - - -' Opens a help url referenced by a Help ID that is retrieved from the calling button tag -Sub ShowHelperDialog(aEvent) -Dim oSystemNode as Object -Dim sSystem as String -Dim oLanguageNode as Object -Dim sLocale as String -Dim sLocaleList() as String -Dim sLanguage as String -Dim sHelpUrl as String -Dim sDocType as String - HelpID = aEvent.Source.Model.Tag - oLocDocument = StarDesktop.ActiveFrame.Controller.Model - sDocType = GetDocumentType(oLocDocument) - oSystemNode = GetRegistryKeyContent("org.openoffice.Office.Common/Help") - sSystem = oSystemNode.GetByName("System") - oLanguageNode = GetRegistryKeyContent("org.openoffice.Setup/L10N/") - sLocale = oLanguageNode.getByName("ooLocale") - sLocaleList() = ArrayoutofString(sLocale, "-") - sLanguage = sLocaleList(0) - sHelpUrl = "vnd.sun.star.help://" & sDocType & "/" & HelpID & "?Language=" & sLanguage & "&System=" & sSystem - StarDesktop.LoadComponentfromUrl(sHelpUrl, "OFFICE_HELP", 63, NoArgs()) -End Sub - - -Sub SaveDataToFile(FilePath as String, DataList()) -Dim FileChannel as Integer -Dim i as Integer -Dim oFile as Object -Dim oOutputStream as Object -Dim oStreamString as Object -Dim oUcb as Object -Dim sCRLF as String - - sCRLF = CHR(13) & CHR(10) - oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") - oOutputStream = createUnoService("com.sun.star.io.TextOutputStream") - If oUcb.Exists(FilePath) Then - oUcb.Kill(FilePath) - End If - oFile = oUcb.OpenFileReadWrite(FilePath) - oOutputStream.SetOutputStream(oFile.GetOutputStream) - For i = 0 To Ubound(DataList()) - oOutputStream.WriteString(DataList(i) & sCRLF) - Next i - oOutputStream.CloseOutput() -End Sub - - -Function LoadDataFromFile(FilePath as String, DataList()) as Boolean -Dim oInputStream as Object -Dim i as Integer -Dim oUcb as Object -Dim oFile as Object -Dim MaxIndex as Integer - oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess") - If oUcb.Exists(FilePath) Then - MaxIndex = 10 - oInputStream = createUnoService("com.sun.star.io.TextInputStream") - oFile = oUcb.OpenFileReadWrite(FilePath) - oInputStream.SetInputStream(oFile.GetInputStream) - i = -1 - Redim Preserve DataList(MaxIndex) - While Not oInputStream.IsEOF - i = i + 1 - If i > MaxIndex Then - MaxIndex = MaxIndex + 10 - Redim Preserve DataList(MaxIndex) - End If - DataList(i) = oInputStream.ReadLine - Wend - If i > -1 And i <> MaxIndex Then - Redim Preserve DataList(i) - End If - LoadDataFromFile() = True - oInputStream.CloseInput() - Else - 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 - If InitResources("", "dbw") Then - ErrMsg = GetResText(500) - ErrMsg = ReplaceString(ErrMsg, chr(13), "<BR>") - ErrMsg = ReplaceString(ErrMsg, sNewFolder, "%1") - Msgbox(ErrMsg, 48, GetProductName()) - End If - CreateFolder = False - Resume GOON - End If -GOON: -End Function -</script:module> |