Macros/General/007/es
Jump to navigation
Jump to search
TDF LibreOffice Document Liberation Blogs comunitarios Weblate Nextcloud Redmine Ask LibreOffice Apoyo al proyecto
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