PC World 2004 May/PCWorld_2004-05_cd.bin/akce/openoffice/f_0071/FilesModul.xba

Extensible Markup Language | 2004-01-27 | 29KB | 805 lines

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FilesModul" script:language="StarBasic">Option Explicit

Public AbsTemplateFound as Integer
Public AbsDocuFound as Integer
Public oLogDocument as Object
Public oLogTable as Object
Public bLogExists as Boolean
Public sComment as String
Public MaxCollectIndex as Integer
Public bInsertRow as Boolean
Public sLogUrl as String
Public sCurPassWord as String
Public FileCount as Integer
Public XMLTemplateCount as Integer
Public PathCollection(7,3) as String
Public bIsFirstLogTable as Boolean
Public bFilterTracerIsinsideTable as Boolean


Function ReadCollectionPaths(FilesList() as String, sFilterName() as String)
Dim FilterIndex as Integer
Dim bRecursive as Boolean
Dim SearchDir as String
Dim i as Integer
Dim n as Integer
Dim a as Integer
Dim s as Integer
Dim t as Integer
Dim sFileContent() as String
Dim NewList(0,1) as String
Dim Index as Integer
Dim CurFileName as String
Dim CurExtension as String
Dim CurFileContent as String
Dim XMLTemplateContentList() as String
Dim bIsTemplatePath as Boolean
Dim MaxIndex as Integer
Dim NewContentList() as String
Dim XMLTemplateContentString as String
Dim ApplIndex as Integer
Dim bAssignFileName as Boolean
    oDocInfo = CreateUnoService("com.sun.star.document.DocumentProperties")
    bInterruptSearch = False
    For i = 0 To MaxCollectIndex
        SearchDir = PathCollection(i,0)
        bRecursive = PathCollection(i,1)
        sFileContent() = ArrayoutofString(PathCollection(i,2), "|")
        NewList() = ReadDirectories(SearchDir, bRecursive, False, False, sFileContent(), "")
        If InterruptProcess Then
            ReadCollectionPaths() = False
            Exit Function
        End If
        If Ubound(NewList()) > -1 Then
            bIsTemplatePath = FieldInList("vor", sFileContent)
            If bIsTemplatePath Then
                XMLTemplateContentString = PathCollection(i,3)
                XMLTemplateContentList() = ArrayoutofString(XMLTemplateContentString, "|")
                If Ubound(XMLTemplateContentList()) > -1 Then
                    MaxIndex = Ubound(NewList())
                    ReDim Preserve NewList(MaxIndex, 1) as String
                    ReDim Preserve NewContentList(MaxIndex) as String
                    a = -1
                    For n = 0 To MaxIndex
                        bAssignFileName = True
                        If InterruptProcess() Then
                            ReadCollectionPaths() = False
                            Exit Function
                        End If
                        CurFileContent = ""
                        CurFileName = NewList(n,0)
                        If NewList(n,1) = "vor" Then
                            CurFileContent = GetRealFileContent(oDocInfo, CurFileName)
                            t = SearchArrayforPartString(CurFileContent, XMLTemplateContentList())
                             bAssignFileName = (t > -1)
                             If bAssignFileName Then
                                 CurFileContent = XMLTemplateContentList(t)
                             End If
                            NewList(n,1) = CurFileContent
                        End If
                        CurExtension = NewList(n,1)
                        If bAssignFileName Then
                            If a < n Then
                                a = a + 1
                                NewList(a,0) = CurFileName
                                NewList(a,1) = CurExtension
                                If CurFileContent = "" Then
                                    CurFileContent = CurExtension
                                End If
                                ApplIndex = GetApplicationIndex(CurFileContent, sFiltername())
                                NewContentList(a) = ApplIndex
                            End If
                        End If
                    Next n
                    If a < MaxIndex And a > -1 Then
                        ReDim Preserve NewList(a, 1) as String
                    End If
                    If a > -1 Then
                        AddListtoFilesList(FilesList(), NewList(), NewContentList())
                    End If
                End If
            Else
                MaxIndex = Ubound(NewList())
                ReDim Preserve NewContentList(MaxIndex) as String
                For s = 0 To MaxIndex
                    CurExtension = NewList(s,1)
                    NewContentList(s) = GetApplicationIndex(CurExtension, sFiltername())
                Next s
                AddListtoFilesList(FilesList(), NewList(), NewContentList())
            End If
        End If
    Next i
    ReadCollectionPaths() = Ubound(FilesList()) > -1
