diff options
Diffstat (limited to '')
| -rw-r--r-- | wizards/source/tools/UCB.xba | 311 |
1 files changed, 311 insertions, 0 deletions
diff --git a/wizards/source/tools/UCB.xba b/wizards/source/tools/UCB.xba new file mode 100644 index 000000000..d849a2ea3 --- /dev/null +++ b/wizards/source/tools/UCB.xba @@ -0,0 +1,311 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> +<!-- + * This file is part of the LibreOffice project. + * + * This Source Code Form is subject to the terms of the Mozilla Public + * License, v. 2.0. If a copy of the MPL was not distributed with this + * file, You can obtain one at http://mozilla.org/MPL/2.0/. + * + * This file incorporates work covered by the following license notice: + * + * Licensed to the Apache Software Foundation (ASF) under one or more + * contributor license agreements. See the NOTICE file distributed + * with this work for additional information regarding copyright + * ownership. The ASF licenses this file to you under the Apache + * License, Version 2.0 (the "License"); you may not use this file + * except in compliance with the License. You may obtain a copy of + * the License at http://www.apache.org/licenses/LICENSE-2.0 . +--> +<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 therefore 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("") Then + ErrMsg = GetResText("RID_COMMON_0") + 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> |