ToolTech/tool-tech
6
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

update

Browse Source
This commit is contained in:
Jane
2024-07-16 15:55:31 +08:00
parent 8f4ec86367
commit 29bc31ade5
12411 changed files with 8139339 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

114
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/AutoText.xba Normal file
View File

@@ -0,0 +1,114 @@
<?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="AutoText" script:language="StarBasic">&apos; BASIC
Option Explicit
Dim oDocument as Object
Dim sDocumentTitle as String
Sub Main()
Dim oTable as Object
Dim oRows as Object
Dim oDocuText as Object
Dim oAutoTextCursor as Object
Dim oAutoTextContainer as Object
Dim oAutogroup as Object
Dim oAutoText as Object
Dim oCharStyles as Object
Dim oContentStyle as Object
Dim oHeaderStyle as Object
Dim oGroupTitleStyle as Object
Dim n, m, iAutoCount as Integer
BasicLibraries.LoadLibrary(&quot;Tools&quot;)
sDocumentTitle = &quot;Installed AutoTexts&quot;
&apos; Open a new empty document
oDocument = CreateNewDocument(&quot;swriter&quot;)
If Not IsNull(oDocument) Then
oDocument.DocumentProperties.Title = sDocumentTitle
oDocuText = oDocument.Text
&apos; Create The Character-templates
oCharStyles = oDocument.StyleFamilies.GetByName(&quot;CharacterStyles&quot;)
&apos; The Characterstyle for the Header that describes the Title of Autotextgroups
oGroupTitleStyle = oDocument.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
oCharStyles.InsertbyName(&quot;AutoTextGroupTitle&quot;, oGroupTitleStyle)
oGroupTitleStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
oGroupTitleStyle.CharHeight = 14
&apos; The Characterstyle for the Header that describes the Title of Autotextgroups
oHeaderStyle = oDocument.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
oCharStyles.InsertbyName(&quot;AutoTextHeading&quot;, oHeaderStyle)
oHeaderStyle.CharWeight = com.sun.star.awt.FontWeight.BOLD
&apos; &quot;Ordinary&quot; Table Content
oContentStyle = oDocument.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
oCharStyles.InsertbyName(&quot;TableContent&quot;, oContentStyle)
oAutoTextContainer = CreateUnoService(&quot;com.sun.star.text.AutoTextContainer&quot;)
oAutoTextCursor = oDocuText.CreateTextCursor()
oAutoTextCursor.CharStyleName = &quot;AutoTextGroupTitle&quot;
&apos; Link the Title with the following table
oAutoTextCursor.ParaKeepTogether = True
For n = 0 To oAutoTextContainer.Count - 1
oAutoGroup = oAutoTextContainer.GetByIndex(n)
oAutoTextCursor.SetString(oAutoGroup.Title)
oAutoTextCursor.CollapseToEnd()
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oTable = oDocument.CreateInstance(&quot;com.sun.star.text.TextTable&quot;)
&apos; Divide the table if necessary
oTable.Split = True
&apos; oTable.KeepTogether = False
oTable.RepeatHeadLine = True
oAutoTextCursor.Text.InsertTextContent(oAutoTextCursor,oTable,False)
InsertStringToCell(&quot;AutoText Name&quot;,oTable.GetCellbyPosition(0,0), &quot;AutoTextHeading&quot;)
InsertStringToCell(&quot;AutoText Shortcut&quot;,oTable.GetCellbyPosition(1,0), &quot;AutoTextHeading&quot;)
&apos; Insert one row at the bottom of the table
oRows = oTable.Rows
iAutoCount = oAutoGroup.Count
For m = 0 To iAutoCount-1
&apos; Insert the name and the title of all Autotexts
oAutoText = oAutoGroup.GetByIndex(m)
InsertStringToCell(oAutoGroup.Titles(m), oTable.GetCellbyPosition(0, m + 1), &quot;TableContent&quot;)
InsertStringToCell(oAutoGroup.ElementNames(m), oTable.GetCellbyPosition(1, m + 1), &quot;TableContent&quot;)
If m &lt; iAutoCount-1 Then
oRows.InsertbyIndex(m + 2,1)
End If
Next m
oDocuText.insertControlCharacter(oAutoTextCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oAutoTextCursor.CollapseToEnd()
Next n
End If
End Sub
Sub InsertStringToCell(sCellString as String, oCell as Object, sCellStyle as String)
Dim oCellCursor as Object
oCellCursor = oCell.CreateTextCursor()
oCellCursor.CharStyleName = sCellStyle
oCell.Text.insertString(oCellCursor,sCellString,False)
oDocument.CurrentController.Select(oCellCursor)
End Sub</script:module>

92
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/ChangeAllChars.xba Normal file
View File

@@ -0,0 +1,92 @@
<?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="ChangeAllChars" script:language="StarBasic">&apos; This macro replaces all characters in a writer-document through &quot;x&quot; or &quot;X&quot; signs.
&apos; It works on the currently activated document.
Private const UPPERREPLACECHAR = &quot;X&quot;
Private const LOWERREPLACECHAR = &quot;x&quot;
Private MSGBOXTITLE
Private NOTSAVEDTEXT
Private WARNING
Sub ChangeAllChars &apos; Change all chars in the active document
Dim oSheets, oPages as Object
Dim i as Integer
Const MBYES = 6
Const MBABORT = 2
Const MBNO = 7
BasicLibraries.LoadLibrary(&quot;Tools&quot;)
MSGBOXTITLE = &quot;Change All Characters to an &apos;&quot; &amp; UPPERREPLACECHAR &amp; &quot;&apos;&quot;
NOTSAVEDTEXT = &quot;This document has already been modified: All characters will be changed to an &quot; &amp; UPPERREPLACECHAR &amp; &quot;&apos;. Should the document be saved now?&quot;
WARNING = &quot;This macro changes all characters and numbers to an &apos;&quot; &amp; UPPERREPLACECHAR &amp; &quot;&apos; in this document.&quot;
On Local Error GoTo NODOCUMENT
oDocument = StarDesktop.ActiveFrame.Controller.Model
NODOCUMENT:
If Err &lt;&gt; 0 Then
Msgbox(WARNING &amp; chr(13) &amp; &quot;First, activate a Writer document.&quot; , 16, GetProductName())
Exit Sub
End If
On Local Error Goto 0
sDocType = GetDocumentType(oDocument)
If oDocument.IsModified And oDocument.Url &lt;&gt; &quot;&quot; Then
Status = MsgBox(NOTSAVEDTEXT, 3+32, MSGBOXTITLE)
Select Case Status
Case MBYES
oDocument.Store
Case MBABORT, MBNO
End
End Select
Else
Status = MsgBox(WARNING, 3+32, MSGBOXTITLE)
If Status = MBNO Or Status = MBABORT Then &apos; No, Abort
End
End If
End If
Select Case sDocType
Case &quot;swriter&quot;
ReplaceAllStrings(oDocument)
Case Else
Msgbox(&quot;This macro only works with Writer documents.&quot;, 16, GetProductName())
End Select
End Sub
Sub ReplaceAllStrings(oContainer as Object)
ReplaceStrings(oContainer, &quot;[a-z]&quot;, LOWERREPLACECHAR)
ReplaceStrings(oContainer, &quot;[à-þ]&quot;, LOWERREPLACECHAR)
ReplaceStrings(oContainer, &quot;[A-Z]&quot;, UPPERREPLACECHAR)
ReplaceStrings(oContainer, &quot;[À-ß]&quot;, UPPERREPLACECHAR)
ReplaceStrings(oContainer, &quot;[0-9]&quot;, UPPERREPLACECHAR)
End Sub
Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString as String)
oReplaceDesc = oContainer.createReplaceDescriptor()
oReplaceDesc.SearchCaseSensitive = True
oReplaceDesc.SearchRegularExpression = True
oReplaceDesc.Searchstring = sSearchString
oReplaceDesc.ReplaceString = sReplaceString
oReplCount = oContainer.ReplaceAll(oReplaceDesc)
End Sub</script:module>