End Function


Function GetApplicationIndex(CurFileContent as String, sFilterName() as String) as Integer
Dim Index as Integer
Dim i as Integer
    Index = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
    If Index >= MaxApplCount Then
        Index = Index - MaxApplCount
    End If
    For i = 0 To MaxApplCount - 1
        If Applications(i, SBAPPLKEY) = Index Then
            GetApplicationIndex() = i
            Exit Function
        End If
    Next i
    GetApplicationIndex() = - 1
End Function


Function InterruptProcess() as Boolean
    If bCancelTask Or RetValue = 0 Then
        bConversionIsRunning = False
        InterruptProcess() = True
        Exit Function
    End if
    InterruptProcess() = False
End Function


Sub AddCollectionPath(ApplIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
    MaxCollectIndex = MaxCollectIndex + 1
    PathCollection(MaxCollectIndex, 0) = Applications(ApplIndex, DocIndex)
    PathCollection(MaxCollectIndex, 1) = Applications(ApplIndex, RecursiveIndex)
    AddFilterNameToPathItem(ApplIndex, MaxCollectIndex, sFiltername(), DistIndex)
End Sub


Sub AddFilterNameToPathItem(ApplIndex as Integer, CollectIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim iKey as Integer
Dim CurListString as String
Dim LocExtension as String
Dim LocContentString as String
Dim LocXMLTemplateContent as String
    iKey = Applications(ApplIndex, SBAPPLKEY)
    CurListString = PathCollection(CollectIndex, 2)
    LocExtension = sFilterName(iKey +DistIndex, 0)
    If Len(LocExtension) > SBMAXEXTENSIONLENGTH Then             ' 7 == Length of two extensions like 'sda|sdd
        LocExtension = "vor"
        LocContentString = sFilterName(iKey +DistIndex, 0)
        LocContentString = ReplaceString(LocContentString, "|", ";")
        LocXMLTemplateContent = PathCollection(CollectIndex, 3)
        If LocXMLTemplateContent = "" Then
            LocXMLTemplateContent = LocContentString
        Else
            LocXMLTemplateContent = LocXMLTemplateContent & "|" & LocContentString
        End If
        PathCollection(CollectIndex, 3) = LocXMLTemplateContent
    End If
    If CurListString = "" Then
        PathCollection(CollectIndex, 2) = LocExtension
    Else
        If Instr(CurListString, LocExtension) = 0 Then
            PathCollection(CollectIndex, 2) = CurListString & "|" & LocExtension
        End If
    End If
End Sub


Sub CheckIfToAddPathToCollection(ApplIndex as Integer, bDoConvertIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim CollectIndex as Integer
Dim bCheckDocuType as Boolean
    bCheckDocuType = Applications(ApplIndex, bDoConvertIndex)
    If bCheckDocuType Then
        CollectIndex = GetIndexInMultiArray(PathCollection(), Applications(ApplIndex,DocIndex), 0)
        If (CollectIndex >-1) Then
            If Applications(ApplIndex, RecursiveIndex) <> PathCollection(CollectIndex, 1) Then
                AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
            Else
                AddFilterNameToPathItem(ApplIndex, CollectIndex, sFilterName(), DistIndex)
            End If
        Else
            AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
        End If
    End If
End Sub


Sub CollectPaths(sFiltername() as String)
Dim i as Integer
Dim    XMLTemplateContentString as String
    MaxCollectIndex = -1
    For i = 0 To ApplCount-1
        CheckIfToAddPathToCollection(i, SBDOCCONVERT, SBDOCSOURCE, SBDOCRECURSIVE, sFilterName(), 0)
    Next i
    XMLTemplateCount = 0
    XMLTemplateContentString = ""
    For i = 0 To ApplCount-1
        If WizardMode = SBXMLMODE Then
            XMLTemplateCount = XMLTemplateCount + 1
        End If
        CheckIfToAddPathToCollection(i, SBTEMPLCONVERT, SBTEMPLSOURCE, SBTEMPLRECURSIVE, sFilterName(), MaxApplCount)
    Next i
End Sub


Sub ConvertAllDocuments(sFilterName() as String)
Dim FileProperties(1) as new com.sun.star.beans.PropertyValue
Dim PWFileProperties(2) as New com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
Dim OpenProperties(4) as new com.sun.star.beans.PropertyValue
Dim    oInteractionHandler as Object
Dim InteractionTypes(0) as Long
Dim FilesList(0,2) as String
Dim sViewPath as String
Dim i as Integer
Dim FilterIndex as Integer
Dim sSourceUrl as String
Dim CurFilename as String
Dim oDocument as Object
Dim sExtension as String
Dim OldExtension as String
Dim CurFound as Integer
Dim TotFound as Integer
Dim TargetStemDir as String
Dim SourceStemDir as String
Dim TargetDir as String
Dim sTargetUrl as String
Dim CurFilterName as String
Dim ApplIndex as Integer
Dim Index as Integer
Dim bIsDocument as Boolean
Dim bDoSave as Boolean
Dim sCurFileExists as String
Dim MaxFileIndex as Integer
Dim bContainsBasicMacro as Boolean
Dim bIsPassWordProtected as Boolean
Dim iOverwrite as Integer
Dim sMimeTypeorExtension as String
Dim sPrevMimeTypeorExtension as String
    bConversionisrunning = True
    InteractionTypes(0) = com.sun.star.task.PasswordRequestMode.PASSWORD_REENTER
    oInteractionHandler = createUnoService("com.sun.star.task.InteractionHandler")
    oInteractionHandler.initialize(InteractionTypes())
    iGeneralOverwrite = SBOVERWRITEUNDEFINED
    bConversionIsRunning = True
    bLogExists = false
    AbsTemplateFound = 0
    AbsDocuFound = 0
    CollectPaths(sFiltername())
    If Not ReadCollectionPaths(FilesList(), sFilterName()) Then
        TotFound = 0
        SetProgressDisplay(0)
        bConversionisrunning = false
        FinalizeDialogButtons()
        Exit Sub
    End If
    TotFound = Ubound(FilesList()) + 1
    If FilesList(0,0) = "" Then                    ' Querying the number of fields in a multidimensionl Array is unsecure
        TotFound = 0                            ' because it will return the value 0 (and not -1) even when the Array is empty
        SetProgressDisplay(0)
    End If
    BubbleSortList(FilesList(), true)
    If TotFound > 0 Then
        CreateLogDocument(OpenProperties())
        InitializeProgressPage(ImportDialog)
        OpenProperties(0).Name = "Hidden"
        OpenProperties(0).Value = True
        OpenProperties(1).Name = "AsTemplate"
        OpenProperties(1).Value = False
        OpenProperties(2).Name = "MacroExecutionMode"
        OpenProperties(2).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE
        OpenProperties(3).Name = "UpdateDocMode"
        OpenProperties(3).Value = com.sun.star.document.UpdateDocMode.NO_UPDATE
        OpenProperties(4).Name = "InteractionHandler"
        OpenProperties(4).Value = oInteractionHandler
        MaxFileIndex = Ubound(FilesList(),1)
        FileCount = 0
        For i = 0 To MaxFileIndex
            sComment = ""
            If InterruptProcess() Then
                Exit For
            End If
            bDoSave = True
            sSourceUrl = FilesList(i,0)
            sPrevMimeTypeorExtension = sMimeTypeorExtension
            sMimeTypeorExtension = FilesList(i,1)
            CurFiltername =    GetFilterName(sMimeTypeorExtension, sFilterName(), sExtension, FilterIndex)
            ApplIndex = FilesList(i,2)
            If sMimeTypeorExtension <> sPrevMimeTypeorExtension Then
                CreateLogTable(ApplIndex, sMimeTypeOrExtension, sFiltername()
            End If
            If ApplIndex > Ubound(Applications) or (ApplIndex < 0) Then
                Msgbox "Applicationindex out of bounds:" & sSourcUrl
            End If
            sViewPath = ConvertFromUrl(sSourceUrl)     ' CutPathView(sSourceUrl, 70)
            ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & "  (" & sViewPath & ")"
            Select Case lcase(sExtension)
                Case "sxw", "sxc", "sxi", "sxd", "sxs", "sxm"
                    SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), "/")
                    TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), "/")
                Case Else                                 ' Templates and Helper-Applications remain
                    SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), "/")
                    TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), "/")
            End Select
            sTargetUrl = ReplaceString(sSourceUrl, TargetStemDir, SourceStemDir)
            CurFilename = GetFileNameWithoutExtension(sTargetUrl, "/")
            OldExtension = GetFileNameExtension(sTargetUrl)
            sTargetUrl = RTrimStr(sTargetUrl, OldExtension)
            sTargetUrl = sTargetUrl & sExtension
            TargetDir = RTrimStr(sTargetUrl, CurFilename & "." & sExtension)
            If (oUcb.Exists(sTargetUrl)) Then
                If (iGeneralOverwrite <> SBOVERWRITEALWAYS) Then
                    If (iGeneralOverwrite = SBOVERWRITEUNDEFINED) Then
                        ShowOverwriteAllDialog(sTargetUrl, sTitle)
                        bDoSave = (iGeneralOverwrite = SBOVERWRITEQUERY) Or (iGeneralOverwrite = SBOVERWRITEALWAYS)
                    Elseif iGeneralOverwrite = SBOVERWRITENEVER Then
                        bDoSave = False
                    ElseIf ((iGeneralOverWrite = SBOVERWRITEQUERY) OR (iGeneralOverwrite = SBOVERWRITECANCEL)) Then
                        ' Todo: According to AS there might come a new feature that storeasUrl could possibly rise a UI dialog.
                        ' In this case my own UI becomes obsolete
                        sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(sTargetUrl), "<1>")
                        sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>")
                        iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle)
                        Select Case iOverWrite
                            Case 1    ' OK
                                ' In the FileProperty-Bean this is already default
                                bDoSave = True
                            Case 2     ' Abort
                                CancelTask(False)
                                bDoSave = False
                            Case 7     ' No
                                bDoSave = False
                        End Select
                    End If
                End If
            End If
            If bDoSave Then
                If Not oUcb.Exists(TargetDir) Then
                    bDoSave = CreateFolder(TargetDir)
                End If
                If bDoSave Then
                    oDocument = StarDesktop.LoadComponentFromURL(sSourceUrl, "_default", 0, OpenProperties())
                    If Not IsNull(oDocument) Then
                        InsertSourceUrlToLogDocument(sSourceUrl, "")
                        bIsPassWordProtected = CheckPassWordProtection(oDocument)
                        CheckIfMacroExists(oDocument.BasicLibraries, sComment)
                        On Local Error Goto NOSAVING
                        If bIsPassWordProtected Then
                            PWFileProperties(0).Name = "FilterName"
                            PWFileProperties(0).Value = CurFilterName
                            PWFileProperties(1).Name = "Overwrite"
                            PWFileProperties(1).Value = True
                            PWFileProperties(2).Name = "Password"
                            PWFileProperties(2).Value = sCurPassWord
                            oDocument.StoreAsUrl(sTargetUrl, PWFileProperties())
                        Else
                            FileProperties(0).Name = "FilterName"
                            FileProperties(0).Value = CurFilterName
                            FileProperties(1).Name = "Overwrite"
                            FileProperties(1).Value = True
                            oDocument.StoreAsUrl(sTargetUrl,FileProperties())
                        End If
                        ' Todo: Make sure that an errorbox pops up when saving fails
                        NOSAVING:
                        If Err <> 0 Then
                            sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(sTargetUrl), "<1>")
                            sComment = ConcatComment(sComment, sCurCouldnotsaveDocument)
                            Resume LETSGO
                            LETSGO:
                        Else
                            FileCount = FileCount + 1
                        End If
                        oDocument.Dispose()
                        InsertTargetUrlToLogDocument(sTargetUrl, sComment, ApplIndex)
                    Else
                        sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sSourceUrl), "<1>")
                        sComment = ConcatComment(sComment, sCurCouldnotopenDocument)
                        InsertSourceUrlToLogDocument(sSourceUrl, sComment)
                    End If
                End If
            End If
        Next i
    End If
    AddLogStatistics()
    FinalizeDialogButtons()
    bConversionIsRunning = False
    Exit Sub
