Macros/General/007/es

    From The Document Foundation Wiki
    This page is a translated version of the page Macros/General/007 and the translation is 100% complete.


    Other languages:

    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