Quelle  AutoPilotRun.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="AutoPilotRun" script:language="StarBasic">Option Explicit

Public SourceDir as String
Public TargetDir as String
Public TargetStemDir as String
Public SourceFile as String
Public TargetFile as String
Public Source as String
Public SubstFile as String
Public SubstDir as String
Public NoArgs()
Public TypeList(6) as String
Public GoOn as Boolean
Public DoUnprotect as Integer
Public Password as String
Public DocIndex as Integer
Public oPathSettings as Object
Public oUcb as Object
Public TotDocCount as Integer
Public sTotDocCount as String
Public OpenProperties(1) as New com.sun.star.beans.PropertyValue


Sub StartAutoPilot()
Dim i As Integer
Dim oFactoryKey as Object
 BasicLibraries.LoadLibrary("Tools")
 BasicLibraries.LoadLibrary("ImportWizard")
 If InitResources("Euro Converter") Then
  oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
  oLocale = GetStarOfficeLocale()
  InitializeConverter(oLocale, 2)
  ToggleGoOnButton()
  oFactoryKey = GetRegistryKeyContent("org.openoffice.Setup/Office/Factories")
  DialogModel.chkTextDocuments.Enabled = oFactoryKey.hasbyName("com.sun.star.text.TextDocument")
  DialogModel.cmdGoOn.DefaultButton = True
  DialogModel.lstCurrencies.TabIndex = 12
  DialogConvert.GetControl("optWholeDir").SetFocus()
  DialogConvert.Execute()
  DialogConvert.Dispose()
 End If
End Sub


Sub ConvertDocuments()
Dim FilesList()
Dim bDisposable as Boolean

 If Source <> "" And TargetDir <> "" Then
  If DialogModel.optSingleFile.State = 1 Then
   SourceFile = Source
   TotDocCount = 1
  Else
   SourceDir = Source
   TargetStemDir = TargetDir
   TypeList(0) = "calc8"
   TypeList(1) = "calc_StarOffice_XML_Calc"
   If DialogModel.chkTextDocuments.State = 1 Then
    ReDim Preserve TypeList(5) as String

    TypeList(2) = "writer8"
    TypeList(3) = "writerglobal8"
    TypeList(4) = "writer_StarOffice_XML_Writer"
    TypeList(5) = "writer_globaldocument_StarOffice_XML_Writer_GlobalDocument"
   End If
   FilesList() = ReadDirectories(SourceDir, bRecursive, True, False, TypeList())
   TotDocCount = Ubound(FilesList(),1) + 1
  End If
  InitializeProgressPage(DialogModel)
'  ChangeToNextProgressStep()
  sTotDocCount = CStr(TotDocCount)
  OpenProperties(0).Name = "Hidden"
  OpenProperties(0).Value = True
  OpenProperties(1).Name = "AsTemplate"
  OpenProperties(1).Value = False
  For DocIndex = 0 To TotDocCount - 1
   If InitializeDocument(FilesList(), bDisposable) Then
    If StoreDocument() Then
     ConvertDocument()
     oDocument.Store
    End If
    If bDisposable Then
     oDocument.Dispose()
    End If
   End If
  Next DocIndex
  DialogModel.cmdBack.Enabled = True
  DialogModel.cmdGoOn.Enabled = True
  DialogModel.cmdGoOn.Label = sReady
  DialogModel.cmdCancel.Label = sEnd
 End If
End Sub