RTError:
    Msgbox sRTErrorDesc, 16, sRTErrorHeader
End Sub



Sub AddListtoFilesList(FirstList(), SecList(), NewContentList() as String)
Dim sLocExtension as String
Dim FirstStart as Integer
Dim FirstEnd as Integer
Dim i as Integer
Dim s as Integer
    If FirstList(0,0) = "" Then
        FirstStart = Ubound(FirstList(),1)
    Else
        FirstStart = Ubound(FirstList(),1) + 1
    End If
    FirstEnd = FirstStart + Ubound(SecList(),1)
    ReDim Preserve FirstList(FirstEnd,2)
    s = 0
    For i = FirstStart To FirstEnd
        FirstList(i,0) = SecList(s,0)
        FirstList(i,1) = SecList(s,1)
        sLocExtension = lcase(FirstList(i,1))
        Select Case sLocExtension
            Case "sdw", "sdc", "sda", "sdd", "smf", "sgl", "doc", "xls", "ppt"
                AbsDocuFound = AbsDocuFound + 1
            Case else
                AbsTemplateFound = AbsTemplateFound + 1
        End Select
        FirstList(i,2) = CStr(NewContentList(s))
        s = s + 1
    Next i
    SetProgressDisplay(Ubound(FirstList()) + 1)
