Kompuutteri Kaikille K-CD 2002 #3/K-CD_2002-03.iso/OpenOffice/f_0243/FilesModul.xba

Extensible Markup Language | 2001-10-17 | 14KB | 382 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 bInsertRow as Boolean

Function ReadApplicationDirectories(ApplIndex as Integer, FilesList(),bIsDocument as Boolean, sFiltername()) as Integer
Dim bCheckDocuType as Boolean
Dim FilterIndex as Integer
Dim bRecursive as Boolean
Dim sSourceDir as String
Dim bCheckRealType as Boolean
Dim a as Integer
Dim sFileContent() as String
Dim NewList() as String
Dim Index as Integer
Dim sLocExtension as String
    Index = Applications(ApplIndex,SBAPPLKEY)
    sLocExtension = ""
    If bIsDocument Then
        bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT)
        bCheckRealType = False
        bRecursive = Applications(ApplIndex,SBDOCRECURSIVE)
        FilterIndex = Index
        sSourceDir = Applications(ApplIndex,SBDOCSOURCE)
    Else
        ' Templates
        bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT)
        ' In SO the documenttype cannot be derived from the extension name
        bCheckRealType = WizardMode = SBXMLMODE
        If bCheckRealType Then
            ' Note: StarOffice-Math-Documents cannot be treated like templates
            bCheckRealType = Index <> 3
            If bCheckRealType Then
                sLocExtension = "vor"
            End If
            bIsDocument = Not bCheckRealType
        End If
        bRecursive = Applications(ApplIndex,SBTEMPLRECURSIVE)
        FilterIndex = Index + MaxApplCount
        sSourceDir = Applications(ApplIndex,SBTEMPLSOURCE)
    End If
    If bCheckDocuType Then
        sFileContent() = GetMimeTypeList(sFilterName(FilterIndex))
        NewList() = ReadDirectories(sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension)
        If Ubound(NewList()) > -1 Then
            AddListtoFilesList(FilesList(), NewList(), ApplIndex)
            ImportDialog.LabelRetrieval.Label = sProgressPage_2 &  "  " & ReplaceString(sProgressPage_5, Str(Ubound(FilesList()) + 1) & " ", "%1")
        End If
    End If
    ReadApplicationDirectories() = Ubound(NewList(),1) + 1
End Function


Sub    ShowCurrentProgress(bIsDocument as Boolean, CurFound as Integer)
    If bIsDocument Then
        AbsDocuFound = AbsDocuFound + CurFound
        ImportDialog.LabelCurDocumentRetrieval.Label =  sProgressFound & " " & CStr(AbsDocuFound) &  " " & sProgressMoreDocs
    Else
        AbsTemplateFound = AbsTemplateFound + CurFound
        ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound & " " & CStr(AbsTemplateFound) & " " & sProgressMoreTemplates
  End If
End Sub


Sub ConvertAllDocuments(sFilterName())
Dim FileProperties(0) as new com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
Dim OpenProperties(1) as new com.sun.star.beans.PropertyValue
Dim FilesList(0,2) as String
Dim sViewPath as String
Dim i as Integer
Dim FilterIndex as Integer
Dim sFullName as String
Dim sFileName 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 TargetFile as String
Dim CurFilterName as String
Dim ApplIndex as Integer
Dim Index as Integer
Dim bIsDocument as Boolean
Dim iOverWrite as Integer
Dim bDoSave as Boolean
Dim sCurFileExists as String
Dim oTaskEnum as Object
Dim oTask as Object
Dim oModel as Object
Dim oTaskController as Object
Dim MaxFileIndex as Integer
Dim sOldExtension as String
    bConversionIsRunnig = True
    AbsTemplateFound = 0
    AbsDocuFound = 0
    For i = 0 To ApplCount-1
        'templates
        bIsDocument = False
        CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
        ShowCurrentProgress(bIsDocument, CurFound)
    Next i
    For i = 0 To ApplCount-1
        'documents
        bIsDocument = True
        CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
        ShowCurrentProgress(bIsDocument, CurFound)
    Next i
    TotFound = AbsTemplateFound + AbsDocuFound
    CreateLogDocument(OpenProperties())
    If TotFound > 0 Then
        InitializeProgressPage(ImportDialog)
        OpenProperties(0).Name = "Hidden"
        OpenProperties(0).Value = True
        OpenProperties(1).Name = "AsTemplate"
        MaxFileIndex = Ubound(FilesList(),1)
        For i = 0 To MaxFileIndex
            If bCancelTask Then
                bConversionIsRunnig = False
                Exit Sub
            End if
            bDoSave = True
            sFullName = FilesList(i,0)
            CurFiltername =    GetFilterName(FilesList(i,1), sFilterName(), sExtension, FilterIndex)
            ApplIndex = FilesList(i,2)
            sViewPath = CutPathView(sFullName, 60)
            ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & "  (" & sViewPath & ")"

            sOldExtension = GetFileNameExtension(sFullName, "/")
            Select Case sOldExtension
                Case "vor", "dot", "xlt", "pot"
                    OpenProperties(1).Value = False
                Case Else
                    OpenProperties(1).Value = True
            End Select
            oDocument = StarDesktop.LoadComponentFromURL(sFullName, "_blank", 0, OpenProperties())
            If bSetFonts Then
                CheckScripts(oDocument, 1)
            End If

            If Not IsNull(oDocument) Then
                Select Case 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

                TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir)
                sFileName = GetFileNameWithoutExtension(TargetFile, "/")
                OldExtension = GetFileNameExtension(TargetFile)

                TargetFile = RTrimStr(TargetFile, OldExtension)
                TargetFile = TargetFile & sExtension
                TargetDir = RTrimStr(TargetFile, sFileName & "." & sExtension)
                If Not oUcb.Exists(TargetDir) Then
                    oUcb.CreateFolder(TargetDir)
                End If
                If oUcb.Exists(TargetFile) Then
                    sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), "<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
                If bDoSave Then
                    InsertDocNamesToLogDocument(sFullName, TargetFile)
                    On Local Error Resume Next
                    FileProperties(0).Name = "FilterName"
                    FileProperties(0).Value = CurFilterName
                    oDocument.StoreAsUrl(TargetFile,FileProperties())
                    oDocument.Dispose()
                    On Local Error Goto 0
                End If
