mirror of
https://gitee.com/kekingcn/file-online-preview.git
synced 2026-05-07 07:24:03 +00:00
优化项目结构、优化 maven 结构
This commit is contained in:
chenkailing
256
office-plugin/windows-office/share/basic/Tools/Debug.xba
Normal file
256
office-plugin/windows-office/share/basic/Tools/Debug.xba
Normal file
@@ -0,0 +1,256 @@
|
||||
<?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="Debug" script:language="StarBasic">REM ***** BASIC *****
|
||||
|
||||
Sub ActivateReadOnlyFlag()
|
||||
SetBasicReadOnlyFlag(True)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub DeactivateReadOnlyFlag()
|
||||
SetBasicReadOnlyFlag(False)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetBasicReadOnlyFlag(bReadOnly as Boolean)
|
||||
Dim i as Integer
|
||||
Dim LibName as String
|
||||
Dim BasicLibNames() as String
|
||||
BasicLibNames() = BasicLibraries.ElementNames()
|
||||
For i = 0 To Ubound(BasicLibNames())
|
||||
LibName = BasicLibNames(i)
|
||||
If LibName <> "Standard" Then
|
||||
BasicLibraries.SetLibraryReadOnly(LibName, bReadOnly)
|
||||
End If
|
||||
Next i
|
||||
End Sub
|
||||
|
||||
|
||||
Sub WritedbgInfo(LocObject as Object)
|
||||
Dim locUrl as String
|
||||
Dim oLocDocument as Object
|
||||
Dim oLocText as Object
|
||||
Dim oLocCursor as Object
|
||||
Dim NoArgs()
|
||||
Dim sObjectStrings(2) as String
|
||||
Dim sProperties() as String
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
sObjectStrings(0) = LocObject.dbg_Properties
|
||||
sObjectStrings(1) = LocObject.dbg_Methods
|
||||
sObjectStrings(2) = LocObject.dbg_SupportedInterfaces
|
||||
LocUrl = "private:factory/swriter"
|
||||
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
|
||||
oLocText = oLocDocument.text
|
||||
oLocCursor = oLocText.createTextCursor()
|
||||
oLocCursor.gotoStart(False)
|
||||
If Vartype(LocObject) = 9 then ' an Object Variable
|
||||
For n = 0 To 2
|
||||
sProperties() = ArrayoutofString(sObjectStrings(n),";", MaxIndex)
|
||||
For m = 0 To MaxIndex
|
||||
oLocText.insertString(oLocCursor,sProperties(m),False)
|
||||
oLocText.insertControlCharacter(oLocCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
|
||||
Next m
|
||||
Next n
|
||||
Elseif Vartype(LocObject) = 8 Then ' a String Variable
|
||||
oLocText.insertString(oLocCursor,LocObject,False)
|
||||
ElseIf Vartype(LocObject) = 1 Then
|
||||
Msgbox("Variable is Null!", 16, GetProductName())
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub WriteDbgString(LocString as string)
|
||||
Dim oLocDesktop as object
|
||||
Dim LocUrl as String
|
||||
Dim oLocDocument as Object
|
||||
Dim oLocCursor as Object
|
||||
Dim oLocText as Object
|
||||
|
||||
LocUrl = "private:factory/swriter"
|
||||
oLocDocument = StarDesktop.LoadComponentFromURL(LocUrl,"_default",0,NoArgs)
|
||||
oLocText = oLocDocument.text
|
||||
oLocCursor = oLocText.createTextCursor()
|
||||
oLocCursor.gotoStart(False)
|
||||
oLocText.insertString(oLocCursor,LocString,False)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub printdbgInfo(LocObject)
|
||||
If Vartype(LocObject) = 9 then
|
||||
Msgbox LocObject.dbg_properties
|
||||
Msgbox LocObject.dbg_methods
|
||||
Msgbox LocObject.dbg_supportedinterfaces
|
||||
Elseif Vartype(LocObject) = 8 Then ' a String Variable
|
||||
Msgbox LocObject
|
||||
ElseIf Vartype(LocObject) = 0 Then
|
||||
Msgbox("Variable is Null!", 16, GetProductName())
|
||||
Else
|
||||
Msgbox("Type of Variable: " & Typename(LocObject), 48, GetProductName())
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ShowArray(LocArray())
|
||||
Dim i as integer
|
||||
Dim msgstring
|
||||
msgstring = ""
|
||||
For i = Lbound(LocArray()) to Ubound(LocArray())
|
||||
msgstring = msgstring + LocArray(i) + chr(13)
|
||||
Next
|
||||
Msgbox msgstring
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ShowPropertyValues(oLocObject as Object)
|
||||
Dim PropName as String
|
||||
Dim sValues as String
|
||||
On Local Error Goto NOPROPERTYSETINFO:
|
||||
sValues = ""
|
||||
For i = 0 To Ubound(oLocObject.PropertySetInfo.Properties)
|
||||
Propname = oLocObject.PropertySetInfo.Properties(i).Name
|
||||
sValues = sValues & PropName & chr(13) & " = " & oLocObject.GetPropertyValue(PropName) & chr(13)
|
||||
Next i
|
||||
Msgbox(sValues , 64, GetProductName())
|
||||
Exit Sub
|
||||
|
||||
NOPROPERTYSETINFO:
|
||||
Msgbox("Sorry, No PropertySetInfo attached to the object", 16, GetProductName())
|
||||
Resume LEAVEPROC
|
||||
LEAVEPROC:
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ShowNameValuePair(Pair())
|
||||
Dim i as Integer
|
||||
Dim ShowString as String
|
||||
ShowString = ""
|
||||
On Local Error Resume Next
|
||||
For i = 0 To Ubound(Pair())
|
||||
ShowString = ShowString & Pair(i).Name & " = "
|
||||
ShowString = ShowString & Pair(i).Value & chr(13)
|
||||
Next i
|
||||
Msgbox ShowString
|
||||
End Sub
|
||||
|
||||
|
||||
' Retrieves all the Elements of aSequence of an object, with the
|
||||
' possibility to define a filter(sfilter <> "")
|
||||
Sub ShowElementNames(oLocElements() as Object, Optional sFiltername as String)
|
||||
Dim i as Integer
|
||||
Dim NameString as String
|
||||
NameString = ""
|
||||
For i = 0 To Ubound(oLocElements())
|
||||
If Not IsMissIng(sFilterName) Then
|
||||
If Instr(1, oLocElements(i), sFilterName) Then
|
||||
NameString = NameString & oLocElements(i) & chr(13)
|
||||
End If
|
||||
Else
|
||||
NameString = NameString & oLocElements(i) & chr(13)
|
||||
End If
|
||||
Next i
|
||||
Msgbox(NameString, 64, GetProductName())
|
||||
End Sub
|
||||
|
||||
|
||||
' Retrieves all the supported servicenames of an object, with the
|
||||
' possibility to define a filter(sfilter <> "")
|
||||
Sub ShowSupportedServiceNames(oLocObject as Object, Optional sFilterName as String)
|
||||
On Local Error Goto NOSERVICENAMES
|
||||
If IsMissing(sFilterName) Then
|
||||
ShowElementNames(oLocobject.SupportedServiceNames())
|
||||
Else
|
||||
ShowElementNames(oLocobject.SupportedServiceNames(), sFilterName)
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
NOSERVICENAMES:
|
||||
Msgbox("Sorry, No 'SupportedServiceNames' - Property attached to the object", 16, GetProductName())
|
||||
Resume LEAVEPROC
|
||||
LEAVEPROC:
|
||||
End Sub
|
||||
|
||||
|
||||
' Retrieves all the available Servicenames of an object, with the
|
||||
' possibility to define a filter(sfilter <> "")
|
||||
Sub ShowAvailableServiceNames(oLocObject as Object, Optional sFilterName as String)
|
||||
On Local Error Goto NOSERVICENAMES
|
||||
If IsMissing(sFilterName) Then
|
||||
ShowElementNames(oLocobject.AvailableServiceNames)
|
||||
Else
|
||||
ShowElementNames(oLocobject.AvailableServiceNames, sFilterName)
|
||||
End If
|
||||
Exit Sub
|
||||
|
||||
NOSERVICENAMES:
|
||||
Msgbox("Sorry, No 'AvailableServiceNames' - Property attached to the object", 16, GetProductName())
|
||||
Resume LEAVEPROC
|
||||
LEAVEPROC:
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ShowCommands(oLocObject as Object)
|
||||
On Local Error Goto NOCOMMANDS
|
||||
ShowElementNames(oLocObject.QueryCommands)
|
||||
Exit Sub
|
||||
NOCOMMANDS:
|
||||
Msgbox("Sorry, No 'QueryCommands' - Property attached to the object", 16, GetProductName())
|
||||
Resume LEAVEPROC
|
||||
LEAVEPROC:
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ProtectCurrentSheets()
|
||||
Dim oDocument as Object
|
||||
Dim sDocType as String
|
||||
Dim iResult as Integer
|
||||
Dim oSheets as Object
|
||||
Dim i as Integer
|
||||
Dim bDoProtect as Boolean
|
||||
oDocument = StarDesktop.ActiveFrame.Controller.Model
|
||||
sDocType = GetDocumentType(oDocument)
|
||||
If sDocType = "scalc" Then
|
||||
oSheets = oDocument.Sheets
|
||||
bDoProtect = False
|
||||
For i = 0 To oSheets.Count-1
|
||||
If Not oSheets(i).IsProtected Then
|
||||
bDoProtect = True
|
||||
End If
|
||||
Next i
|
||||
If bDoProtect Then
|
||||
iResult = Msgbox( "Do you want to protect all sheets of this document?",35, GetProductName())
|
||||
If iResult = 6 Then
|
||||
ProtectSheets(oDocument.Sheets)
|
||||
End If
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FillDocument()
|
||||
oMyReport = createUNOService("com.sun.star.wizards.report.CallReportWizard")
|
||||
oMyReport.trigger("fill")
|
||||
End Sub
|
||||
|
||||
</script:module>
|
||||
@@ -0,0 +1,37 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.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.
|
||||
*
|
||||
***********************************************************-->
|
||||
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="DlgOverwriteAll" dlg:left="138" dlg:top="75" dlg:width="230" dlg:height="64" dlg:closeable="true" dlg:moveable="true">
|
||||
<dlg:bulletinboard>
|
||||
<dlg:text dlg:id="lblQueryforSave" dlg:tab-index="0" dlg:left="6" dlg:top="6" dlg:width="218" dlg:height="36" dlg:value="lblQueryforSave" dlg:multiline="true"/>
|
||||
<dlg:button dlg:id="cmdYes" dlg:tab-index="1" dlg:left="6" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdYes">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToQuery?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdYesToAll" dlg:tab-index="2" dlg:left="62" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdYesToAll">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToAlways?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdNo" dlg:tab-index="3" dlg:left="118" dlg:top="43" dlg:width="50" dlg:height="14" dlg:default="true" dlg:value="cmdNo">
|
||||
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Tools.ModuleControls.SetOVERWRITEToNever?language=Basic&location=application" script:language="Script"/>
|
||||
</dlg:button>
|
||||
<dlg:button dlg:id="cmdCancel" dlg:tab-index="4" dlg:left="174" dlg:top="43" dlg:width="50" dlg:height="14" dlg:value="cmdCancel" dlg:button-type="cancel"/>
|
||||
</dlg:bulletinboard>
|
||||
</dlg:window>
|
||||
373
office-plugin/windows-office/share/basic/Tools/Listbox.xba
Normal file
373
office-plugin/windows-office/share/basic/Tools/Listbox.xba
Normal file
@@ -0,0 +1,373 @@
|
||||
<?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="Listbox" script:language="StarBasic">Option Explicit
|
||||
Dim OriginalList()
|
||||
Dim oDialogModel as Object
|
||||
|
||||
|
||||
Sub MergeList(SourceListBox() as Object, SecondList() as String)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(SecondList())
|
||||
OriginalList() = AddListToList(OriginalList(), SecondList())
|
||||
For i = 0 To MaxIndex
|
||||
SourceListbox = AddSingleItemToListbox(SourceListbox, SecondList(i))
|
||||
Next i
|
||||
Call FormSetMoveRights()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub RemoveListItems(SourceListbox as Object, TargetListbox as Object, RemoveList() as String)
|
||||
Dim i as Integer
|
||||
Dim s as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim CopyList()
|
||||
MaxIndex = Ubound(RemoveList())
|
||||
For i = 0 To MaxIndex
|
||||
RemoveListboxItemByName(SourceListbox, RemoveList(i))
|
||||
RemoveListboxItemByName(TargetListbox, RemoveList(i))
|
||||
Next i
|
||||
CopyList() = OriginalList()
|
||||
s = 0
|
||||
MaxIndex = Ubound(CopyList())
|
||||
For i = 0 To MaxIndex
|
||||
If IndexInArray(CopyList(i),RemoveList())= -1 Then
|
||||
OriginalList(s) = CopyList(i)
|
||||
s = s + 1
|
||||
End If
|
||||
Next i
|
||||
ReDim Preserve OriginalList(s-1)
|
||||
Call FormSetMoveRights()
|
||||
End Sub
|
||||
|
||||
|
||||
' Note Boolean Parameter
|
||||
Sub InitializeListboxProcedures(oModel as Object, SourceListbox as Object, TargetListbox as Object)
|
||||
Dim EmptyList()
|
||||
Set oDialogModel = oModel
|
||||
OriginalList()= SourceListbox.StringItemList()
|
||||
TargetListbox.StringItemList() = EmptyList()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub CopyListboxItems(SourceListbox as Object, TargetListbox As Object)
|
||||
Dim NullArray()
|
||||
TargetListbox.StringItemList() = OriginalList()
|
||||
SourceListbox.StringItemList() = NullArray()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormMoveSelected()
|
||||
Call MoveSelectedListBox(oDialogModel.lstFields, oDialogModel.lstSelFields)
|
||||
Call FormSetMoveRights()
|
||||
oDialogModel.lstSelFields.Tag = True
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormMoveAll()
|
||||
Call CopyListboxItems(oDialogModel.lstFields, oDialogModel.lstSelFields)
|
||||
Call FormSetMoveRights()
|
||||
oDialogModel.lstSelFields.Tag = True
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormRemoveSelected()
|
||||
Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, False)
|
||||
Call FormSetMoveRights()
|
||||
oDialogModel.lstSelFields.Tag = True
|
||||
End Sub
|
||||
|
||||
|
||||
Sub FormRemoveAll()
|
||||
Call MoveOrderedSelectedListbox(oDialogModel.lstFields, oDialogModel.lstSelFields, True)
|
||||
Call FormSetMoveRights()
|
||||
oDialogModel.lstSelFields.Tag = 1
|
||||
End Sub
|
||||
|
||||
|
||||
Sub MoveSelectedListBox(SourceListbox as Object, TargetListbox as Object)
|
||||
Dim MaxCurTarget as Integer
|
||||
Dim MaxSourceSelected as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim CurIndex
|
||||
Dim iOldTargetSelect as Integer
|
||||
Dim iOldSourceSelect as Integer
|
||||
MaxCurTarget = Ubound(TargetListbox.StringItemList())
|
||||
MaxSourceSelected = Ubound(SourceListbox.SelectedItems())
|
||||
Dim TargetList(MaxCurTarget+MaxSourceSelected+1)
|
||||
If MaxSourceSelected > -1 Then
|
||||
iOldSourceSelect = SourceListbox.SelectedItems(0)
|
||||
If Ubound(TargetListbox.SelectedItems()) > -1 Then
|
||||
iOldTargetSelect = TargetListbox.SelectedItems(0)
|
||||
Else
|
||||
iOldTargetSelect = -1
|
||||
End If
|
||||
For n = 0 To MaxCurTarget
|
||||
TargetList(n) = TargetListbox.StringItemList(n)
|
||||
Next n
|
||||
For m = 0 To MaxSourceSelected
|
||||
CurIndex = SourceListbox.SelectedItems(m)
|
||||
TargetList(n) = SourceListbox.StringItemList(CurIndex)
|
||||
n = n + 1
|
||||
Next m
|
||||
TargetListBox.StringItemList() = TargetList()
|
||||
SourceListbox.StringItemList() = RemoveSelected (SourceListbox)
|
||||
SetNewSelection(SourceListbox, iOldSourceSelect)
|
||||
SetNewSelection(TargetListbox, iOldTargetSelect)
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
Sub MoveOrderedSelectedListbox(lstSource as Object, lstTarget as Object, bMoveAll as Boolean)
|
||||
Dim NullArray()
|
||||
Dim MaxSelected as Integer
|
||||
Dim MaxSourceIndex as Integer
|
||||
Dim MaxOriginalIndex as Integer
|
||||
Dim MaxNewIndex as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim CurIndex as Integer
|
||||
Dim SearchString as String
|
||||
Dim SourceList() as String
|
||||
Dim iOldTargetSelect as Integer
|
||||
Dim iOldSourceSelect as Integer
|
||||
If bMoveAll Then
|
||||
lstSource.StringItemList() = OriginalList()
|
||||
lstTarget.StringItemList() = NullArray()
|
||||
Else
|
||||
MaxOriginalIndex = Ubound(OriginalList())
|
||||
MaxSelected = Ubound(lstTarget.SelectedItems())
|
||||
iOldTargetSelect = lstTarget.SelectedItems(0)
|
||||
If Ubound(lstSource.SelectedItems()) > -1 Then
|
||||
iOldSourceSelect = lstSource.SelectedItems(0)
|
||||
End If
|
||||
Dim SelList(MaxSelected)
|
||||
For n = 0 To MaxSelected
|
||||
CurIndex = lstTarget.SelectedItems(n)
|
||||
SelList(n) = lstTarget.StringItemList(CurIndex)
|
||||
Next n
|
||||
SourceList() = lstSource.StringItemList()
|
||||
MaxSourceIndex = Ubound(lstSource.StringItemList())
|
||||
MaxNewIndex = MaxSelected + MaxSourceIndex + 1
|
||||
Dim NewSourceList(MaxNewIndex)
|
||||
m = 0
|
||||
For n = 0 To MaxOriginalIndex
|
||||
SearchString = OriginalList(n)
|
||||
If IndexinArray(SearchString, SelList()) <> -1 Then
|
||||
NewSourceList(m) = SearchString
|
||||
m = m + 1
|
||||
ElseIf IndexinArray(SearchString, SourceList()) <> -1 Then
|
||||
NewSourceList(m) = SearchString
|
||||
m = m + 1
|
||||
End If
|
||||
Next n
|
||||
lstSource.StringItemList() = NewSourceList()
|
||||
lstTarget.StringItemList() = RemoveSelected(lstTarget)
|
||||
End If
|
||||
SetNewSelection(lstSource, iOldSourceSelect)
|
||||
SetNewSelection(lstTarget, iOldTargetSelect)
|
||||
|
||||
End Sub
|
||||
|
||||
|
||||
Function RemoveSelected(oListbox as Object)
|
||||
Dim MaxIndex as Integer
|
||||
Dim MaxSelected as Integer
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim CurIndex as Integer
|
||||
Dim CurItem as String
|
||||
Dim ResultArray()
|
||||
MaxIndex = Ubound(oListbox.StringItemList())
|
||||
MaxSelected = Ubound(oListbox.SelectedItems())
|
||||
Dim LocItemList(MaxIndex)
|
||||
LocItemList() = oListbox.StringItemList()
|
||||
If MaxSelected > -1 Then
|
||||
For n = 0 To MaxSelected
|
||||
CurIndex = oListbox.SelectedItems(n)
|
||||
LocItemList(CurIndex) = ""
|
||||
Next n
|
||||
If MaxIndex > 0 Then
|
||||
ReDim ResultArray(MaxIndex - MaxSelected - 1)
|
||||
m = 0
|
||||
For n = 0 To MaxIndex
|
||||
CurItem = LocItemList(n)
|
||||
If CurItem <> "" Then
|
||||
ResultArray(m) = CurItem
|
||||
m = m + 1
|
||||
End If
|
||||
Next n
|
||||
End If
|
||||
RemoveSelected = ResultArray()
|
||||
Else
|
||||
RemoveSelected = oListbox.StringItemList()
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub SetNewSelection(oListBox as Object, iLastSelection as Integer)
|
||||
Dim MaxIndex as Integer
|
||||
Dim SelIndex as Integer
|
||||
Dim SelList(0) as Integer
|
||||
MaxIndex = Ubound(oListBox.StringItemList())
|
||||
If MaxIndex > -1 AND iLastSelection > -1 Then
|
||||
If iLastSelection > MaxIndex Then
|
||||
Selindex = MaxIndex
|
||||
Else
|
||||
SelIndex = iLastSelection
|
||||
End If
|
||||
Sellist(0) = SelIndex
|
||||
oListBox.SelectedItems() = SelList()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ToggleListboxControls(oDialogModel as Object, bDoEnable as Boolean)
|
||||
With oDialogModel
|
||||
.lblFields.Enabled = bDoEnable
|
||||
.lblSelFields.Enabled = bDoEnable
|
||||
' .lstTables.Enabled = bDoEnable
|
||||
.lstFields.Enabled = bDoEnable
|
||||
.lstSelFields.Enabled = bDoEnable
|
||||
.cmdRemoveAll.Enabled = bDoEnable
|
||||
.cmdRemoveSelected.Enabled = bDoEnable
|
||||
.cmdMoveAll.Enabled = bDoEnable
|
||||
.cmdMoveSelected.Enabled = bDoEnable
|
||||
End With
|
||||
If bDoEnable Then
|
||||
FormSetMoveRights()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
' Enable or disable the buttons used for moving the available
|
||||
' fields between the two list boxes.
|
||||
Sub FormSetMoveRights()
|
||||
Dim bIsFieldSelected as Boolean
|
||||
Dim bSelectSelected as Boolean
|
||||
Dim FieldCount as Integer
|
||||
Dim SelectCount as Integer
|
||||
bIsFieldSelected = Ubound(oDialogModel.lstFields.SelectedItems()) <> -1
|
||||
FieldCount = Ubound(oDialogModel.lstFields.StringItemList()) + 1
|
||||
bSelectSelected = Ubound(oDialogModel.lstSelFields.SelectedItems()) > -1
|
||||
SelectCount = Ubound(oDialogModel.lstSelFields.StringItemList()) + 1
|
||||
oDialogModel.cmdRemoveAll.Enabled = SelectCount>=1
|
||||
oDialogModel.cmdRemoveSelected.Enabled = bSelectSelected
|
||||
oDialogModel.cmdMoveAll.Enabled = FieldCount >=1
|
||||
oDialogModel.cmdMoveSelected.Enabled = bIsFieldSelected
|
||||
oDialogModel.cmdGoOn.Enabled = SelectCount>=1
|
||||
' This flag is set to '1' when the lstSelFields has been modified
|
||||
End Sub
|
||||
|
||||
|
||||
Function AddSingleItemToListbox(ByVal oListbox as Object, ListItem as String, Optional iSelIndex) as Object
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
|
||||
MaxIndex = Ubound(oListbox.StringItemList())
|
||||
Dim LocList(MaxIndex + 1)
|
||||
' Todo: This goes faster with the Redim LocList(MaxIndex + 1) Preserve function
|
||||
For i = 0 To MaxIndex
|
||||
LocList(i) = oListbox.StringItemList(i)
|
||||
Next i
|
||||
LocList(MaxIndex + 1) = ListItem
|
||||
oListbox.StringItemList() = LocList()
|
||||
If Not IsMissing(iSelIndex) Then
|
||||
SelectListboxItem(oListbox, iSelIndex)
|
||||
End If
|
||||
AddSingleItemToListbox() = oListbox
|
||||
End Function
|
||||
|
||||
|
||||
Sub EmptyListbox(oListbox as Object)
|
||||
Dim NullList() as String
|
||||
oListbox.StringItemList() = NullList()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SelectListboxItem(oListbox as Object, iSelIndex as Integer)
|
||||
Dim LocSelList(0) as Integer
|
||||
If iSelIndex <> -1 Then
|
||||
LocSelList(0) = iSelIndex
|
||||
oListbox.SelectedItems() = LocSelList()
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetSelectedListboxItems(oListbox as Object)
|
||||
Dim SelList(Ubound(oListBox.SelectedItems())) as String
|
||||
Dim i as Integer
|
||||
Dim CurIndex as Integer
|
||||
For i = 0 To Ubound(oListbox.SelectedItems())
|
||||
CurIndex = oListbox.SelectedItems(i)
|
||||
SelList(i) = oListbox.StringItemList(CurIndex)
|
||||
Next i
|
||||
GetSelectedListboxItems() = SelList()
|
||||
End Function
|
||||
|
||||
|
||||
' Note: When using this Sub it must be ensured that the
|
||||
' 'RemoveItem' appears only only once in the Listbox
|
||||
Sub RemoveListboxItemByName(oListbox as Object, RemoveItem as String)
|
||||
Dim OldList() as String
|
||||
Dim NullList() as String
|
||||
Dim i as Integer
|
||||
Dim a as Integer
|
||||
Dim MaxIndex as Integer
|
||||
OldList = oListbox.StringItemList()
|
||||
MaxIndex = Ubound(OldList())
|
||||
If IndexInArray(RemoveItem, OldList()) <> -1 Then
|
||||
If MaxIndex > 0 Then
|
||||
a = 0
|
||||
Dim NewList(MaxIndex -1)
|
||||
For i = 0 To MaxIndex
|
||||
If RemoveItem <> OldList(i) Then
|
||||
NewList(a) = OldList(i)
|
||||
a = a + 1
|
||||
End If
|
||||
Next i
|
||||
oListbox.StringItemList() = NewList()
|
||||
Else
|
||||
oListBox.StringItemList() = NullList()
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Function GetItemPos(oListBox as Object, sItem as String)
|
||||
Dim ItemList()
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
ItemList() = oListBox.StringItemList()
|
||||
MaxIndex = Ubound(ItemList())
|
||||
For i = 0 To MaxIndex
|
||||
If sItem = ItemList(i) Then
|
||||
GetItemPos() = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
GetItemPos() = -1
|
||||
End Function
|
||||
</script:module>
|
||||
837
office-plugin/windows-office/share/basic/Tools/Misc.xba
Normal file
837
office-plugin/windows-office/share/basic/Tools/Misc.xba
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,390 @@
|
||||
<?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="ModuleControls" script:language="StarBasic">Option Explicit
|
||||
|
||||
Public DlgOverwrite as Object
|
||||
Public Const SBOVERWRITEUNDEFINED as Integer = 0
|
||||
Public Const SBOVERWRITECANCEL as Integer = 2
|
||||
Public Const SBOVERWRITEQUERY as Integer = 7
|
||||
Public Const SBOVERWRITEALWAYS as Integer = 6
|
||||
Public Const SBOVERWRITENEVER as Integer = 8
|
||||
Public iGeneralOverwrite as Integer
|
||||
|
||||
|
||||
|
||||
' Accepts the name of a control and returns the respective control model as object
|
||||
' The Container can either be a whole document or a specific sheet of a Calc-Document
|
||||
' 'CName' is the name of the Control
|
||||
Function getControlModel(oContainer as Object, CName as String)
|
||||
Dim aForm, oForms as Object
|
||||
Dim i as Integer
|
||||
oForms = oContainer.Drawpage.GetForms
|
||||
For i = 0 To oForms.Count-1
|
||||
aForm = oForms.GetbyIndex(i)
|
||||
If aForm.HasByName(CName) Then
|
||||
GetControlModel = aForm.GetbyName(CName)
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' Gets the Shape of a Control( e. g. to reset the size or Position of the control
|
||||
' Parameters:
|
||||
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
||||
' 'CName' is the Name of the Control
|
||||
Function GetControlShape(oContainer as Object,CName as String)
|
||||
Dim i as integer
|
||||
Dim aShape as Object
|
||||
For i = 0 to oContainer.DrawPage.Count-1
|
||||
aShape = oContainer.DrawPage(i)
|
||||
If HasUnoInterfaces(aShape, "com.sun.star.drawing.XControlShape") then
|
||||
If ashape.Control.Name = CName then
|
||||
GetControlShape = aShape
|
||||
exit Function
|
||||
End If
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
|
||||
' Returns the View of a Control
|
||||
' Parameters:
|
||||
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
||||
' The 'oController' is always directly attached to the Document
|
||||
' 'CName' is the Name of the Control
|
||||
Function getControlView(oContainer , oController as Object, CName as String) as Object
|
||||
Dim aForm, oForms, oControlModel as Object
|
||||
Dim i as Integer
|
||||
oForms = oContainer.DrawPage.Forms
|
||||
For i = 0 To oForms.Count-1
|
||||
aForm = oforms.GetbyIndex(i)
|
||||
If aForm.HasByName(CName) Then
|
||||
oControlModel = aForm.GetbyName(CName)
|
||||
GetControlView = oController.GetControl(oControlModel)
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
Msgbox("No Control with the name '" & CName & "' found" , 16, GetProductName())
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
' Parameters:
|
||||
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
||||
' 'CName' is the Name of the Control
|
||||
Function DisposeControl(oContainer as Object, CName as String) as Boolean
|
||||
Dim aControl as Object
|
||||
|
||||
aControl = GetControlModel(oContainer,CName)
|
||||
If not IsNull(aControl) Then
|
||||
aControl.Dispose()
|
||||
DisposeControl = True
|
||||
Else
|
||||
DisposeControl = False
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Returns a sequence of a group of controls like option buttons or checkboxes
|
||||
' The 'oContainer' is the Document or a specific sheet of a Calc - Document
|
||||
' 'sGroupName' is the Name of the Controlgroup
|
||||
Function GetControlGroupModel(oContainer as Object, sGroupName as String )
|
||||
Dim aForm, oForms As Object
|
||||
Dim aControlModel() As Object
|
||||
Dim i as integer
|
||||
|
||||
oForms = oContainer.DrawPage.Forms
|
||||
For i = 0 To oForms.Count-1
|
||||
aForm = oForms(i)
|
||||
If aForm.HasbyName(sGroupName) Then
|
||||
aForm.GetGroupbyName(sGroupName,aControlModel)
|
||||
GetControlGroupModel = aControlModel
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
Msgbox("No Controlgroup with the name '" & sGroupName & "' found" , 16, GetProductName())
|
||||
End Function
|
||||
|
||||
|
||||
' Returns the Referencevalue of a group of e.g. option buttons or check boxes
|
||||
' 'oControlGroup' is a sequence of the Control objects
|
||||
Function GetRefValue(oControlGroup() as Object)
|
||||
Dim i as Integer
|
||||
For i = 0 To Ubound(oControlGroup())
|
||||
' oControlGroup(i).DefaultState = oControlGroup(i).State
|
||||
If oControlGroup(i).State Then
|
||||
GetRefValue = oControlGroup(i).RefValue
|
||||
exit Function
|
||||
End If
|
||||
Next
|
||||
GetRefValue() = -1
|
||||
End Function
|
||||
|
||||
|
||||
Function GetRefValueOfControlGroup(oContainer as Object, GroupName as String)
|
||||
Dim oOptGroup() as Object
|
||||
Dim iRef as Integer
|
||||
oOptGroup() = GetControlGroupModel(oContainer, GroupName)
|
||||
iRef = GetRefValue(oOptGroup())
|
||||
GetRefValueofControlGroup = iRef
|
||||
End Function
|
||||
|
||||
|
||||
Function GetOptionGroupValue(oContainer as Object, OptGroupName as String) as Boolean
|
||||
Dim oRulesOptions() as Object
|
||||
oRulesOptions() = GetControlGroupModel(oContainer, OptGroupName)
|
||||
GetOptionGroupValue = oRulesOptions(0).State
|
||||
End Function
|
||||
|
||||
|
||||
|
||||
Function WriteOptValueToCell(oSheet as Object, OptGroupName as String, iCol as Integer, iRow as Integer) as Boolean
|
||||
Dim bOptValue as Boolean
|
||||
Dim oCell as Object
|
||||
bOptValue = GetOptionGroupValue(oSheet, OptGroupName)
|
||||
oCell = oSheet.GetCellByPosition(iCol, iRow)
|
||||
oCell.SetValue(ABS(CInt(bOptValue)))
|
||||
WriteOptValueToCell() = bOptValue
|
||||
End Function
|
||||
|
||||
|
||||
Function LoadDialog(Libname as String, DialogName as String, Optional oLibContainer)
|
||||
Dim oLib as Object
|
||||
Dim oLibDialog as Object
|
||||
Dim oRuntimeDialog as Object
|
||||
If IsMissing(oLibContainer ) then
|
||||
oLibContainer = DialogLibraries
|
||||
End If
|
||||
oLibContainer.LoadLibrary(LibName)
|
||||
oLib = oLibContainer.GetByName(Libname)
|
||||
oLibDialog = oLib.GetByName(DialogName)
|
||||
oRuntimeDialog = CreateUnoDialog(oLibDialog)
|
||||
LoadDialog() = oRuntimeDialog
|
||||
End Function
|
||||
|
||||
|
||||
Sub GetFolderName(oRefModel as Object)
|
||||
Dim oFolderDialog as Object
|
||||
Dim iAccept as Integer
|
||||
Dim sPath as String
|
||||
Dim InitPath as String
|
||||
Dim RefControlName as String
|
||||
Dim oUcb as object
|
||||
'Note: The following services have to be called in the following order
|
||||
' because otherwise Basic does not remove the FileDialog Service
|
||||
oFolderDialog = CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
InitPath = ConvertToUrl(oRefModel.Text)
|
||||
If InitPath = "" Then
|
||||
InitPath = GetPathSettings("Work")
|
||||
End If
|
||||
If oUcb.Exists(InitPath) Then
|
||||
oFolderDialog.SetDisplayDirectory(InitPath)
|
||||
End If
|
||||
iAccept = oFolderDialog.Execute()
|
||||
If iAccept = 1 Then
|
||||
sPath = oFolderDialog.GetDirectory()
|
||||
If oUcb.Exists(sPath) Then
|
||||
oRefModel.Text = ConvertFromUrl(sPath)
|
||||
End If
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub GetFileName(oRefModel as Object, Filternames())
|
||||
Dim oFileDialog as Object
|
||||
Dim iAccept as Integer
|
||||
Dim sPath as String
|
||||
Dim InitPath as String
|
||||
Dim RefControlName as String
|
||||
Dim oUcb as object
|
||||
'Dim ListAny(0)
|
||||
'Note: The following services have to be called in the following order
|
||||
' because otherwise Basic does not remove the FileDialog Service
|
||||
oFileDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
|
||||
'ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILEOPEN_SIMPLE
|
||||
'oFileDialog.initialize(ListAny())
|
||||
AddFiltersToDialog(FilterNames(), oFileDialog)
|
||||
InitPath = ConvertToUrl(oRefModel.Text)
|
||||
If InitPath = "" Then
|
||||
InitPath = GetPathSettings("Work")
|
||||
End If
|
||||
If oUcb.Exists(InitPath) Then
|
||||
oFileDialog.SetDisplayDirectory(InitPath)
|
||||
End If
|
||||
iAccept = oFileDialog.Execute()
|
||||
If iAccept = 1 Then
|
||||
sPath = oFileDialog.Files(0)
|
||||
If oUcb.Exists(sPath) Then
|
||||
oRefModel.Text = ConvertFromUrl(sPath)
|
||||
End If
|
||||
End If
|
||||
oFileDialog.Dispose()
|
||||
End Sub
|
||||
|
||||
|
||||
Function StoreDocument(oDocument as Object, FilterNames() as String, DefaultName as String, DisplayDirectory as String, Optional iAddProcedure as Integer) as String
|
||||
Dim NoArgs() as New com.sun.star.beans.PropertyValue
|
||||
Dim oStoreProperties(0) as New com.sun.star.beans.PropertyValue
|
||||
Dim oStoreDialog as Object
|
||||
Dim iAccept as Integer
|
||||
Dim sPath as String
|
||||
Dim ListAny(0) as Long
|
||||
Dim UIFilterName as String
|
||||
Dim FilterName as String
|
||||
Dim FilterIndex as Integer
|
||||
ListAny(0) = com.sun.star.ui.dialogs.TemplateDescription.FILESAVE_AUTOEXTENSION_PASSWORD
|
||||
oStoreDialog = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
|
||||
oStoreDialog.Initialize(ListAny())
|
||||
AddFiltersToDialog(FilterNames(), oStoreDialog)
|
||||
oStoreDialog.SetDisplayDirectory(DisplayDirectory)
|
||||
oStoreDialog.SetDefaultName(DefaultName)
|
||||
oStoreDialog.setValue(com.sun.star.ui.dialogs.ExtendedFilePickerElementIds.CHECKBOX_AUTOEXTENSION,0, true)
|
||||
|
||||
iAccept = oStoreDialog.Execute()
|
||||
If iAccept = 1 Then
|
||||
sPath = oStoreDialog.Files(0)
|
||||
UIFilterName = oStoreDialog.GetCurrentFilter()
|
||||
FilterIndex = IndexInArray(UIFilterName, FilterNames())
|
||||
FilterName = FilterNames(FilterIndex,2)
|
||||
If Not IsMissing(iAddProcedure) Then
|
||||
Select Case iAddProcedure
|
||||
Case 1
|
||||
CommitLastDocumentChanges(sPath)
|
||||
End Select
|
||||
End If
|
||||
On Local Error Goto NOSAVING
|
||||
If FilterName = "" Then
|
||||
' Todo: Catch the case that a document that has to be overwritten is writeportected (e.g. it is open)
|
||||
oDocument.StoreAsUrl(sPath, NoArgs())
|
||||
Else
|
||||
oStoreProperties(0).Name = "FilterName"
|
||||
oStoreProperties(0).Value = FilterName
|
||||
oDocument.StoreAsUrl(sPath, oStoreProperties())
|
||||
End If
|
||||
End If
|
||||
oStoreDialog.dispose()
|
||||
StoreDocument() = sPath
|
||||
Exit Function
|
||||
NOSAVING:
|
||||
If Err <> 0 Then
|
||||
' Msgbox("Document cannot be saved under '" & ConvertFromUrl(sPath) & "'", 48, GetProductName())
|
||||
sPath = ""
|
||||
oStoreDialog.dispose()
|
||||
Resume NOERROR
|
||||
NOERROR:
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Sub AddFiltersToDialog(FilterNames() as String, oDialog as Object)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim ViewFiltername as String
|
||||
Dim oProdNameAccess as Object
|
||||
Dim sProdName as String
|
||||
oProdNameAccess = GetRegistryKeyContent("org.openoffice.Setup/Product")
|
||||
sProdName = oProdNameAccess.getByName("ooName")
|
||||
MaxIndex = Ubound(FilterNames(), 1)
|
||||
For i = 0 To MaxIndex
|
||||
Filternames(i,0) = ReplaceString(Filternames(i,0), sProdName,"%productname%")
|
||||
oDialog.AppendFilter(FilterNames(i,0), FilterNames(i,1))
|
||||
Next i
|
||||
oDialog.SetCurrentFilter(FilterNames(0,0)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SwitchMousePointer(oWindowPeer as Object, bDoEnable as Boolean)
|
||||
Dim oWindowPointer as Object
|
||||
oWindowPointer = CreateUnoService("com.sun.star.awt.Pointer")
|
||||
If bDoEnable Then
|
||||
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.ARROW)
|
||||
Else
|
||||
oWindowPointer.SetType(com.sun.star.awt.SystemPointer.WAIT)
|
||||
End If
|
||||
oWindowPeer.SetPointer(oWindowPointer)
|
||||
End Sub
|
||||
|
||||
|
||||
Sub ShowOverwriteAllDialog(FilePath as String, sTitle as String)
|
||||
Dim QueryString as String
|
||||
Dim LocRetValue as Integer
|
||||
Dim lblYes as String
|
||||
Dim lblNo as String
|
||||
Dim lblYesToAll as String
|
||||
Dim lblCancel as String
|
||||
Dim OverwriteModel as Object
|
||||
If InitResources(GetProductName(), "dbw") Then
|
||||
QueryString = GetResText(507)
|
||||
QueryString = ReplaceString(QueryString, ConvertFromUrl(FilePath), "<PATH>")
|
||||
If Len(QueryString) > 190 Then
|
||||
QueryString = DeleteStr(QueryString, ".<BR>")
|
||||
End If
|
||||
QueryString = ReplaceString(QueryString, chr(13), "<BR>")
|
||||
lblYes = GetResText(508)
|
||||
lblYesToAll = GetResText(509)
|
||||
lblNo = GetResText(510)
|
||||
lblCancel = GetResText(511)
|
||||
DlgOverwrite = LoadDialog("Tools", "DlgOverwriteAll")
|
||||
DlgOverwrite.Title = sTitle
|
||||
OverwriteModel = DlgOverwrite.Model
|
||||
OverwriteModel.cmdYes.Label = lblYes
|
||||
OverwriteModel.cmdYesToAll.Label = lblYesToAll
|
||||
OverwriteModel.cmdNo.Label = lblNo
|
||||
OverwriteModel.cmdCancel.Label = lblCancel
|
||||
OverwriteModel.lblQueryforSave.Label = QueryString
|
||||
OverwriteModel.cmdNo.DefaultButton = True
|
||||
DlgOverwrite.GetControl("cmdNo").SetFocus()
|
||||
iGeneralOverwrite = 999
|
||||
LocRetValue = DlgOverwrite.execute()
|
||||
If iGeneralOverwrite = 999 Then
|
||||
iGeneralOverwrite = SBOVERWRITECANCEL
|
||||
End If
|
||||
DlgOverwrite.dispose()
|
||||
Else
|
||||
iGeneralOverwrite = SBOVERWRITECANCEL
|
||||
End If
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToQuery()
|
||||
iGeneralOverwrite = SBOVERWRITEQUERY
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToAlways()
|
||||
iGeneralOverwrite = SBOVERWRITEALWAYS
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
|
||||
|
||||
Sub SetOVERWRITEToNever()
|
||||
iGeneralOverwrite = SBOVERWRITENEVER
|
||||
DlgOverwrite.EndExecute()
|
||||
End Sub
|
||||
</script:module>
|
||||
472
office-plugin/windows-office/share/basic/Tools/Strings.xba
Normal file
472
office-plugin/windows-office/share/basic/Tools/Strings.xba
Normal file
@@ -0,0 +1,472 @@
|
||||
<?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="Strings" script:language="StarBasic">Option Explicit
|
||||
Public sProductname as String
|
||||
|
||||
|
||||
' Deletes out of a String 'BigString' all possible PartStrings, that are summed up
|
||||
' in the Array 'ElimArray'
|
||||
Function ElimChar(ByVal BigString as String, ElimArray() as String)
|
||||
Dim i% ,n%
|
||||
For i = 0 to Ubound(ElimArray)
|
||||
BigString = DeleteStr(BigString,ElimArray(i)
|
||||
Next
|
||||
ElimChar = BigString
|
||||
End Function
|
||||
|
||||
|
||||
' Deletes out of a String 'BigString' a possible Partstring 'CompString'
|
||||
Function DeleteStr(ByVal BigString,CompString as String) as String
|
||||
Dim i%, CompLen%, BigLen%
|
||||
CompLen = Len(CompString)
|
||||
i = 1
|
||||
While i <> 0
|
||||
i = Instr(i, BigString,CompString)
|
||||
If i <> 0 then
|
||||
BigLen = Len(BigString)
|
||||
BigString = Mid(BigString,1,i-1) + Mid(BigString,i+CompLen,BigLen-i+1-CompLen)
|
||||
End If
|
||||
Wend
|
||||
DeleteStr = BigString
|
||||
End Function
|
||||
|
||||
|
||||
' Finds a PartString, that is framed by the Strings 'Prestring' and 'PostString'
|
||||
Function FindPartString(BigString, PreString, PostString as String, SearchPos as Integer) as String
|
||||
Dim StartPos%, EndPos%
|
||||
Dim BigLen%, PreLen%, PostLen%
|
||||
StartPos = Instr(SearchPos,BigString,PreString)
|
||||
If StartPos <> 0 Then
|
||||
PreLen = Len(PreString)
|
||||
EndPos = Instr(StartPos + PreLen,BigString,PostString)
|
||||
If EndPos <> 0 Then
|
||||
BigLen = Len(BigString)
|
||||
PostLen = Len(PostString)
|
||||
FindPartString = Mid(BigString,StartPos + PreLen, EndPos - (StartPos + PreLen))
|
||||
SearchPos = EndPos + PostLen
|
||||
Else
|
||||
Msgbox("No final tag for '" & PreString & "' existing", 16, GetProductName())
|
||||
FindPartString = ""
|
||||
End If
|
||||
Else
|
||||
FindPartString = ""
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Note iCompare = 0 (Binary comparison)
|
||||
' iCompare = 1 (Text comparison)
|
||||
Function PartStringInArray(BigArray(), SearchString as String, iCompare as Integer) as Integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
MaxIndex = Ubound(BigArray())
|
||||
For i = 0 To MaxIndex
|
||||
If Instr(1, BigArray(i), SearchString, iCompare) <> 0 Then
|
||||
PartStringInArray() = i
|
||||
Exit Function
|
||||
End If
|
||||
Next i
|
||||
PartStringInArray() = -1
|
||||
End Function
|
||||
|
||||
|
||||
' Deletes the String 'SmallString' out of the String 'BigString'
|
||||
' in case SmallString's Position in BigString is right at the end
|
||||
Function RTrimStr(ByVal BigString, SmallString as String) as String
|
||||
Dim SmallLen as Integer
|
||||
Dim BigLen as Integer
|
||||
SmallLen = Len(SmallString)
|
||||
BigLen = Len(BigString)
|
||||
If Instr(1,BigString, SmallString) <> 0 Then
|
||||
If Mid(BigString,BigLen + 1 - SmallLen, SmallLen) = SmallString Then
|
||||
RTrimStr = Mid(BigString,1,BigLen - SmallLen)
|
||||
Else
|
||||
RTrimStr = BigString
|
||||
End If
|
||||
Else
|
||||
RTrimStr = BigString
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
' Deletes the Char 'CompChar' out of the String 'BigString'
|
||||
' in case CompChar's Position in BigString is right at the beginning
|
||||
Function LTRimChar(ByVal BigString as String,CompChar as String) as String
|
||||
Dim BigLen as integer
|
||||
BigLen = Len(BigString)
|
||||
If BigLen > 1 Then
|
||||
If Left(BigString,1) = CompChar then
|
||||
BigString = Mid(BigString,2,BigLen-1)
|
||||
End If
|
||||
ElseIf BigLen = 1 Then
|
||||
BigString = ""
|
||||
End If
|
||||
LTrimChar = BigString
|
||||
End Function
|
||||
|
||||
|
||||
' Retrieves an Array out of a String.
|
||||
' The fields of the Array are separated by the parameter 'Separator', that is contained
|
||||
' in the Array
|
||||
' The Array MaxIndex delivers the highest Index of this Array
|
||||
Function ArrayOutOfString(BigString, Separator as String, Optional MaxIndex as Integer)
|
||||
Dim LocList() as String
|
||||
LocList=Split(BigString,Separator)
|
||||
|
||||
If not isMissing(MaxIndex) then maxIndex=ubound(LocList())
|
||||
|
||||
ArrayOutOfString=LocList
|
||||
End Function
|
||||
|
||||
|
||||
' Deletes all fieldvalues in one-dimensional Array
|
||||
Sub ClearArray(BigArray)
|
||||
Dim i as integer
|
||||
For i = Lbound(BigArray()) to Ubound(BigArray())
|
||||
BigArray(i) = ""
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
' Deletes all fieldvalues in a multidimensional Array
|
||||
Sub ClearMultiDimArray(BigArray,DimCount as integer)
|
||||
Dim n%, m%
|
||||
For n = Lbound(BigArray(),1) to Ubound(BigArray(),1)
|
||||
For m = 0 to Dimcount - 1
|
||||
BigArray(n,m) = ""
|
||||
Next m
|
||||
Next n
|
||||
End Sub
|
||||
|
||||
|
||||
' Checks if a Field (LocField) is already defined in an Array
|
||||
' Returns 'True' or 'False'
|
||||
Function FieldinArray(LocArray(), MaxIndex as integer, LocField as String) As Boolean
|
||||
Dim i as integer
|
||||
For i = Lbound(LocArray()) to MaxIndex
|
||||
If Ucase(LocArray(i)) = Ucase(LocField) Then
|
||||
FieldInArray = True
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
FieldInArray = False
|
||||
End Function
|
||||
|
||||
|
||||
' Checks if a Field (LocField) is already defined in an Array
|
||||
' Returns 'True' or 'False'
|
||||
Function FieldinList(LocField, BigList()) As Boolean
|
||||
Dim i as integer
|
||||
For i = Lbound(BigList()) to Ubound(BigList())
|
||||
If LocField = BigList(i) Then
|
||||
FieldInList = True
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
FieldInList = False
|
||||
End Function
|
||||
|
||||
|
||||
' Retrieves the Index of the delivered String 'SearchString' in
|
||||
' the Array LocList()'
|
||||
Function IndexinArray(SearchString as String, LocList()) as Integer
|
||||
Dim i as integer
|
||||
For i = Lbound(LocList(),1) to Ubound(LocList(),1)
|
||||
If Ucase(LocList(i,0)) = Ucase(SearchString) Then
|
||||
IndexinArray = i
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
IndexinArray = -1
|
||||
End Function
|
||||
|
||||
|
||||
Sub MultiArrayInListbox(oDialog as Object, ListboxName as String, ValList(), iDim as Integer)
|
||||
Dim oListbox as Object
|
||||
Dim i as integer
|
||||
Dim a as Integer
|
||||
a = 0
|
||||
oListbox = oDialog.GetControl(ListboxName)
|
||||
oListbox.RemoveItems(0, oListbox.GetItemCount)
|
||||
For i = 0 to Ubound(ValList(), 1)
|
||||
If ValList(i) <> "" Then
|
||||
oListbox.AddItem(ValList(i, iDim-1), a)
|
||||
a = a + 1
|
||||
End If
|
||||
Next
|
||||
End Sub
|
||||
|
||||
|
||||
' Searches for a String in a two-dimensional Array by querying all Searchindexex of the second dimension
|
||||
' and delivers the specific String of the ReturnIndex in the second dimension of the Searchlist()
|
||||
Function StringInMultiArray(SearchList(), SearchString as String, SearchIndex as Integer, ReturnIndex as Integer, Optional MaxIndex as Integer) as String
|
||||
Dim i as integer
|
||||
Dim CurFieldString as String
|
||||
If IsMissing(MaxIndex) Then
|
||||
MaxIndex = Ubound(SearchList(),1)
|
||||
End If
|
||||
For i = Lbound(SearchList()) to MaxIndex
|
||||
CurFieldString = SearchList(i,SearchIndex)
|
||||
If Ucase(CurFieldString) = Ucase(SearchString) Then
|
||||
StringInMultiArray() = SearchList(i,ReturnIndex)
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
StringInMultiArray() = ""
|
||||
End Function
|
||||
|
||||
|
||||
' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension
|
||||
' and delivers the Index where it is found.
|
||||
Function GetIndexInMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer
|
||||
Dim i as integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim CurFieldValue
|
||||
MaxIndex = Ubound(SearchList(),1)
|
||||
For i = Lbound(SearchList()) to MaxIndex
|
||||
CurFieldValue = SearchList(i,SearchIndex)
|
||||
If CurFieldValue = SearchValue Then
|
||||
GetIndexInMultiArray() = i
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
GetIndexInMultiArray() = -1
|
||||
End Function
|
||||
|
||||
|
||||
' Searches for a Value in multidimensial Array by querying all Searchindices of the passed dimension
|
||||
' and delivers the Index where the Searchvalue is found as a part string
|
||||
Function GetIndexForPartStringinMultiArray(SearchList(), SearchValue, SearchIndex as Integer) as Integer
|
||||
Dim i as integer
|
||||
Dim MaxIndex as Integer
|
||||
Dim CurFieldValue
|
||||
MaxIndex = Ubound(SearchList(),1)
|
||||
For i = Lbound(SearchList()) to MaxIndex
|
||||
CurFieldValue = SearchList(i,SearchIndex)
|
||||
If Instr(CurFieldValue, SearchValue) > 0 Then
|
||||
GetIndexForPartStringinMultiArray() = i
|
||||
Exit Function
|
||||
End if
|
||||
Next
|
||||
GetIndexForPartStringinMultiArray = -1
|
||||
End Function
|
||||
|
||||
|
||||
Function ArrayfromMultiArray(MultiArray as String, iDim as Integer)
|
||||
Dim MaxIndex as Integer
|
||||
Dim i as Integer
|
||||
MaxIndex = Ubound(MultiArray())
|
||||
Dim ResultArray(MaxIndex) as String
|
||||
For i = 0 To MaxIndex
|
||||
ResultArray(i) = MultiArray(i,iDim)
|
||||
Next i
|
||||
ArrayfromMultiArray() = ResultArray()
|
||||
End Function
|
||||
|
||||
|
||||
' Replaces the string "OldReplace" through the String "NewReplace" in the String
|
||||
' 'BigString'
|
||||
Function ReplaceString(ByVal Bigstring, NewReplace, OldReplace as String) as String
|
||||
ReplaceString=join(split(BigString,OldReplace),NewReplace)
|
||||
End Function
|
||||
|
||||
|
||||
' Retrieves the second value for a next to 'SearchString' in
|
||||
' a two-dimensional string-Array
|
||||
Function FindSecondValue(SearchString as String, TwoDimList() as String ) as String
|
||||
Dim i as Integer
|
||||
For i = 0 To Ubound(TwoDimList,1)
|
||||
If Ucase(SearchString) = Ucase(TwoDimList(i,0)) Then
|
||||
FindSecondValue = TwoDimList(i,1)
|
||||
Exit For
|
||||
End If
|
||||
Next
|
||||
End Function
|
||||
|
||||
|
||||
' raises a base to a certain power
|
||||
Function Power(Basis as Double, Exponent as Double) as Double
|
||||
Power = Exp(Exponent*Log(Basis))
|
||||
End Function
|
||||
|
||||
|
||||
' rounds a Real to a given Number of Decimals
|
||||
Function Round(BaseValue as Double, Decimals as Integer) as Double
|
||||
Dim Multiplicator as Long
|
||||
Dim DblValue#, RoundValue#
|
||||
Multiplicator = Power(10,Decimals)
|
||||
RoundValue = Int(BaseValue * Multiplicator)
|
||||
Round = RoundValue/Multiplicator
|
||||
End Function
|
||||
|
||||
|
||||
'Retrieves the mere filename out of a whole path
|
||||
Function FileNameoutofPath(ByVal Path as String, Optional Separator as String) as String
|
||||
Dim i as Integer
|
||||
Dim SepList() as String
|
||||
If IsMissing(Separator) Then
|
||||
Path = ConvertFromUrl(Path)
|
||||
Separator = GetPathSeparator()
|
||||
End If
|
||||
SepList() = ArrayoutofString(Path, Separator,i)
|
||||
FileNameoutofPath = SepList(i)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFileNameExtension(ByVal FileName as String)
|
||||
Dim MaxIndex as Integer
|
||||
Dim SepList() as String
|
||||
SepList() = ArrayoutofString(FileName,".", MaxIndex)
|
||||
GetFileNameExtension = SepList(MaxIndex)
|
||||
End Function
|
||||
|
||||
|
||||
Function GetFileNameWithoutExtension(ByVal FileName as String, Optional Separator as String)
|
||||
Dim MaxIndex as Integer
|
||||
Dim SepList() as String
|
||||
If not IsMissing(Separator) Then
|
||||
FileName = FileNameoutofPath(FileName, Separator)
|
||||
End If
|
||||
SepList() = ArrayoutofString(FileName,".", MaxIndex)
|
||||
GetFileNameWithoutExtension = RTrimStr(FileName, "." & SepList(MaxIndex)
|
||||
End Function
|
||||
|
||||
|
||||
Function DirectoryNameoutofPath(sPath as String, Separator as String) as String
|
||||
Dim LocFileName as String
|
||||
LocFileName = FileNameoutofPath(sPath, Separator)
|
||||
DirectoryNameoutofPath = RTrimStr(sPath, Separator & LocFileName)
|
||||
End Function
|
||||
|
||||
|
||||
Function CountCharsinString(BigString, LocChar as String, ByVal StartPos as Integer) as Integer
|
||||
Dim LocCount%, LocPos%
|
||||
LocCount = 0
|
||||
Do
|
||||
LocPos = Instr(StartPos,BigString,LocChar)
|
||||
If LocPos <> 0 Then
|
||||
LocCount = LocCount + 1
|
||||
StartPos = LocPos+1
|
||||
End If
|
||||
Loop until LocPos = 0
|
||||
CountCharsInString = LocCount
|
||||
End Function
|
||||
|
||||
|
||||
Function BubbleSortList(ByVal SortList(),optional sort2ndValue as Boolean)
|
||||
'This function bubble sorts an array of maximum 2 dimensions.
|
||||
'The default sorting order is the first dimension
|
||||
'Only if sort2ndValue is True the second dimension is the relevant for the sorting order
|
||||
Dim s as Integer
|
||||
Dim t as Integer
|
||||
Dim i as Integer
|
||||
Dim k as Integer
|
||||
Dim dimensions as Integer
|
||||
Dim sortvalue as Integer
|
||||
Dim DisplayDummy
|
||||
dimensions = 2
|
||||
|
||||
On Local Error Goto No2ndDim
|
||||
k = Ubound(SortList(),2)
|
||||
No2ndDim:
|
||||
If Err <> 0 Then dimensions = 1
|
||||
|
||||
i = Ubound(SortList(),1)
|
||||
If ismissing(sort2ndValue) then
|
||||
sortvalue = 0
|
||||
else
|
||||
sortvalue = 1
|
||||
end if
|
||||
|
||||
For s = 1 to i - 1
|
||||
For t = 0 to i-s
|
||||
Select Case dimensions
|
||||
Case 1
|
||||
If SortList(t) > SortList(t+1) Then
|
||||
DisplayDummy = SortList(t)
|
||||
SortList(t) = SortList(t+1)
|
||||
SortList(t+1) = DisplayDummy
|
||||
End If
|
||||
Case 2
|
||||
If SortList(t,sortvalue) > SortList(t+1,sortvalue) Then
|
||||
For k = 0 to UBound(SortList(),2)
|
||||
DisplayDummy = SortList(t,k)
|
||||
SortList(t,k) = SortList(t+1,k)
|
||||
SortList(t+1,k) = DisplayDummy
|
||||
Next k
|
||||
End If
|
||||
End Select
|
||||
Next t
|
||||
Next s
|
||||
BubbleSortList = SortList()
|
||||
End Function
|
||||
|
||||
|
||||
Function GetValueoutofList(SearchValue, BigList(), iDim as Integer, Optional ValueIndex)
|
||||
Dim i as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(BigList(),1)
|
||||
For i = 0 To MaxIndex
|
||||
If BigList(i,0) = SearchValue Then
|
||||
If Not IsMissing(ValueIndex) Then
|
||||
ValueIndex = i
|
||||
End If
|
||||
GetValueOutOfList() = BigList(i,iDim)
|
||||
End If
|
||||
Next i
|
||||
End Function
|
||||
|
||||
|
||||
Function AddListtoList(ByVal FirstArray(), ByVal SecondArray(), Optional StartIndex)
|
||||
Dim n as Integer
|
||||
Dim m as Integer
|
||||
Dim MaxIndex as Integer
|
||||
MaxIndex = Ubound(FirstArray()) + Ubound(SecondArray()) + 1
|
||||
If MaxIndex > -1 Then
|
||||
Dim ResultArray(MaxIndex)
|
||||
For m = 0 To Ubound(FirstArray())
|
||||
ResultArray(m) = FirstArray(m)
|
||||
Next m
|
||||
For n = 0 To Ubound(SecondArray())
|
||||
ResultArray(m) = SecondArray(n)
|
||||
m = m + 1
|
||||
Next n
|
||||
AddListToList() = ResultArray()
|
||||
Else
|
||||
Dim NullArray()
|
||||
AddListToList() = NullArray()
|
||||
End If
|
||||
End Function
|
||||
|
||||
|
||||
Function CheckDouble(DoubleString as String)
|
||||
On Local Error Goto WRONGDATATYPE
|
||||
CheckDouble() = CDbl(DoubleString)
|
||||
WRONGDATATYPE:
|
||||
If Err <> 0 Then
|
||||
CheckDouble() = 0
|
||||
Resume NoErr:
|
||||
End If
|
||||
NOERR:
|
||||
End Function
|
||||
</script:module>
|
||||
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>
|
||||
@@ -0,0 +1,5 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Tools" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="DlgOverwriteAll"/>
|
||||
</library:library>
|
||||
10
office-plugin/windows-office/share/basic/Tools/script.xlb
Normal file
10
office-plugin/windows-office/share/basic/Tools/script.xlb
Normal file
@@ -0,0 +1,10 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd">
|
||||
<library:library xmlns:library="http://openoffice.org/2000/library" library:name="Tools" library:readonly="true" library:passwordprotected="false">
|
||||
<library:element library:name="ModuleControls"/>
|
||||
<library:element library:name="Strings"/>
|
||||
<library:element library:name="Misc"/>
|
||||
<library:element library:name="UCB"/>
|
||||
<library:element library:name="Listbox"/>
|
||||
<library:element library:name="Debug"/>
|
||||
</library:library>
|
||||
Reference in New Issue
Block a user