Macros/General/007/es

TDF LibreOffice en español Document Liberation Project Blogs comunitarios Weblate Nextcloud Redmine Preguntas y respuestas Donar

• Inicio
• Desarrollo
• Diseño
• Control de calidad
• Eventos
• Documentación
• Sitio web
• Regionalización
• Accesibilidad
• Mercadotecnia
• Diversity
• Wiki Help

• Macros
• Macros Generales
• Macros para Writer
• Macros para Calc
• Macros para Impress
• Macros para Draw
• Macros para Base
• Macros para Math
• Basic/Python

Esta macro descarga un archivo desde una dirección de Internet específica a la computadora local. Funciona en Linux y Windows, pero no en macOS por el momento. En Linux, la macro usa wget para descargar el archivo; mientras que en Windows la macro usa la función API de Windows urlmon. La dirección de Internet y el nombre del archivo deben personalizarse en la parte de la declaración de "DownloadToFile". Puede utilizar los datos actuales, si desea probar primero la macro. La herramienta alemana "accounting-tool" se descargará entonces

Código

en LibreOffice Basic:

' Copyright (c) 2011 Frieder Delor, Mailto: delorfr@googlemail.com
' the function "GetPath" is originally from Copyright (c) 2011 Volker Lenhardt
'
'
' This program is free software; you can redistribute it and/or modify it under 
' the terms of the GNU General Public License as published by the Free Software
' Foundation; either version 2 of the License, or (at your option) any later 
' version.

' This program is distributed in the hope that it will be useful, but WITHOUT 
' ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
' FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.

' You should have received a copy of the GNU General Public License along with 
' this program; if not, write to the Free Software Foundation, Inc., 59 Temple 
' Place, Suite 330, Boston, MA 02111-1307 USA


Option Explicit

Sub DownloadToFile
    '''La subrutina principal, declara los parámetros relevantes, comprueba el sistema operativo para llamar a otras subrutinas específicas del sistema operativo.'''

    Dim iSystem%
    Dim sURL As String
    Dim sPath$ 

    ' La dirección de Internet tiene que ser un enlace directo a la descarga.
    sURL="http://wurzelmanager.blogger.de/getfile?name=abrechnungs_tool2.1.1.ods"

    ' Ruta en el equipo cliente
    sPath = GetPath	

    If sPath = "" Then
        MsgBox "No ha seleccionado una ruta de directorio adecuada" ,0 ,"Error"
        Exit Sub
    End if

    sPath =  ConvertFromUrl(sPath)
    sPath = sPath  & "abrechnungs_tool2.1.1.ods" ' por favor personalice
    iSystem = GetGUIType

    Select Case iSystem 	
        Case 1 ' El sistema operativo es Windows
  	    Win_Download (sURL, sPath )		
        Case 3 ' macOS
            MsgBox "Esta macro no funciona en Mac-OS." ,0 ,"Error"
        Case 4  ' Unix o Linux
            Linux_Download (sURL, sPath )
        Case Else
            MsgBox "No se detectó el sistema operativo." ,0 ,"Error"
    End Select

End Sub ' DownloadToFile


Sub Linux_Download (sURL As String, sPath As String)
    '''Descarga (implementación para sistema GNU/Linux)'''

    Dim iVar%,i%
    Dim dummy()
    If FileExists(sPath) Then
  	iVar = MsgBox ("El archivo " & Chr(10) & sPath & Chr(10) & " ya existe" & Chr(10) & _
  	               "¿Se debe reemplazar el archivo existente?",4,"Error")
  	If iVar = 7 Then Exit Sub  	
    End if

    ' Descargando el archivo
    Shell("wget -q " & sURL &" -O " & "'" & sPath & "'")

    For i = 1 To 10
        Wait 1000
        If FileExists(sPath) Then Exit For   ' espere 10 segundos hasta que finalice la descarga
        Next
        If Not FileExists(sPath) Then ' Error después de 10 segundos
            MsgBox "No se pudo descargar el archivo. " & Chr(10) & _
                "Verifique de nuevo la dirección de Internet." ,0, "Error"
            Exit Sub  
            Else
                MsgBox "La descarga se completó." ,0, "con éxito"
        End If 

End Sub ' Linux_Download


Sub Win_Download(sURL As String, sPath As String)
    '''Descarga (implementación para sistema Windows)'''

    Dim iVar%

    If FileExists(sPath)Then 
        iVar = MsgBox ("El archivo " & Chr(10) & sPath & Chr(10) & " ya existe." & Chr(10) & _
                "¿Se debe reemplazar el archivo existente?",4,"Error")
    If iVar = 7 Then Exit Sub
    End if

    'File downloading
    If DownloadFile(sURL, sPath) = False Then 
        MsgBox "No se pudo descargar el archivo. " & Chr(10) & _
            "Verifique de nuevo la dirección de Internet." ,0, "Error"
        Exit Sub
    Else
        MsgBox "La descarga se completó." ,0, "con éxito"
    End If 

End Sub ' Win_Download


' Abrir el procedimiento "urlmon" desde la API de Windows.
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
                       (ByVal pCaller As Long, _
                        ByVal szURL As String, _
                        ByVal szFileName As String, _
                        ByVal dwReserved As Long, _
                        ByVal lpfnCB As Long) As Long
                        

Public Function DownloadFile (URL As String, LocalFilename As String) As Boolean 
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0) 
    If lngRetVal = 0 Then DownloadFile = True 
End Function ' DownloadFile



Function GetPath() As String
    '''Obtener la carpeta del diálogo de selección de carpetas'''

    Dim  oPathSettings, oFolderDialog
    Dim sPath As String

    oPathSettings = CreateUnoService("com.sun.star.util.PathSettings")
    sPath = oPathSettings.Work
    oFolderDialog = _
          CreateUnoService("com.sun.star.ui.dialogs.FolderPicker")
    oFolderDialog.SetDisplayDirectory(sPath)
    If oFolderDialog.Execute() = com.sun.star.ui.dialogs.ExecutableDialogResults.OK Then
        sPath = oFolderDialog.GetDirectory
    Else
        GetPath = ""
        Exit Function
    End If

    If Right(sPath, 1) <> "/" Then sPath = sPath & "/"
    GetPath = sPath

End Function ' GetPath