'                oTaskenum = StarDesktop.Tasks.CreateEnumeration
'                While oTaskEnum.HasmoreElements
'                    oTask = oTaskenum.NextElement
'                    If oTask.Name <> "" Then
'                        oTaskController = oTask.Controller
'                        PrintdbgInfo oTaskController
'                        If hasUnoInterfaces(oTaskController,"com.sun.star.frame.XModel") then
'                            oModel = oTaskController.Model
'                            If Ucase(oModel.Url) = Ucase(sFullName) Then
'                                oTask.Close
'                            End If
'                        End If
'                    End If
'                Wend
            End If
        Next i
    End If
    ImportDialog.cbCancel.Label = sCloseButton
    ImportDialog.cbGoOn.Label = sReady
    ImportDialog.cbGoOn.Enabled = True
    bConversionIsRunnig = False
    Exit Sub
RTError:
    Msgbox sRTErrorDesc, 16, sRTErrorHeader
End Sub


Sub AddListtoFilesList(FirstList(), SecList(), ApplIndex as Integer)
Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, 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)
        FirstList(i,2) = CStr(ApplIndex)
        s = s + 1
    Next i
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 a as Integer
                Dim sLocExtensionList() as String
                a =    SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
                sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex)
                GetFilterName = sLocFilterList(a)
                sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex)
                sExtension = sLocExtensionList(a)
            End If
            Exit For
        End If
    Next
    FilterIndex = i
End Function


Function SearchArrayforPartString(SearchString as String, LocList()) as Integer
Dim i as integer
    For i = Lbound(LocList(),1) to Ubound(LocList(),1)
        If Instr(1,LocList(i), SearchString) <> 0 Then
            SearchArrayForPartString() = i
            Exit Function
        End if
    Next
    IndexinArray = -1
End Function


Function GetMimeTypeList(BigFiltername as STring)
Dim sBigList() as String
Dim sSmallList() as String
Dim sMimeTypeList()
Dim BigMaxIndex as Integer
Dim n as Integer
    sBigList() = ArrayoutofString(BigFilterName,"|", BigMaxIndex)
    For n = 0 To BigMaxIndex
        sSmallList() = ArrayoutofString(sBigList(n),";")
        sMimeTypeList() = AddListToList(sMimeTypeList(), sSmallList())
    Next n
    GetMimetypeList() = sMimeTypeList()
End Function


Sub CreateLogDocument(HiddenProperties())
Dim oTableCursor as Object
Dim oLogCursor as Object
Dim oLogRows as Object
Dim sLogUrl as String
Dim NoArgs()
Dim i as Integer
Dim bLogExists as Boolean
    If ImportDialog.chkLogfile.State = 1 Then
        i = 2
Dim oArg() as new com.sun.star.beans.PropertyValue
Dim oUrl as new com.sun.star.util.URL
Dim oDisp as Object
    oUrl.Complete = "private:factory/swriter"
'    oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)
    oDisp = StarDesktop.currentFrame.queryDispatch(oUrl, "_self", 0)

    oDisp.dispatch(oUrl, oArg())
    printdbgInfo oDisp
'    oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 4, NoArgs())' HiddenProperties()) ' HiddenProperties())
        oLogCursor = oLogDocument.Text.CreateTextCursor
        oLogTable =  oLogDocument.CreateInstance("com.sun.star.text.TextTable")
        oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
        oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor
        oLogCursor.SetString(sSourceDocuments)
        oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor
        oLogCursor.SetString(sTargetDocuments)
        bInsertRow = False
' Todo: Strings in Resourcen
        sLogUrl = SOWorkPath & "/Logfile.sxw"
        Do
            bLogExists = oUcb.Exists(sLogUrl)
            If bLogExists 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 bLogExists
        oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
    EndIf
End Sub


Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String)
Dim oCell as Object
Dim oLogCursor as Object
Dim UrlList(1) as String
Dim LocFileName as String
Dim LocUrl as String
Dim i as Integer
    If ImportDialog.chkLogfile.State = 1 Then
        If bInsertRow Then
            oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
        Else
            bInsertRow = True
        End If
        UrlList(0) = SourceUrl
        UrlList(1) = TargetUrl
        For i = 0 To 1
            oCell = oLogTable.GetCellbyPosition(i,oLogTable.Rows.Count-1)
            oLogCursor = oCell.createTextCursor()
            LocUrl = UrlList(i)
            oLogCursor.HyperLinkURL = LocUrl
            oLogCursor.HyperLinkName = LocUrl
            oLogCursor.HyperLinkTarget = LocUrl
            LocFileName = FileNameOutOfPath(LocUrl)
            oCell.InsertString(oLogCursor, LocFileName,False)
        Next i
        oLogDocument.Store()
    End If
End Sub</script:module>