536
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/GetTexts.xba Normal file
View File

@@ -0,0 +1,536 @@
<?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="GetTexts" script:language="StarBasic">Option Explicit
&apos; Description:
&apos; This macro extracts the strings out of the currently active document and inserts them into a log document.
&apos; The aim of the macro is to provide the programmer an insight into the OpenOffice API.
&apos; It focuses on how document objects are accessed.
&apos; Therefore not only texts of the document body are retrieved but also texts of general
&apos; document objects like, annotations, charts and general document information.
Public oLogDocument, oLogText, oLogCursor, oLogHeaderStyle, oLogBodyTextStyle as Object
Public oDocument as Object
Public LogArray(1000) as String
Public LogIndex as Integer
Public oLocHeaderStyle as Object
Sub Main
Dim sDocType as String
Dim oHyperCursor as Object
Dim oCharStyles as Object
BasicLibraries.LoadLibrary(&quot;Tools&quot;)
On Local Error GoTo NODOCUMENT
oDocument = StarDesktop.ActiveFrame.Controller.Model
sDocType = GetDocumentType(oDocument)
NODOCUMENT:
If Err &lt;&gt; 0 Then
Msgbox(&quot;This macro extracts all data from the active Writer, Calc or Draw/Impress document.&quot; &amp; chr(13) &amp;_
&quot;To start this macro you have to activate a document first.&quot; , 16, GetProductName)
Exit Sub
End If
On Local Error Goto 0
&apos; Open a new document where all the texts are inserted
oLogDocument = CreateNewDocument(&quot;swriter&quot;)
If Not IsNull(oLogDocument) Then
oLogText = oLogDocument.Text
&apos; create and define the character styles of the log document
oCharStyles = oLogDocument.StyleFamilies.GetByName(&quot;CharacterStyles&quot;)
oLogHeaderStyle = oLogDocument.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
oCharStyles.InsertbyName(&quot;Log Header&quot;, oLogHeaderStyle)
oLogHeaderStyle.charWeight = com.sun.star.awt.FontWeight.BOLD
oLogBodyTextStyle = oLogDocument.createInstance(&quot;com.sun.star.style.CharacterStyle&quot;)
oCharStyles.InsertbyName(&quot;Log Body&quot;, oLogBodyTextStyle)
&apos; Insert the title of the activated document as a hyperlink
oHyperCursor = oLogText.createTextCursor()
oHyperCursor.CharWeight = com.sun.star.awt.FontWeight.BOLD
oHyperCursor.gotoStart(False)
oHyperCursor.HyperLinkURL = oDocument.URL
oHyperCursor.HyperLinkTarget = oDocument.URL
If oDocument.DocumentProperties.Title &lt;&gt; &quot;&quot; Then
oHyperCursor.HyperlinkName = oDocument.DocumentProperties.Title
End If
oLogText.insertString(oHyperCursor, oDocument.DocumentProperties.Title, False)
oLogText.insertControlCharacter(oHyperCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oLogCursor = oLogText.createTextCursor()
oLogCursor.GotoEnd(False)
&apos; &quot;Switch off&quot; the Hyperlink - Properties
oLogCursor.SetPropertyToDefault(&quot;HyperLinkURL&quot;)
oLogCursor.SetPropertyToDefault(&quot;HyperLinkTarget&quot;)
oLogCursor.SetPropertyToDefault(&quot;HyperLinkName&quot;)
LogIndex = 0
&apos; Get the Properties of the document
GetDocumentProps()
Select Case sDocType
Case &quot;swriter&quot;
GetWriterStrings()
Case &quot;scalc&quot;
GetCalcStrings()
Case &quot;sdraw&quot;, &quot;simpress&quot;
GetDrawStrings()
Case Else
Msgbox(&quot;This macro only works with a Writer, Calc or Draw/Impress document.&quot;, 16, GetProductName())
End Select
End If
End Sub
&apos; ***********************************************Calc documents**************************************************
Sub GetCalcStrings()
Dim i, n as integer
Dim oSheet as Object
Dim SheetName as String
Dim oSheets as Object
&apos; Create a sequence of all sheets within the document
oSheets = oDocument.Sheets
For i = 0 to osheets.Count - 1
oSheet = osheets.GetbyIndex(i)
SheetName = oSheet.Name
MakeLogHeadLine(&quot;Sheet No. &quot; &amp; i &amp; &quot; (&quot; &amp; SheetName &amp; &quot;)&quot; )
&apos; Check the &quot;body&quot; of the sheet
GetCellTexts(oSheet)
If oSheet.IsScenario then
MakeLogHeadLine(&quot;Scenario Comments from &quot; &amp; SheetName &amp; &quot;&apos;&quot;)
WriteStringtoLogFile(osheet.ScenarioComment)
End if
GetAnnotations(oSheet, &quot;Annotations from &apos;&quot; &amp; SheetName &amp; &quot;&apos;&quot;)
GetChartStrings(oSheet, &quot;Charts from &apos;&quot; &amp; SheetName &amp; &quot;&apos;&quot;)
GetControlStrings(oSheet.DrawPage, &quot;Controls from &apos;&quot; &amp; SheetName &amp; &quot;&apos;&quot;)
Next
&apos; Pictures
GetCalcGraphicNames()
GetNamedRanges()
End Sub
Sub GetCellTexts(oSheet as Object)
Dim BigRange, BigEnum, oCell as Object
BigRange = oDocument.CreateInstance(&quot;com.sun.star.sheet.SheetCellRanges&quot;)
BigRange.InsertbyName(&quot;&quot;,oSheet)
BigEnum = BigRange.GetCells.CreateEnumeration
While BigEnum.hasmoreElements
oCell = BigEnum.NextElement
If oCell.String &lt;&gt; &quot;&quot; And Val(oCell.String) = 0then
WriteStringtoLogFile(oCell.String)
End If
Wend
End Sub
Sub GetAnnotations(oSheet as Object, HeaderLine as String)
Dim oNotes as Object
Dim n as Integer
oNotes = oSheet.getAnnotations
If oNotes.hasElements() then
MakeLogHeadLine(HeaderLine)
For n = 0 to oNotes.Count-1
WriteStringtoLogFile(oNotes.GetbyIndex(n).String)
Next
End if
End Sub
Sub GetNamedRanges()
Dim i as integer
MakeLogHeadLine(&quot;Named Ranges&quot;)
For i = 0 To oDocument.NamedRanges.Count - 1
WriteStringtoLogFile(oDocument.NamedRanges.GetbyIndex(i).Name)
Next
End Sub
Sub GetCalcGraphicNames()
Dim n,m as integer
MakeLogHeadLine(&quot;Graphics&quot;)
For n = 0 To oDocument.Drawpages.count-1
For m = 0 To oDocument.Drawpages.GetbyIndex(n).Count - 1
WriteStringtoLogFile(oDocument.DrawPages.GetbyIndex(n).GetbyIndex(m).Text.String)
Next m
Next n
End Sub
&apos; ***********************************************Writer documents**************************************************
Sub GetParagraphTexts(oParaObject as Object, HeadLine as String)
Dim ParaEnum as Object
Dim oPara as Object
Dim oTextPortEnum as Object
Dim oTextPortion as Object
Dim i as integer
Dim oCellNames()
Dim oCell as Object
MakeLogHeadLine(HeadLine)
ParaEnum = oParaObject.Text.CreateEnumeration
While ParaEnum.HasMoreElements
oPara = ParaEnum.NextElement
&apos; Note: The enumeration ParaEnum lists all tables and paragraphs.
&apos; Therefore we have to find out what kind of object &quot;oPara&quot; actually is
If oPara.supportsService(&quot;com.sun.star.text.Paragraph&quot;) Then
&apos; &quot;oPara&quot; is a Paragraph
oTextPortEnum = oPara.createEnumeration
While oTextPortEnum.hasmoreElements
oTextPortion = oTextPortEnum.nextElement()
WriteStringToLogFile(oTextPortion.String)
Wend
Else
&apos; &quot;oPara&quot; is a table
oCellNames = oPara.CellNames
For i = 0 To Ubound(oCellNames())
If oCellNames(i) &lt;&gt; &quot;&quot; Then
oCell = oPara.getCellByName(oCellNames(i))
WriteStringToLogFile(oCell.String)
End If
Next
End If
Wend
End Sub
Sub GetChartStrings(oSheet as Object, HeaderLine as String)
Dim i as Integer
Dim aChartObject as Object
Dim aChartDiagram as Object
MakeLogHeadLine(HeaderLine)
For i = 0 to oSheet.Charts.Count-1
aChartObject = oSheet.Charts.GetByIndex(i).EmbeddedObject
If aChartObject.HasSubTitle then
WriteStringToLogFile(aChartObject.SubTitle.String)
End If
If aChartObject.HasMainTitle then
WriteStringToLogFile(aChartObject.Title.String)
End If
aChartDiagram = aChartObject.Diagram
If aChartDiagram.hasXAxisTitle Then
WriteStringToLogFile(aChartDiagram.XAxisTitle)
End If
If aChartDiagram.hasYAxisTitle Then
WriteStringToLogFile(aChartDiagram.YAxisTitle)
End If
If aChartDiagram.hasZAxisTitle Then
WriteStringToLogFile(aChartDiagram.ZAxisTitle)
End If
Next i
End Sub
Sub GetFrameTexts()
Dim i as integer
Dim oTextFrame as object
Dim oFrameEnum as Object
Dim oFramePort as Object
Dim oFrameTextEnum as Object
Dim oFrameTextPort as Object
MakeLogHeadLine(&quot;Text Frames&quot;)
For i = 0 to oDocument.TextFrames.Count-1
oTextFrame = oDocument.TextFrames.GetbyIndex(i)
WriteStringToLogFile(oTextFrame.Name)
&apos; Is the frame bound to the page?
If oTextFrame.AnchorType = com.sun.star.text.TextContentAnchorType.AT_PAGE Then
GetParagraphTexts(oTextFrame, &quot;Text Frame Contents&quot;)
End If
oFrameEnum = oTextFrame.CreateEnumeration
While oFrameEnum.HasMoreElements
oFramePort = oFrameEnum.NextElement
If oFramePort.supportsService(&quot;com.sun.star.text.Paragraph&quot;) then
oFrameTextEnum = oFramePort.createEnumeration
While oFrameTextEnum.HasMoreElements
oFrameTextPort = oFrameTextEnum.NextElement
If oFrameTextPort.SupportsService(&quot;com.sun.star.text.TextFrame&quot;) Then
WriteStringtoLogFile(oFrameTextPort.String)
End If
Wend
Else
WriteStringtoLogFile(oFramePort.Name)
End if
Wend
Next
End Sub
Sub GetTextFieldStrings()
Dim aTextField as Object
Dim i as integer
Dim CurElement as Object
MakeLogHeadLine(&quot;Text Fields&quot;)
aTextfield = oDocument.getTextfields.CreateEnumeration
While aTextField.hasmoreElements
CurElement = aTextField.NextElement
If CurElement.PropertySetInfo.hasPropertybyName(&quot;Content&quot;) Then
WriteStringtoLogFile(CurElement.Content)
ElseIf CurElement.PropertySetInfo.hasPropertybyName(&quot;PlaceHolder&quot;) Then
WriteStringtoLogFile(CurElement.PlaceHolder)
WriteStringtoLogFile(CurElement.Hint)
ElseIf Curelement.TextFieldMaster.PropertySetInfo.HasPropertybyName(&quot;Content&quot;) then
WriteStringtoLogFile(CurElement.TextFieldMaster.Content)
End If
Wend
End Sub
Sub GetLinkedFileNames()
Dim oDocSections as Object
Dim LinkedFileName as String
Dim i as Integer
If Right(oDocument.URL,3) = &quot;sgl&quot; Then
MakeLogHeadLine(&quot;Sub-documents&quot;)
oDocSections = oDocument.TextSections
For i = 0 to oDocSections.Count - 1
LinkedFileName = oDocSections.GetbyIndex(i).FileLink.FileURL
If LinkedFileName &lt;&gt; &quot;&quot; Then
WriteStringToLogFile(LinkedFileName)
End If
Next i
End If
End Sub
Sub GetSectionNames()
Dim i as integer
Dim oDocSections as Object
MakeLogHeadLine(&quot;Sections&quot;)
oDocSections = oDocument.TextSections
For i = 0 to oDocSections.Count-1
WriteStringtoLogFile(oDocSections.GetbyIndex(i).Name)
Next
End Sub
Sub GetWriterStrings()
GetParagraphTexts(oDocument, &quot;Document Body&quot;)
GetGraphicNames()
GetStyles()
GetControlStrings(oDocument.DrawPage, &quot;Controls&quot;)
GetTextFieldStrings()
GetSectionNames()
GetFrameTexts()
GetHyperLinks
GetLinkedFileNames()
End Sub
&apos; ***********************************************Draw/Impress documents**************************************************
Sub GetDrawPageTitles(LocObject as Object)
Dim n as integer
Dim oPage as Object
For n = 0 to LocObject.Count - 1
oPage = LocObject.GetbyIndex(n)
WriteStringtoLogFile(oPage.Name)
&apos; Is the page a DrawPage and not a MasterPage?
If oPage.supportsService(&quot;com.sun.star.drawing.DrawPage&quot;)then
&apos; Get the name of the NotesPage (only relevant for Impress documents)
If oDocument.supportsService(&quot;com.sun.star.presentation.PresentationDocument&quot;) then
WriteStringtoLogFile(oPage.NotesPage.Name)
End If
End If
Next
End Sub
Sub GetPageStrings(oPages as Object)
Dim m, n, s as Integer
Dim oPage, oPageElement, oShape as Object
For n = 0 to oPages.Count-1
oPage = oPages.GetbyIndex(n)
If oPage.HasElements then
For m = 0 to oPage.Count-1
oPageElement = oPage.GetByIndex(m)
If HasUnoInterfaces(oPageElement,&quot;com.sun.star.container.XIndexAccess&quot;) Then
&apos; The Object &quot;oPageElement&quot; a group of Shapes, that can be accessed by their index
For s = 0 To oPageElement.Count - 1
WriteStringToLogFile(oPageElement.GetByIndex(s).String)
Next s
ElseIf HasUnoInterfaces(oPageElement, &quot;com.sun.star.text.XText&quot;) Then
WriteStringtoLogFile(oPageElement.String)
End If
Next
End If
Next
End Sub
Sub GetDrawStrings()
Dim oDPages, oMPages as Object
oDPages = oDocument.DrawPages
oMPages = oDocument.Masterpages
MakeLogHeadLine(&quot;Titles&quot;)
GetDrawPageTitles(oDPages)
GetDrawPageTitles(oMPages)
MakeLogHeadLine(&quot;Document Body&quot;)
GetPageStrings(oDPages)
GetPageStrings(oMPages)
End Sub
&apos; ***********************************************Misc**************************************************
Sub GetDocumentProps()
Dim oDocuProps as Object
MakeLogHeadLine(&quot;Document Properties&quot;)
oDocuProps = oDocument.DocumentProperties
WriteStringToLogFile(oDocuProps.Title)
WriteStringToLogFile(oDocuProps.Description)
WriteStringToLogFile(oDocuProps.Subject)
WriteStringToLogFile(oDocuProps.Author)
&apos; WriteStringToLogFile(oDocuProps.UserDefinedProperties.ReplyTo)
&apos; WriteStringToLogFile(oDocuProps.UserDefinedProperties.Recipient)
&apos; WriteStringToLogFile(oDocuProps.UserDefinedProperties.References)
&apos; WriteStringToLogFile(oDocuProps.Keywords)
End Sub
Sub GetHyperlinks()
Dim i as integer
Dim oCrsr as Object
Dim oAllHyperLinks as Object
Dim SrchAttributes(0) as new com.sun.star.beans.PropertyValue
Dim oSearchDesc as Object
MakeLogHeadLine(&quot;Hyperlinks&quot;)
&apos; create a Search-Descriptor
oSearchDesc = oDocument.CreateSearchDescriptor
oSearchDesc.Valuesearch = False
&apos; define the Search-attributes
srchattributes(0).Name = &quot;HyperLinkURL&quot;
srchattributes(0).Value = &quot;&quot;
oSearchDesc.SetSearchAttributes(SrchAttributes())
oAllHyperLinks = oDocument.findAll(oSearchDesc())
For i = 0 to oAllHyperLinks.Count - 1
oFound = oAllHyperLinks(i)
oCrsr = oFound.Text.createTextCursorByRange(oFound)
WriteStringToLogFile(oCrs.HyperLinkURL) &apos;Url
WriteStringToLogFile(oCrs.HyperLinkTarget) &apos;Name
WriteStringToLogFile(oCrs.HyperLinkName) &apos;Frame
Next i
End Sub
Sub GetGraphicNames()
Dim i as integer
Dim oDocGraphics as Object
MakeLogHeadLine(&quot;Graphics&quot;)
oDocGraphics = oDocument.GraphicObjects
For i = 0 to oDocGraphics.count - 1
WriteStringtoLogFile(oDocGraphics.GetbyIndex(i).Name)
Next
End Sub
Sub GetStyles()
Dim m,n as integer
MakeLogHeadLine(&quot;User-defined Templates&quot;)
&apos; Check all StyleFamilies(i.e. PageStyles, ParagraphStyles, CharacterStyles, cellStyles)
For n = 0 to oDocument.StyleFamilies.Count - 1
For m = 0 to oDocument.StyleFamilies.getbyIndex(n).Count-1
If oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).IsUserDefined then
WriteStringtoLogFile(oDocument.StyleFamilies.GetbyIndex(n).getbyIndex(m).Name)
End If
Next
Next
End Sub
Sub GetControlStrings(oDPage as Object, HeaderLine as String)
Dim aForm as Object
Dim m,n as integer
MakeLogHeadLine(HeaderLine)
&apos;SearchFor all possible Controls
For n = 0 to oDPage.Forms.Count - 1
aForm = oDPage.Forms(n)
For m = 0 to aForm.Count-1
GetControlContent(aForm.GetbyIndex(m))
Next
Next
End Sub
Sub GetControlContent(LocControl as Object)
Dim i as integer
If LocControl.PropertySetInfo.HasPropertybyName(&quot;Label&quot;) then
WriteStringtoLogFile(LocControl.Label)
ElseIf LocControl.SupportsService(&quot;com.sun.star.form.component.ListBox&quot;) then
For i = 0 to Ubound(LocControl.StringItemList())
WriteStringtoLogFile(LocControl.StringItemList(i))
Next
End If
If LocControl.PropertySetInfo.HasPropertybyName(&quot;HelpText&quot;) then
WriteStringtoLogFile(LocControl.Helptext)
End If
End Sub
&apos; ***********************************************Log document**************************************************
Sub WriteStringtoLogFile( sString as String)
If (Not FieldInArray(LogArray(),LogIndex,sString))AND (NOT ISNULL(sString)) Then
LogArray(LogIndex) = sString
LogIndex = LogIndex + 1
oLogText.insertString(oLogCursor,sString,False)
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
End If
End Sub
Sub MakeLogHeadLine(HeadText as String)
oLogCursor.CharStyleName = &quot;Log Header&quot;
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oLogText.insertString(oLogCursor,HeadText,False)
oLogText.insertControlCharacter(oLogCursor,com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK,False)
oLogCursor.CharStyleName = &quot;Log Body&quot;
End Sub
</script:module>

