312 lines
10 KiB
Java
312 lines
10 KiB
Java
<?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>
|