Function InitializeDocument(FilesList(), bDisposable as Boolean) as Boolean
' The Autopilot is started from step No. 2
Dim sViewPath as String
Dim bIsReadOnly as Boolean
Dim sExtension as String
 On Local Error Goto NEXTFILE
 If Not bCancelTask Then
  If DialogModel.optWholeDir.State = 1 Then
   SourceFile = FilesList(DocIndex,0)
   TargetFile = ReplaceString(SourceFile,TargetStemDir,SourceDir)
   TargetDir = DirectorynameoutofPath(TargetFile, "/")
  Else
   SourceFile = Source
   TargetFile = TargetDir & "/" & FileNameoutofPath(SourceFile, "/")
  End If
  If CreateFolder(TargetDir) Then
   sExtension = GetFileNameExtension(SourceFile, "/")
    oDocument = OpenDocument(SourceFile, OpenProperties(), bDisposable)
   If (oDocument.IsReadOnly) AND (UCase(SourceFile) = UCase(TargetFile)) Then
    bIsReadOnly = True
    Msgbox(sMsgDOCISREADONLY, 16, GetProductName())
   Else
    bIsReadOnly = False
    RetrieveDocumentObjects()
    sViewPath = CutPathView(SourceFile, 60)
    DialogModel.lblCurDocument.Label = Str(DocIndex+1) & "/" & sTotDocCount & " (" & sViewPath & ")"
   End If
   InitializeDocument() = Not bIsReadOnly
  Else
   InitializeDocument() = False
  End If
 Else
  InitializeDocument() = False
 End If
NEXTFILE:
 If Err <> 0 Then
  InitializeDocument() = False
  Resume LETSGO
LETSGO:
 End If
End Function


Sub ChangeToNextProgressStep()
 DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.NORMAL
 DialogConvert.GetControl("lblCurProgress").Visible = True
End Sub


Function StoreDocument() as Boolean
Dim sCurFileExists as String
Dim iOverWrite as Integer
 If (TargetFile <> "") And (Not bCancelTask) Then
  On Local Error Goto NOSAVING
  If oUcb.Exists(TargetFile) Then
   sCurFileExists = ReplaceString(sMsgFileExists, ConvertFromUrl(TargetFile), "<1>")
   sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>")
   iOverWrite = Msgbox (sCurFileExists, 32 + 3, sMsgDLGTITLE)
   Select Case iOverWrite
    Case 1 ' OK
    Case 2  ' Abort
     bCancelTask = True
     StoreDocument() = False
     Exit Function
    Case 7  ' No
     StoreDocument() = False
     Exit Function
   End Select
  End If
  If TargetFile <> SourceFile Then
   oDocument.StoreAsUrl(TargetFile,NoArgs)
  Else
   oDocument.Store
  End If
  StoreDocument() = True
  NOSAVING:
  If Err <> 0 Then
   StoreDocument() = False
   Resume CLERROR
  End If
  CLERROR:
 End If
End Function


Sub SwapExtent()
 DialogModel.chkRecursive.Enabled = DialogModel.optWholeDir.State = 1
 If DialogModel.optWholeDir.State = 1 Then
  DialogModel.lblSource.Label = sSOURCEDIR
  If Not IsNull(SubstFile) Then
   SubstFile = DialogModel.txtSource.Text
   DialogModel.txtSource.Text = SubstDir
  End If
 Else
  DialogModel.LblSource.Label = sSOURCEFILE
  If Not IsNull(SubstDir) Then
   SubstDir = DialogModel.txtSource.Text
   DialogModel.txtSource.Text = SubstFile
  End If
 End If
 ToggleGoOnButton()
End Sub