322
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/ReadDir.xba Normal file
View File

@@ -0,0 +1,322 @@
<?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="ReadDir" script:language="StarBasic">Option Explicit
Public Const SBPAGEX = 800
Public Const SBPAGEY = 800
Public Const SBRELDIST = 1.3
&apos; Names of the second Dimension of the Array iLevelPos
Public Const SBBASEX = 0
Public Const SBBASEY = 1
Public Const SBOLDSTARTX = 2
Public Const SBOLDSTARTY = 3
Public Const SBOLDENDX = 4
Public Const SBOLDENDY = 5
Public Const SBNEWSTARTX = 6
Public Const SBNEWSTARTY = 7
Public Const SBNEWENDX = 8
Public Const SBNEWENDY = 9
Public ConnectLevel As Integer
Public iLevelPos(1,9) As Long
Public Source as String
Public iCurLevel as Integer
Public nConnectLevel as Integer
Public nOldWidth, nOldHeight As Long
Public nOldX, nOldY, nOldLevel As Integer
Public oOldLeavingLine As Object
Public oOldArrivingLine As Object
Public DlgReadDir as Object
Dim oProgressBar as Object
Dim oDocument As Object
Dim oPage As Object
Sub Main()
Dim oStandardTemplate as Object
BasicLibraries.LoadLibrary(&quot;Tools&quot;)
oDocument = CreateNewDocument(&quot;sdraw&quot;)
If Not IsNull(oDocument) Then
oPage = oDocument.DrawPages(0)
oStandardTemplate = oDocument.StyleFamilies.GetByName(&quot;graphics&quot;).GetByName(&quot;standard&quot;)
oStandardTemplate.CharHeight = 10
oStandardTemplate.TextLeftDistance = 100
oStandardTemplate.TextRightDistance = 100
oStandardTemplate.TextUpperDistance = 50
oStandardTemplate.TextLowerDistance = 50
DlgReadDir = LoadDialog(&quot;Gimmicks&quot;,&quot;ReadFolderDlg&quot;)
oProgressBar = DlgReadDir.Model.ProgressBar1
DlgReadDir.Model.TextField1.Text = ConvertFromUrl(GetPathSettings(&quot;Work&quot;))
DlgReadDir.Model.cmdGoOn.DefaultButton = True
DlgReadDir.GetControl(&quot;TextField1&quot;).SetFocus()
DlgReadDir.Execute
End If
End Sub
Sub TreeInfo()
Dim oCurTextShape As Object
Dim i as Integer
Dim bStartUpRun As Boolean
Dim CurFilename as String
Dim BaseLevel as Integer
Dim oController as Object
Dim MaxFileIndex as Integer
Dim FileNames() as String
ToggleDialogControls(False)
oProgressBar.ProgressValueMin = 0
oProgressBar.ProgressValueMax = 100
bStartUpRun = True
nOldHeight = 200
nOldY = SBPAGEY
nOldX = SBPAGEX
nOldWidth = SBPAGEX
oController = oDocument.GetCurrentController
Source = ConvertToURL(DlgReadDir.Model.TextField1.Text)
BaseLevel = CountCharsInString(Source, &quot;/&quot;, 1)
oProgressBar.ProgressValue = 5
DlgReadDir.Model.Label3.Enabled = True
FileNames() = ReadSourceDirectory(Source)
DlgReadDir.Model.Label4.Enabled = True
DlgReadDir.Model.Label3.Enabled = False
oProgressBar.ProgressValue = 12
FileNames() = BubbleSortList(FileNames())
DlgReadDir.Model.Label5.Enabled = True
DlgReadDir.Model.Label4.Enabled = False
oProgressBar.ProgressValue = 20
MaxFileIndex = Ubound(FileNames(),1)
For i = 0 To MaxFileIndex
oProgressBar.ProgressValue = 20 + (i/MaxFileIndex * 80)
CurFilename = FileNames(i,1)
SetNewLevels(FileNames(i,0), BaseLevel)
oCurTextShape = CreateTextShape(oPage, CurFilename)
CheckPageWidth(oCurTextShape.Size.Width)
iLevelPos(iCurLevel,SBBASEY) = oCurTextShape.Position.Y
If i = 0 Then
AdjustPageHeight(oCurTextShape.Size.Height, MaxFileIndex + 1)
End If
&apos; The Current TextShape has To be connected with a TextShape one Level higher
&apos; except for a TextShape In Level 0:
If Not bStartUpRun Then
&apos; A leaving Line Is only drawn when level is not 0
If iCurLevel&lt;&gt; 0 Then
&apos; Determine the Coordinates of the arriving Line
iLevelPos(iCurLevel,SBOLDSTARTX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
iLevelPos(iCurLevel,SBOLDSTARTY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
iLevelPos(iCurLevel,SBOLDENDX) = iLevelPos(iCurLevel,SBBASEX)
iLevelPos(iCurLevel,SBOLDENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
oOldArrivingLine = DrawLine(iCurLevel, SBOLDSTARTX, SBOLDSTARTY, SBOLDENDX, SBOLDENDY, oPage)
&apos; Determine the End-Coordinates of the last leaving Line
iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y + 0.5 * oCurTextShape.Size.Height
Else
&apos; On Level 0 the last Leaving Line&apos;s Endpoint is the upper edge of the TextShape
iLevelPos(nConnectLevel,SBNEWENDY) = oCurTextShape.Position.Y
iLevelPos(nConnectLevel,SBNEWENDX) = iLevelPos(nConnectLevel,SBNEWSTARTX)
End If
&apos; Draw the Connectors To the previous TextShapes
oOldLeavingLine = DrawLine(nConnectLevel, SBNEWSTARTX, SBNEWSTARTY, SBNEWENDX, SBNEWENDY, oPage)
Else
&apos; StartingPoint of the leaving Edge
bStartUpRun = FALSE
End If
&apos; Determine the beginning Coordinates of the leaving Line
iLevelPos(iCurLevel,SBNEWSTARTX) = iLevelPos(iCurLevel,SBBASEX) + 0.5 * oCurTextShape.Size.Width
iLevelPos(iCurLevel,SBNEWSTARTY) = iLevelPos(iCurLevel,SBBASEY) + oCurTextShape.Size.Height
&apos; Save the values For the Next run
nOldHeight = oCurTextShape.Size.Height
nOldX = oCurTextShape.Position.X
nOldWidth = oCurTextShape.Size.Width
nOldLevel = iCurLevel
Next i
ToggleDialogControls(True)
DlgReadDir.Model.cmdGoOn.Enabled = False
End Sub
Function CreateTextShape(oPage as Object, Filename as String)
Dim oTextShape As Object
Dim aPoint As New com.sun.star.awt.Point
aPoint.X = CalculateXPoint()
aPoint.Y = nOldY + SBRELDIST * nOldHeight
nOldY = aPoint.Y
oTextShape = oDocument.createInstance(&quot;com.sun.star.drawing.TextShape&quot;)
oTextShape.LineStyle = 1
oTextShape.Position = aPoint
oPage.add(oTextShape)
oTextShape.TextAutoGrowWidth = TRUE
oTextShape.TextAutoGrowHeight = TRUE
oTextShape.String = FileName
&apos; Configure Size And Position of the TextShape according to its Scripting
aPoint.X = iLevelPos(iCurLevel,SBBASEX)
oTextShape.Position = aPoint
CreateTextShape() = oTextShape
End Function
Function CalculateXPoint()
&apos; The current level Is lower than the Old one
If (iCurLevel&lt; nOldLevel) And (iCurLevel&lt;&gt; 0) Then
&apos; ClearArray(iLevelPos(),iCurLevel+1)
Elseif iCurLevel= 0 Then
iLevelPos(iCurLevel,SBBASEX) = SBPAGEX
&apos; The current level Is higher than the old one
Elseif iCurLevel&gt; nOldLevel Then
iLevelPos(iCurLevel,SBBASEX) = iLevelPos(iCurLevel-1,SBBASEX) + nOldWidth + 100
End If
CalculateXPoint = iLevelPos(iCurLevel,SBBASEX)
End Function
Function DrawLine(nLevel, nStartX, nStartY, nEndX, nEndY As Integer, oPage as Object)
Dim oConnect As Object
Dim aPoint As New com.sun.star.awt.Point
Dim aSize As New com.sun.star.awt.Size
aPoint.X = iLevelPos(nLevel,nStartX)
aPoint.Y = iLevelPos(nLevel,nStartY)
aSize.Width = iLevelPos(nLevel,nEndX) - iLevelPos(nLevel,nStartX)
aSize.Height = iLevelPos(nLevel,nEndY) - iLevelPos(nLevel,nStartY)
oConnect = oDocument.createInstance(&quot;com.sun.star.drawing.LineShape&quot;)
oConnect.Position = aPoint
oConnect.Size = aSize
oPage.Add(oConnect)
DrawLine() = oConnect
End Function
Sub GetSourceDirectory()
GetFolderName(DlgReadDir.Model.TextField1)
End Sub
Function ReadSourceDirectory(ByVal Source As String)
Dim i as Integer
Dim m as Integer
Dim n as Integer
Dim s as integer
Dim FileName as string
Dim FileNameList(100,1) as String
Dim DirList(0) as String
Dim oUCBobject as Object
Dim DirContent() as String
Dim SystemPath as String
Dim PathSeparator as String
Dim MaxFileIndex as Integer
PathSeparator = GetPathSeparator()
oUcbobject = createUnoService(&quot;com.sun.star.ucb.SimpleFileAccess&quot;)
m = 0
s = 0
DirList(0) = Source
FileNameList(n,0) = Source
SystemPath = ConvertFromUrl(Source)
FileNameList(n,1) = FileNameoutofPath(SystemPath, PathSeparator)
n = 1
Do
Source = DirList(m)
m = m + 1
DirContent() = oUcbObject.GetFolderContents(Source,True)
If Ubound(DirContent()) &lt;&gt; -1 Then
MaxFileIndex = Ubound(DirContent())
For i = 0 to MaxFileIndex
FileName = DirContent(i)
FileNameList(n,0) = FileName
SystemPath = ConvertFromUrl(FileName)
FileNameList(n,1) = FileNameOutofPath(SystemPath, PathSeparator)
n = n + 1
If n &gt; Ubound(FileNameList(),1) Then
ReDim Preserve FileNameList(n + 10,1) as String
End If
If oUcbObject.IsFolder(FileName) Then
s = s + 1
ReDim Preserve DirList(s) as String
DirList(s) = FileName
End If
Next i
End If
Loop Until m &gt; Ubound(DirList())
ReDim Preserve FileNameList(n-1,1) as String
ReadSourceDirectory() = FileNameList()
End Function
Sub CloseDialog
DlgReadDir.EndExecute
End Sub
Sub AdjustPageHeight(lShapeHeight, FileCount)
Dim lNecHeight as Long
Dim lBorders as Long
oDocument.LockControllers
lBorders = oPage.BorderTop + oPage.BorderBottom
lNecHeight = SBPAGEY + (FileCount * SBRELDIST * lShapeHeight)
If lNecHeight &gt; (oPage.Height - lBorders) Then
oPage.Height = lNecHeight + lBorders + 500
End If
oDocument.UnlockControllers
End Sub
Sub SetNewLevels(FileName as String, BaseLevel as Integer)
iCurLevel= CountCharsInString(FileName, &quot;/&quot;, 1) - BaseLevel
If iCurLevel &lt;&gt; 0 Then
nConnectLevel = iCurLevel- 1
Else
nConnectLevel = iCurLevel
End If
If iCurLevel &gt; Ubound(iLevelPos(),1) Then
ReDim Preserve iLevelPos(iCurLevel,9) as Long
End If
End Sub
Sub CheckPageWidth(TextWidth as Long)
Dim PageWidth as Long
Dim BaseX as Long
PageWidth = oPage.Width
BaseX = iLevelPos(iCurLevel,SBBASEX)
If BaseX + TextWidth &gt; PageWidth - 1000 Then
oPage.Width = 1000 + BaseX + TextWidth
End If
End Sub
Sub ToggleDialogControls(bDoEnable as Boolean)
With DlgReadDir.Model
.cmdGoOn.Enabled = bDoEnable
.cmdGetDir.Enabled = bDoEnable
.Label1.Enabled = bDoEnable
.Label2.Enabled = bDoEnable
.TextField1.Enabled = bDoEnable
End With
End Sub</script:module>

39
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/ReadFolderDlg.xdl Normal file
View File

@@ -0,0 +1,39 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.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 .
-->
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="ReadFolderDlg" dlg:left="161" dlg:top="81" dlg:width="180" dlg:height="136" dlg:closeable="true" dlg:moveable="true" dlg:title="Read and Design Recursively">
<dlg:bulletinboard>
<dlg:button dlg:id="cmdGetDir" dlg:tab-index="0" dlg:left="161" dlg:top="49" dlg:width="14" dlg:height="14" dlg:value="...">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.GetSourceDirectory?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:textfield dlg:id="TextField1" dlg:tab-index="1" dlg:left="6" dlg:top="50" dlg:width="147" dlg:height="12"/>
<dlg:button dlg:id="cmdCancel" dlg:tab-index="2" dlg:left="49" dlg:top="115" dlg:width="35" dlg:height="14" dlg:value="~Cancel">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.CloseDialog?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="cmdGoOn" dlg:tab-index="3" dlg:left="95" dlg:top="115" dlg:width="35" dlg:height="14" dlg:value="~GoOn">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.ReadDir.TreeInfo?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:text dlg:id="Label1" dlg:tab-index="4" dlg:left="6" dlg:top="38" dlg:width="122" dlg:height="8" dlg:value="Top level path"/>
<dlg:text dlg:id="Label2" dlg:tab-index="5" dlg:left="6" dlg:top="4" dlg:width="168" dlg:height="26" dlg:value="This macro will create a drawing document and design a complete tree view of all subdirectories from a given path." dlg:multiline="true"/>
<dlg:progressmeter dlg:id="ProgressBar1" dlg:tab-index="6" dlg:left="6" dlg:top="101" dlg:width="170" dlg:height="10"/>
<dlg:text dlg:id="Label3" dlg:tab-index="7" dlg:disabled="true" dlg:left="6" dlg:top="69" dlg:width="170" dlg:height="8" dlg:value="Getting the files and subdirectories..."/>
<dlg:text dlg:id="Label4" dlg:tab-index="8" dlg:disabled="true" dlg:left="6" dlg:top="80" dlg:width="170" dlg:height="8" dlg:value="Sorting the files and subdirectories..."/>
<dlg:text dlg:id="Label5" dlg:tab-index="9" dlg:disabled="true" dlg:left="6" dlg:top="91" dlg:width="170" dlg:height="8" dlg:value="Drawing the filestructure..."/>
</dlg:bulletinboard>
</dlg:window>

66
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/UserfieldDlg.xdl Normal file
View File

@@ -0,0 +1,66 @@
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE dlg:window PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "dialog.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 .
-->
<dlg:window xmlns:dlg="http://openoffice.org/2000/dialog" xmlns:script="http://openoffice.org/2000/script" dlg:id="UserfieldDlg" dlg:left="161" dlg:top="57" dlg:width="281" dlg:height="214" dlg:closeable="true" dlg:moveable="true" dlg:title="Modify User Data">
<dlg:bulletinboard>
<dlg:text dlg:id="Label1" dlg:tab-index="0" dlg:left="6" dlg:top="48" dlg:width="57" dlg:height="8" dlg:value="Label1"/>
<dlg:text dlg:id="Label2" dlg:tab-index="1" dlg:left="6" dlg:top="64" dlg:width="57" dlg:height="8" dlg:value="Label2"/>
<dlg:text dlg:id="Label3" dlg:tab-index="2" dlg:left="6" dlg:top="80" dlg:width="57" dlg:height="8" dlg:value="Label3"/>
<dlg:text dlg:id="Label4" dlg:tab-index="3" dlg:left="6" dlg:top="96" dlg:width="57" dlg:height="8" dlg:value="Label4"/>
<dlg:text dlg:id="Label5" dlg:tab-index="4" dlg:left="6" dlg:top="112" dlg:width="57" dlg:height="8" dlg:value="Label5"/>
<dlg:text dlg:id="Label6" dlg:tab-index="5" dlg:left="6" dlg:top="128" dlg:width="57" dlg:height="8" dlg:value="Label6"/>
<dlg:text dlg:id="Label7" dlg:tab-index="6" dlg:left="6" dlg:top="144" dlg:width="57" dlg:height="8" dlg:value="Label7"/>
<dlg:text dlg:id="Label8" dlg:tab-index="7" dlg:left="6" dlg:top="160" dlg:width="57" dlg:height="8" dlg:value="Label8"/>
<dlg:text dlg:id="Label9" dlg:tab-index="8" dlg:left="6" dlg:top="176" dlg:width="57" dlg:height="8" dlg:value="Label9"/>
<dlg:textfield dlg:id="TextField1" dlg:tab-index="9" dlg:left="65" dlg:top="46" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField2" dlg:tab-index="10" dlg:left="65" dlg:top="62" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField3" dlg:tab-index="11" dlg:left="65" dlg:top="78" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField4" dlg:tab-index="12" dlg:left="65" dlg:top="94" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField5" dlg:tab-index="13" dlg:left="65" dlg:top="110" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField6" dlg:tab-index="14" dlg:left="65" dlg:top="126" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField7" dlg:tab-index="15" dlg:left="65" dlg:top="142" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField8" dlg:tab-index="16" dlg:left="65" dlg:top="158" dlg:width="193" dlg:height="12"/>
<dlg:textfield dlg:id="TextField9" dlg:tab-index="17" dlg:left="65" dlg:top="174" dlg:width="193" dlg:height="12"/>
<dlg:scrollbar dlg:id="ScrollBar1" dlg:tab-index="18" dlg:left="263" dlg:top="46" dlg:width="12" dlg:height="140" dlg:align="vertical">
<script:event script:event-name="on-adjustmentvaluechange" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.ScrollControls?language=Basic&amp;location=application" script:language="Script"/>
</dlg:scrollbar>
<dlg:button dlg:id="cmdQuit" dlg:tab-index="19" dlg:left="6" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Exit Macro" dlg:value="Exit">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StopMacro?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="cmdSave" dlg:tab-index="20" dlg:left="45" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Save All Data of All Users to File" dlg:value="~Save">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.SaveSettings?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="cmdSelect" dlg:tab-index="21" dlg:left="84" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Replace the User Data in &lt;PRODUCTNAME&gt; With the User Data Above" dlg:value="Se~lect">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.SelectCurrentFields?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="cmdNextUser" dlg:tab-index="22" dlg:left="162" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="1" dlg:help-text="Show Data of Next User" dlg:value="Next &gt;&gt;">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StepToRecord?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="cmdPrevUser" dlg:tab-index="23" dlg:left="123" dlg:top="193" dlg:width="35" dlg:height="14" dlg:tag="-1" dlg:help-text="Show Data of Previous User" dlg:value="&lt;&lt;Previous">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.StepToRecord?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:button dlg:id="CommandButton1" dlg:tab-index="24" dlg:left="201" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Add Data for New User" dlg:value="~New">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.AddRecord?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
<dlg:text dlg:id="Label10" dlg:tab-index="25" dlg:left="6" dlg:top="6" dlg:width="269" dlg:height="34" dlg:value="This macro lets you easily administrate several user profiles.&#x0a;The user data of several users may be stored in a single file in the directory &lt;ConfigDir&gt;. From there, you can select a particular user whose data is then the current user data in &lt;PRODUCTNAME&gt;." dlg:multiline="true"/>
<dlg:button dlg:id="cmdDelete" dlg:tab-index="26" dlg:left="240" dlg:top="193" dlg:width="35" dlg:height="14" dlg:help-text="Delete Data of Current User" dlg:value="Delete">
<script:event script:event-name="on-performaction" script:macro-name="vnd.sun.star.script:Gimmicks.Userfields.DeleteCurrentSettings?language=Basic&amp;location=application" script:language="Script"/>
</dlg:button>
</dlg:bulletinboard>
</dlg:window>

236
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/Userfields.xba Normal file
View File

@@ -0,0 +1,236 @@
<?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="Userfields" script:language="StarBasic">Option Explicit
&apos;Todo: Controlling Scrollbar via Keyboard
Public Const SBMAXFIELDINDEX = 14
Public DlgUserFields as Object
Public oDocument as Object
Public UserFieldDataType(SBMAXFIELDINDEX,1) as String
Public ScrollBarValue as Integer
Public UserFieldFamily(0, SBMAXfIELDINDEX) as String
Public Const SBTBCOUNT = 9
Public oUserDataAccess as Object
Public CurFieldIndex as Integer
Public FilePath as String
Sub StartChangesUserfields
Dim SystemPath as String
BasicLibraries.LoadLibrary(&quot;Tools&quot;)
UserFieldDatatype(0,0) = &quot;COMPANY&quot;
UserFieldDatatype(0,1) = &quot;o&quot;
UserFieldDatatype(1,0) = &quot;FIRSTNAME&quot;
UserFieldDatatype(1,1) = &quot;givenname&quot;
UserFieldDatatype(2,0) = &quot;LASTNAME&quot;
UserFieldDatatype(2,1) = &quot;sn&quot;
UserFieldDatatype(3,0) = &quot;INITIALS&quot;
UserFieldDatatype(3,1) = &quot;initials&quot;
UserFieldDatatype(4,0) = &quot;STREET&quot;
UserFieldDatatype(4,1) = &quot;street&quot;
UserFieldDatatype(5,0) = &quot;COUNTRY&quot;
UserFieldDatatype(5,1) = &quot;c&quot;
UserFieldDatatype(6,0) = &quot;ZIP&quot;
UserFieldDatatype(6,1) = &quot;postalcode&quot;
UserFieldDatatype(7,0) = &quot;CITY&quot;
UserFieldDatatype(7,1) = &quot;l&quot;
UserFieldDatatype(8,0) = &quot;TITLE&quot;
UserFieldDatatype(8,1) = &quot;title&quot;
UserFieldDatatype(9,0) = &quot;POSITION&quot;
UserFieldDatatype(9,1) = &quot;position&quot;
UserFieldDatatype(10,0) = &quot;PHONE_HOME&quot;
UserFieldDatatype(10,1) = &quot;homephone&quot;
UserFieldDatatype(11,0) = &quot;PHONE_WORK&quot;
UserFieldDatatype(11,1) = &quot;telephonenumber&quot;
UserFieldDatatype(12,0) = &quot;FAX&quot;
UserFieldDatatype(12,1) = &quot;facsimiletelephonenumber&quot;
UserFieldDatatype(13,0) = &quot;E-MAIL&quot;
UserFieldDatatype(13,1) = &quot;mail&quot;
UserFieldDatatype(14,0) = &quot;STATE&quot;
UserFieldDatatype(14,1) = &quot;st&quot;
FilePath = GetPathSettings(&quot;Config&quot;, False) &amp; &quot;/&quot; &amp; &quot;UserData.dat&quot;
DlgUserFields = LoadDialog(&quot;Gimmicks&quot;,&quot;UserfieldDlg&quot;)
SystemPath = ConvertFromUrl(FilePath)
DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, &quot;&apos;&quot; &amp; SystemPath &amp; &quot;&apos;&quot;, &quot;&lt;ConfigDir&gt;&quot;)
DlgUserFields.Model.Label10.Label = ReplaceString(DlgUserFields.Model.Label10.Label, GetProductName(), &quot;&lt;PRODUCTNAME&gt;&quot;)
DlgUserFields.Model.cmdSelect.HelpText = ReplaceString(DlgUserFields.Model.cmdSelect.HelpText, GetProductName(), &quot;&lt;PRODUCTNAME&gt;&quot;)
ScrollBarValue = 0
oUserDataAccess = GetRegistryKeyContent(&quot;org.openoffice.UserProfile/Data&quot;, True)
InitializeUserFamily()
FillDialog()
DlgUserFields.Execute
DlgUserFields.Dispose()
End Sub
Sub FillDialog()
Dim a as Integer
With DlgUserFields
For a = 1 To SBTBCount
.GetControl(&quot;Label&quot; &amp; a).Model.Label = UserFieldDataType(a-1,0)
.GetControl(&quot;TextField&quot; &amp; a).Model.Text = UserFieldFamily(CurFieldIndex, a-1)
Next a
.Model.ScrollBar1.ScrollValueMax = (SBMAXFIELDINDEX+1) - SBTBCOUNT
.Model.ScrollBar1.BlockIncrement = SBTBCOUNT
.Model.ScrollBar1.LineIncrement = 1
.Model.ScrollBar1.ScrollValue = ScrollBarValue
End With
End Sub
Sub ScrollControls()
ScrollTextFieldInfo(ScrollBarValue)
ScrollBarValue = DlgUserFields.Model.ScrollBar1.ScrollValue
If (ScrollBarValue + SBTBCOUNT) &gt;= SBMAXFIELDINDEX + 1 Then
ScrollBarValue = (SBMAXFIELDINDEX + 1) - SBTBCOUNT
End If
FillupTextFields()
End Sub
Sub ScrollTextFieldInfo(ByVal iScrollValue as Integer)
Dim a as Integer
Dim CurIndex as Integer
For a = 1 To SBTBCOUNT
CurIndex = (a-1) + iScrollValue
UserFieldFamily(CurFieldIndex,CurIndex) = DlgUserFields.GetControl(&quot;TextField&quot; &amp; a).Model.Text
Next a
End Sub
Sub StopMacro()
DlgUserFields.EndExecute
End Sub
Sub SaveSettings()
Dim n as Integer
Dim m as Integer
Dim MaxIndex as Integer
ScrollTextFieldInfo(DlgUserFields.Model.ScrollBar1.ScrollValue)
MaxIndex = Ubound(UserFieldFamily(), 1)
Dim FileStrings(MaxIndex) as String
For n = 0 To MaxIndex
FileStrings(n) = &quot;&quot;
For m = 0 To SBMAXFIELDINDEX
FileStrings(n) = FileStrings(n) &amp; UserFieldFamily(n,m) &amp; &quot;;&quot;
Next m
Next n
SaveDataToFile(FilePath, FileStrings(), True)
End Sub
Sub ToggleButtons(ByVal Index as Integer)
Dim i as Integer
CurFieldIndex = Index
DlgUserFields.Model.cmdNextUser.Enabled = CurFieldIndex &lt;&gt; Ubound(UserFieldFamily(), 1)
DlgUserFields.Model.cmdPrevUser.Enabled = CurFieldIndex &lt;&gt; 0
End Sub
Sub InitializeUserFamily()
Dim FirstIndex as Integer
Dim UserFieldstrings() as String
Dim LocStrings() as String
Dim bFileExists as Boolean
Dim n as Integer
Dim m as Integer
bFileExists = LoadDataFromFile(GetPathSettings(&quot;Config&quot;, False) &amp; &quot;/&quot; &amp; &quot;UserData.dat&quot;, UserFieldStrings())
If bFileExists Then
FirstIndex = Ubound(UserFieldStrings())
ReDim Preserve UserFieldFamily(FirstIndex, SBMAXFIELDINDEX) as String
For n = 0 To FirstIndex
LocStrings() = ArrayOutofString(UserFieldStrings(n), &quot;;&quot;)
For m = 0 To SBMAXFIELDINDEX
UserFieldFamily(n,m) = LocStrings(m)
Next m
Next n
Else
ReDim Preserve UserFieldFamily(0,SBMAXFIELDINDEX) as String
For m = 0 To SBMAXFIELDINDEX
UserFieldFamily(0,m) = oUserDataAccess.GetByName(UserFieldDataType(m,1))
Next m
End If
ToggleButtons(0)
End Sub
Sub AddRecord()
Dim i as Integer
Dim MaxIndex as Integer
For i = 1 To SBTBCount
DlgUserFields.GetControl(&quot;TextField&quot; &amp; i).Model.Text = &quot;&quot;
Next i
MaxIndex = Ubound(UserFieldFamily(),1)
ReDim Preserve UserFieldFamily(MaxIndex + 1, SBMAXFIELDINDEX) as String
ToggleButtons(MaxIndex + 1, 1)
End Sub
Sub FillupTextFields()
Dim a as Integer
Dim CurIndex as Integer
For a = 1 To SBTBCOUNT
CurIndex = (a-1) + ScrollBarValue
DlgUserFields.GetControl(&quot;Label&quot; &amp; a).Model.Label = UserFieldDataType(CurIndex,0)
DlgUserFields.GetControl(&quot;TextField&quot; &amp; a).Model.Text = UserFieldFamily(CurFieldIndex, CurIndex)
Next a
End Sub
Sub StepToRecord(aEvent as Object)
Dim iStep as Integer
iStep = CInt(aEvent.Source.Model.Tag)
ScrollTextFieldInfo(ScrollBarValue)
ToggleButtons(CurFieldIndex + iStep)
FillUpTextFields()
End Sub
Sub SelectCurrentFields()
Dim MaxIndex as Integer
Dim i as Integer
ScrollTextFieldInfo(ScrollBarValue)
MaxIndex = Ubound(UserFieldFamily(),2)
For i = 0 To MaxIndex
oUserDataAccess.ReplaceByName(UserFieldDataType(i,1), UserFieldFamily(CurFieldIndex, i))
Next i
oUserDataAccess.commitChanges()
End Sub
Sub DeleteCurrentSettings()
Dim n as Integer
Dim m as Integer
Dim MaxIndex as Integer
MaxIndex = Ubound(UserFieldFamily(),1)
If CurFieldIndex &lt; MaxIndex Then
For n = CurFieldIndex To MaxIndex - 1
For m = 0 To SBMAXFIELDINDEX
UserFieldFamily(n,m) = UserFieldFamily(n + 1,m)
Next m
Next n
Else
CurFieldIndex = MaxIndex - 1
End If
ReDim Preserve UserFieldFamily(MaxIndex-1, SBMAXfIELDINDEX) as String
FillupTextFields()
ToggleButtons(CurFieldIndex)
End Sub</script:module>

6
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/dialog.xlb Normal file
View File

@@ -0,0 +1,6 @@
<?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="Gimmicks" library:readonly="false" library:passwordprotected="false">
<library:element library:name="UserfieldDlg"/>
<library:element library:name="ReadFolderDlg"/>
</library:library>

9
tool-tech-file-view/LibreOfficePortable/App/libreoffice/share/basic/Gimmicks/script.xlb Normal file
View File

@@ -0,0 +1,9 @@
<?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="Gimmicks" library:readonly="false" library:passwordprotected="false">
<library:element library:name="GetTexts"/>
<library:element library:name="Userfields"/>
<library:element library:name="ChangeAllChars"/>
<library:element library:name="AutoText"/>
<library:element library:name="ReadDir"/>
</library:library>