D7net
Home
Console
Upload
information
Create File
Create Folder
About
Tools
:
/
lib
/
libreoffice
/
share
/
basic
/
Euro
/
Filename :
AutoPilotRun.xba
back
Copy
<?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>