End Sub



Function GetTargetTemplatePath(Index as Integer)
    Select Case WizardMode
        Case SBMICROSOFTMODE
            GetTargetTemplatePath() = SOTemplatePath & "/" & sTemplateGroupName
        Case SBXMLMODE
            If Index = 3 Then
                ' Helper Application
                GetTargetTemplatePath = SOWorkPath
            Else
                GetTargetTemplatePath = SOTemplatePath
            End If
    End Select
End Function


' Retrieves the second value for a next to 'SearchString' in
' a two-dimensional string-Array
Function GetFilterName(sMimetypeorExtension as String, sFilterName(), sExtension as string, FilterIndex as Integer) as String
Dim i as Integer
Dim MaxIndex as Integer
Dim sLocFilterlist() as String
    For i = 0 To Ubound(sFiltername(),1)
        If Instr(1,sFilterName(i,0),sMimeTypeOrExtension) <> 0 Then
            sLocFilterList() = ArrayoutofString(sFiltername(i,0),"|", MaxIndex)
            If MaxIndex = 0 Then
                sExtension = sFiltername(i,2)
                GetFilterName = sFilterName(i,1)
            Else
                Dim b as Integer
                Dim sLocExtensionList() as String
                b =    SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
                sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex)
                GetFilterName = sLocFilterList(b)
                sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex)
                sExtension = sLocExtensionList(b)
            End If
            Exit For
        End If
    Next
    FilterIndex = i
