Quelle  FilesModul.xba   Sprache: unbekannt

<?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="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


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
Dim bInterruptSearch as Boolean
 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 (FieldInList(NewList(n,1), XMLTemplateList())) Then
       CurFileContent = GetRealFileContent(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


Function SetExtension(LocExtension) as String
 if (Instr(LocExtension, "vnd.sun.xml.impress")) > 0 then
  SetExtension() = "vor|sti|std"
 elseif (Instr(LocExtension, "vnd.sun.xml.writer")) > 0 then
  SetExtension() = "vor|stw" 
 elseif (Instr(LocExtension, "vnd.sun.xml.calc")) > 0 then
  SetExtension() = "vor|stc"
 elseif (Instr(LocExtension, "vnd.sun.xml.draw")) > 0 then
  SetExtension() = "vor|std|sti" 
 endif
End Function

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 Instr(LocExtension, "vnd.sun.xml.") = 1 Then
  LocExtension = SetExtension(LocExtension)
  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
  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 multidimensional 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 "odt", "ods", "odp", "odg", "odm", "odf" 
     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)
     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", "docx", "docm", "xls", "xlsx", "xlsm", "ppt", "pps", "pptx", "pptm", "ppsx", "ppsm", "pub", "sxi", "sxw", "sxd", "sxg", "sxm", "sxc"
                        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
 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
 If Not bLogExists Then
        Exit Sub
    End If 
 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)
 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
 oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
 oTextCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor()
 oTextCursor.SetString(sSourceDocuments) 
 oTextCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor()
 oTextCursor.SetString(sTargetDocuments)
 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())
  SOWorkPath = RTrimStr(SOWorkPath,"/")
  sLogUrl = SOWorkPath & "/Logfile.odt"
  Do
   bLogIsThere = oUcb.Exists(sLogUrl)
   If bLogIsThere Then
    If i = 2 Then
     sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.odt", "/Logfile.odt")
    Else
     sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".odt", "/Logfile_" & cStr(i-1) & ".odt")
    End If
    i = i + 1
   End If
  Loop Until Not bLogIsThere
  bLogExists = True
  oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
 End If
End Sub


Sub InsertTargetUrlToLogDocument(sTargetUrl as String, sComment as String)
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)
   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)
            If oBasicLibraries.isLibraryLoaded(LibName) Then
       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
   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()

 bShowLogFile = True
 ImportDialogArea.endexecute()
 
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>