Function InitializeThirdStep() as Boolean
Dim TextBoxText as String
 Source = AssignFileName(DialogModel.txtSource.Text, DialogModel.lblSource.Label, True)
 If CheckTextBoxPath(DialogModel.txtTarget, True, True, sMsgDLGTITLE, True) Then
  TargetDir = AssignFileName(DialogModel.txtTarget.Text, DialogModel.lblTarget.Label, False)
 Else
  TargetDir = ""
 End If
 If Source <> "" And TargetDir <> "" Then
  bRecursive = DialogModel.chkRecursive.State = 1
  bDoUnprotect = DialogModel.chkProtect.State = 1
  DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.BOLD
  DialogModel.lblRetrieval.Label = sPrgsRETRIEVAL
  DialogModel.lblCurProgress.Label = sPrgsCONVERTING
  If DialogModel.optWholeDir.State = 1 Then
   TextBoxText = sSOURCEDIR & " " & ConvertFromUrl(Source) & chr(13)
   If DialogModel.chkRecursive.State = 1 Then
    TextBoxText = TextBoxText & DeleteStr(sInclusiveSubDir,"~") & chr(13)
   End If
  Else
   TextBoxText = sSOURCEFILE & " " & ConvertFromUrl(Source) & chr(13)
  End If
  TextBoxText = TextBoxText & sTARGETDIR & " " & ConvertFromUrl(TargetDir) & chr(13)
  If DialogModel.chkProtect.State = 1 Then
   TextBoxText = TextboxText & sPrgsUNPROTECT
  End If
  DialogModel.txtConfig.Text = TextBoxText
   ToggleProgressStep()
  DialogModel.cmdGoOn.Enabled = False
  InitializeThirdStep() = True
 Else
  InitializeThirdStep() = False
 End If
End Function


Sub ToggleProgressStep(Optional aEvent as Object)
Dim bMakeVisible as Boolean
Dim LocStep as Integer
 ' If the Sub is call by the 'cmdBack' Button then set the 'bMakeVisible' variable accordingly
 bMakeVisible = IsMissing(aEvent)
 If bMakeVisible Then
  DialogModel.Step = 3
 Else
  DialogModel.Step = 2
 End If
  DialogConvert.GetControl("lblCurrencies").Visible = Not bMakeVisible
  DialogConvert.GetControl("lstCurrencies").Visible = Not bMakeVisible
 DialogConvert.GetControl("cmdBack").Visible = bMakeVisible
  DialogConvert.GetControl("cmdGoOn").Visible = bMakeVisible
 DialogModel.imgPreview.ImageUrl = BitmapDir & "euro_" & DialogModel.Step & ".png"
End Sub


Sub EnableStep2DialogControls(OnValue as Boolean)
 With DialogModel
  .hlnExtent.Enabled = OnValue
  .optWholeDir.Enabled = OnValue
  .optSingleFile.Enabled = OnValue
  .chkProtect.Enabled = OnValue
  .cmdCallSourceDialog.Enabled = OnValue
  .cmdCallTargetDialog.Enabled = OnValue
  .lblSource.Enabled = OnValue
  .lblTarget.Enabled = OnValue
  .txtSource.Enabled = OnValue
  .txtTarget.Enabled = OnValue
  .imgPreview.Enabled = OnValue
  .lstCurrencies.Enabled = OnValue
  .lblCurrencies.Enabled = OnValue
  If OnValue Then
   ToggleGoOnButton()
   .chkRecursive.Enabled = .optWholeDir.State = 1
  Else
   .cmdGoOn.Enabled = False
   .chkRecursive.Enabled = False
  End If
 End With
End Sub


Sub InitializeProgressPage()
 DialogConvert.GetControl("lblRetrieval").Visible = False
 DialogConvert.GetControl("lblCurProgress").Visible = False
 DialogModel.lblRetrieval.FontWeight = com.sun.star.awt.FontWeight.NORMAL
 DialogModel.lblCurProgress.FontWeight = com.sun.star.awt.FontWeight.BOLD
 DialogConvert.GetControl("lblRetrieval").Visible = True
 DialogConvert.GetControl("lblCurProgress").Visible = True
End Sub