End Function


Function SearchArrayforPartString(SearchString as String, LocList()) as Integer
Dim i as Integer
Dim a as Integer
Dim StringList() as String
    For i = Lbound(LocList(),1) to Ubound(LocList(),1)
        StringList() = ArrayoutofString(LocList(i), "|")
        For a = 0 To Ubound(StringList())
            If (Instr(1, SearchString, StringList(a)) <> 0) Then
                SearchArrayForPartString() = i
                Exit Function
            End If
        Next a
    Next i
    SearchArrayForPartString() = -1
End Function


Sub CreateLogTable(ApplIndex as Integer, CurFileContent as String, sFilterName() as String)
Dim oLogCursor as Object
Dim oLogRows as Object
Dim FilterIndex as Integer
Dim sDocumentType as String
Dim oTextCursor
Dim oCell
    bFilterTracerIsinsideTable = False
    FilterIndex = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
    sDocumentType = sFiltername(FilterIndex,3)
    oLogCursor = oLogDocument.Text.createTextCursor()
    oLogCursor.GotoEnd(False)
    If Not bIsFirstLogTable Then
        oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
    Else
        bisFirstLogTable = False
    End If
    oLogCursor.HyperLinkURL = ""
    oLogCursor.HyperLinkName = ""
    oLogCursor.HyperLinkTarget = ""
    oLogCursor.ParaStyleName = "Heading 1"
    oLogCursor.setString(sDocumentType)
    If WizardMode = SBMICROSOFTMODE Then
        If bFilterTracingAvailable Then
            If bMSApplFilterTracingAvailable(ApplIndex) Then
                Dim CurFilterTracingPath as String
                CurFilterTracingPath = FilterTracingLogPath(ApplIndex)
                bFilterTracerIsinsideTable = (bTakeOverTargetName(ApplIndex) Or bTakeOverPathName(ApplIndex))
                If Not bFilterTracerIsinsideTable Then
                    oLogCursor.CollapseToEnd()
                    oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
                    InsertCommandButtonatViewCursor(oLogDocument, oLogCursor, CurFilterTracingPath)
                End If
            End If
        End If
    End If
    oLogCursor.CollapsetoEnd()
    oLogDocument.Text.insertControlCharacter(oLogCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
    oLogTable =  oLogDocument.CreateInstance("com.sun.star.text.TextTable")
    oLogTable.RepeatHeadline = true
    If bFilterTracerIsinsideTable Then
        oLogTable.initialize(2,3)
    End If
    oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
    oTextCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor()
    oTextCursor.SetString(sSourceDocuments)
    oTextCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor()
    oTextCursor.SetString(sTargetDocuments)
    If bFilterTracerIsinsideTable Then
        oTextCursor = oLogTable.GetCellbyPosition(2,0).createTextCursor()
        oTextCursor.SetString("FilterTracer")
    End If
    bInsertRow = False
End Sub


Function GetSize(iWidth, iHeight) As New com.sun.star.awt.Size
Dim aSize As New com.sun.star.awt.Size
    aSize.Width = iWidth
    aSize.Height = iHeight
    GetSize() = aSize
End Function


Sub InsertCommandButtonatViewCursor(oLocDocument, oLocCursor, TargetUrl as String, Optional aSize)
Dim oDocument
Dim oController
Dim oCommandButton
Dim oShape
Dim oDrawPage
Dim oCommandControl
Dim oEvent
Dim oCell
    oCommandButton = oLocDocument.createInstance("com.sun.star.form.component.CommandButton")
    oShape = oLocDocument.CreateInstance ("com.sun.star.drawing.ControlShape")
    If IsMissing(aSize) Then
        oShape.Size = GetSize(4000, 600)
    End If
    oCommandButton.Label = FileNameoutofPath(Targeturl)
    oCommandButton.TargetFrame = "_default"
    oCommandButton.ButtonType = com.sun.star.form.FormButtonType.URL
    oCommandbutton.DispatchUrlInternal = True
    oCommandButton.TargetURL = ConverttoUrl(TargetUrl)
    oShape.Control = oCommandbutton
    oLocCursor.Text.InsertTextContent(oLocCursor, oShape, True)
End Sub



Sub CreateLogDocument(HiddenProperties())
Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue
Dim NoArgs()
Dim i as Integer
Dim bLogIsThere as Boolean
    If ImportDialog.chkLogfile.State = 1 Then
        i = 2
        OpenProperties(0).Name = "Hidden"
        OpenProperties(0).Value = True
        oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_default", 4, OpenProperties())
        sLogUrl = SOWorkPath & "/Logfile.sxw"
        Do
            bLogIsThere = oUcb.Exists(sLogUrl)
            If bLogIsThere Then
                If i = 2 Then
                    sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.sxw", "/Logfile.sxw")
                Else
                    sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".sxw", "/Logfile_" & cStr(i-1) & ".sxw")
                End If
                i = i + 1
            End If
        Loop Until Not bLogIsThere
        bLogExists = True
        oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
    End If
