mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-03-18 07:03:51 +08:00
优化项目结构、优化 maven 结构
This commit is contained in:
chenkailing
314
office-plugin/windows-office/share/basic/Tools/UCB.xba
Normal file
314
office-plugin/windows-office/share/basic/Tools/UCB.xba
Normal file
@@ -0,0 +1,314 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
||||
<!--***********************************************************
|
||||
*
|
||||
* 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
|
||||
*
|
||||
* Unless required by applicable law or agreed to in writing,
|
||||
* software distributed under the License is distributed on an
|
||||
* "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
|
||||
* KIND, either express or implied. See the License for the
|
||||
* specific language governing permissions and limitations
|
||||
* under the License.
|
||||
*
|
||||
***********************************************************-->
|
||||
<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>
|
||||
Reference in New Issue
Block a user