Function AssignFileName(sPath as String, ByVal HeaderString, bCheckFileType as Boolean) as String
Dim bIsValid as Boolean
Dim sLocMimeType as String
Dim sNoDirMessage as String
 HeaderString = DeleteStr(HeaderString, ":")
 sPath = ConvertToUrl(Trim(sPath))
 bIsValid = oUcb.Exists(sPath)
 If bIsValid Then
  If DialogModel.optSingleFile.State = 1 Then
   If bCheckFileType Then
    sLocMimeType = GetRealFileContent(sPath)
    If DialogModel.chkTextDocuments.State = 1 Then
     If (Instr(1, sLocMimeType, "text") = 0) And (Instr(1, sLocMimeType, "calc") = 0) Then
      Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE)
      bIsValid = False
     End If
    Else
     If (Instr(1, sLocMimeType, "spreadsheet") = 0) And (Instr(1, sLocMimeType, "calc")) = 0 Then
      Msgbox(sMsgFileInvalid, 48, sMsgDLGTITLE)
      bIsValid = False
     End If
    End If
   End If
  Else
   If Not oUcb.IsFolder(sPath) Then
    sNoDirMessage = ReplaceString(sMsgNODIRECTORY,sPath,"<1>")
    Msgbox(sNoDirMessage,48, sMsgDLGTITLE)
    bIsValid = False
   Else
    sPath = RTrimStr(sPath,"/")
    sPath = sPath & "/"
   End If
  End if
 Else
  Msgbox(HeaderString & " '" & ConvertFromUrl(sPath) & "' " & sMsgNOTTHERE,48, sMsgDLGTITLE)
 End If
 If bIsValid Then
  AssignFileName() = sPath
 Else
  AssignFilename() = ""
 End If
End Function


Sub ToggleGoOnButton()
Dim bDoEnable as Boolean
Dim sLocMimeType as String
Dim sPath as String
 bDoEnable = Ubound(DialogModel.lstCurrencies.SelectedItems()) > -1
 If bDoEnable Then
  ' Check if Source is set correctly
  sPath = ConvertToUrl(Trim(DialogModel.txtSource.Text))
  bDoEnable = oUcb.Exists(sPath)
 End If
 DialogModel.cmdGoOn.Enabled = bDoEnable
End Sub


Sub CallFolderPicker()
 GetFolderName(DialogModel.txtTarget)
 ToggleGoOnButton()
End Sub


Sub CallFilePicker()
 If DialogModel.optSingleFile.State = 1 Then
  Dim oMasterKey as Object
  Dim oTypes() as Object
  Dim oUIKey() as Object

  oMasterKey = GetRegistryKeyContent("org.openoffice.TypeDetection.Types")
  oTypes() = oMasterKey.Types
  oUIKey = GetRegistryKeyContent("org.openoffice.Office.UI/FilterClassification/LocalFilters")
  If DialogModel.chkTextDocuments.State = 1 Then
   Dim FilterNames(7,1) as String
   FilterNames(4,0) = oTypes.GetByName("writer_StarOffice_XML_Writer").UIName
   FilterNames(4,1) = "*.sxw"
   FilterNames(5,0) = oTypes.GetByName("writer_StarOffice_XML_Writer_Template").UIName
   FilterNames(5,1) = "*.stw"
   FilterNames(6,0) = oTypes.GetByName("writer8").UIName
   FilterNames(6,1) = "*.odt"
   FilterNames(7,0) = oTypes.GetByName("writer8_template").UIName
   FilterNames(7,1) = "*.ott"
  Else
   ReDim FilterNames(3,1) as String
  End If
  FilterNames(0,0) = oTypes.GetByName("calc8").UIName
  Filternames(0,1) = "*.ods"
  FilterNames(1,0) = oTypes.GetByName("calc8_template").UIName
  Filternames(1,1) = "*.ots"
  FilterNames(2,0) = oTypes.GetByName("calc_StarOffice_XML_Calc").UIName
  Filternames(2,1) = "*.sxc"
  FilterNames(3,0) = oTypes.GetByName("calc_StarOffice_XML_Calc_Template").UIName
  Filternames(3,1) = "*.stc"
  GetFileName(DialogModel.txtSource, Filternames())
 Else
  GetFolderName(DialogModel.txtSource)
 End If
 ToggleGoOnButton()
End Sub


Sub PreviousStep()
 DialogModel.Step = 2
 DialogModel.cmdGoOn.Label = sGOON
 DialogModel.cmdCancel.Label = sCANCEL
End Sub
</script:module>