End Sub


Function GetFilterTracingLogPath(sTargetUrl as String, ApplIndex) as String
Dim TargetFileName as String
Dim sTargetFolder as String
Dim CurFilterTracingPath as String
Dim CurFilterTracingname as String
Dim CurFilterFolder as String
        CurFilterTracingPath = FilterTracingLogPath(ApplIndex)
        If bTakeOverTargetName(ApplIndex) Then
            TargetFilename = GetFileNameWithoutextension(sTargetUrl, "/")
            CurFilterFolder = DirectoryNameoutofPath(FilterTracingLogPath(ApplIndex), "/")
            CurFilterTracingpath = CurFilterFolder & "/" & TargetFilename & ".log"
        End If
        If bTakeOverPathName(ApplIndex) Then  'Replace the Folder in the FilterTracerpath by the Folder of the targetUrl
            sTargetFolder = DirectoryNameoutofPath(sTargetUrl,"/")
            CurFilterTracingPath = sTargetFolder & "/" & FileNameoutofPath(CurFilterTracingPath, "/")
        End If
        GetFilterTracingLogPath() = CurFilterTracingPath
End Function


Sub InsertTargetUrlToLogDocument(sTargetUrl as String, sComment as String, ApplIndex as Integer)
Dim oCell
Dim oTextCursor
Dim CurFilterTracingpath as String
    If (bLogExists) And (sTargetUrl <> "") Then
        If sTargetUrl <> "" Then
            oCell = oLogTable.GetCellbyPosition(1,oLogTable.Rows.Count-1)
            InsertCommentToLogCell(sComment, oCell)
            InsertHyperLinkToLogCell(sTargetUrl, oCell)
            If bFilterTracerIsinsideTable Then
                oCell = oLogTable.getCellByPosition(2, oLogTable.Rows.Count-1)
                oTextCursor = oCell.Text.CreateTextCursor()
                CurFilterTracingpath = GetFilterTracingLogPath(sTargetUrl, ApplIndex)
                InsertCommandButtonatViewCursor(oLogDocument, oTextCursor, CurFilterTracingPath)
            End If
            oLogDocument.Store()
        End If
    End If
End Sub


Sub InsertSourceUrlToLogDocument(SourceUrl as String, sComment)        '
Dim oCell as Object
    If bLogExists Then
        If bInsertRow Then
            oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
        Else
            bInsertRow = True
        End If
        oCell = oLogTable.GetCellbyPosition(0,oLogTable.Rows.Count-1)
        InsertCommentToLogCell(sComment, oCell)
        InsertHyperLinkToLogCell(SourceUrl, oCell)
        oLogDocument.Store()
    End If
End Sub


Sub InsertHyperLinkToLogCell(sUrl as String, oCell as Object)
Dim oLogCursor as Object
Dim LocFileName as String
    oLogCursor = oCell.createTextCursor()
    oLogCursor.CollapseToStart()
    oLogCursor.HyperLinkURL = sUrl
    oLogCursor.HyperLinkName = sUrl
    oLogCursor.HyperLinkTarget = sUrl
    LocFileName = FileNameOutOfPath(sUrl)
    oCell.InsertString(oLogCursor, LocFileName,False)
End Sub


Sub InsertCommentToLogCell(sComment as string, oCell as Object)
Dim oCommentCursor as Object
    If sComment <> "" Then
        oCommentCursor = oCell.createTextCursor()
        oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
        oCell.insertString(oCommentCursor, sComment, false)
    End If
End Sub


Sub AddLogStatistics()
Dim oCell as Object
Dim oLogCursor as Object
Dim MaxRowIndex as Integer
    If bLogExists Then
        MaxRowIndex = oLogTable.Rows.Count
        sLogSummary = ReplaceString(sLogSummary, FileCount, "<COUNT>")
'        oLogTable.Rows.InsertByIndex(MaxRowIndex, 1)
'        oCell = oLogTable.GetCellbyPosition(0, MaxRowIndex)
'        oLogCursor = oCell.createTextCursor()
'        oCell.InsertString(oLogCursor, sLogSummary,False)
'        MergeRange(oLogTable, oCell, 1)

        oLogCursor = oLogDocument.Text.CreateTextCursor
        oLogCursor.gotoEnd(False)
        oLogCursor.HyperLinkURL = ""
        oLogCursor.HyperLinkName = ""
        oLogCursor.HyperLinkTarget = ""
        oLogCursor.SetString(sLogSummary)
        oLogDocument.Store()
        oLogDocument.Dispose()
        bLogExists = False
    End If
End Sub



Function CheckIfMacroExists(oBasicLibraries as Object, sComment as String) as Boolean
Dim ModuleNames() as String
Dim ModuleName as String
Dim MaxLibIndex as Integer
Dim MaxModuleIndex as Integer
Dim bMacroExists as Boolean
Dim n as Integer
Dim m as Integer
Dim LibName as String
Dim sBasicCode as String
Dim oLibrary as Object
    bMacroExists = False
    bMacroExists = oBasicLibraries.hasElements
    If bMacroExists Then
        MaxLibIndex = Ubound(oBasicLibraries.ElementNames())
        For n = 0 To MaxLibIndex
            LibName = oBasicLibraries.ElementNames(n)
            oLibrary = oBasicLibraries.getbyName(LibName)
            If oLibrary.hasElements() Then
                MaxModuleIndex = Ubound(oLibrary.ElementNames())
                For m = 0 To MaxModuleIndex
                    ModuleName = oLibrary.ElementNames(m)
                    sBasicCode = oLibrary.getbyName(ModuleName)
                    If sBasicCode <> "" Then
                        ConcatComment(sComment, sReeditMacro)
                        CheckIfMacroExists() = True
                        Exit Function
                    End If
                Next m
            End If
        Next n
    End If
    CheckIfMacroExists() = False
End Function



Function CheckPassWordProtection(oDocument as Object)
Dim bIsPassWordProtected as Boolean
Dim i as Integer
Dim oArgs()
Dim MaxIndex as Integer
Dim sblabla as String
    bIsPassWordProtected = false
     oArgs() = oDocument.getArgs()
     MaxIndex = Ubound(oArgs())
    For i = 0 To MaxIndex
        sblabla = oArgs(i).Name
        If oArgs(i).Name = "Password" Then
            bIsPassWordProtected = True
            sCurPassWord = oArgs(i).Value
            Exit For
        End If
    Next i
    CheckPassWordProtection() = bIsPassWordProtected
End Function


Sub OpenLogDocument()
Dim NoArgs() as New com.sun.star.beans.PropertyValue
    OpenDocument(sLogUrl, NoArgs())
End Sub


Sub MergeRange(oTable as Object, oCell as Object, MergeCount as Integer)
Dim oTableCursor as Object
    oTableCursor = oTable.createCursorByCellName(oCell.CellName)
    oTableCursor.goRight(MergeCount, True)
    oTableCursor.mergeRange()
End Sub


Function ConcatComment(sComment as String, AdditionalComment as String)
    If sComment = "" Then
        sComment = AdditionalComment
    Else
        sComment = sComment & chr(13) + AdditionalComment
    End If
    ConcatComment = sComment
End Function
</script:module>