Scarica il file direttamente sul client
Jump to navigation
Jump to search
TDF LibreOffice Blog comunitari Weblate(traduci) Autori Nextcloud Redmine Ask LibreOffice | Donazione
Descrizione
Questa macro scarica un file da un indirizzo Internet specificato nel computer locale. Funziona su Linux e Windows, ma non su macOS al momento. Su Linux, la macro usa wget
per scaricare il file; mentre su Windows la macro utilizza la funzione API di Windows urlmon
. L'indirizzo Internet e il nome del file devono essere personalizzati nella parte di dichiarazione di "DownloadToFile". Potete provare i dati effettivi, se volete testare prima la macro. Lo strumento tedesco "accounting-tool" verrà quindi scaricato.
Code
In 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 subroutine principale, dichiara che i parametri rilevanti controllano il sistema operativo per chiamare altre subroutine specifiche del sistema operativo.'''
Dim iSystem%
Dim sURL As String
Dim sPath$
' L'indirizzo Internet deve essere un collegamento diretto al download
sURL="http://wurzelmanager.blogger.de/getfile?name=abrechnungs_tool2.1.1.ods"
' Percorso sul computer client
sPath = GetPath
If sPath = "" Then
MsgBox "Non avete selezionato un percorso di directory corretto" ,0 ,"Errore"
Exit Sub
End if
sPath = ConvertFromUrl(sPath)
sPath = sPath & "abrechnungs_tool2.1.1.ods" ' per favore personalizzate
iSystem = GetGUIType
Select Case iSystem
Case 1 ' Il sistema operativo è Windows
Win_Download (sURL, sPath )
Case 3 ' macOS
MsgBox "Questa macro non funzione con Mac-OS." ,0 ,"Errore"
Case 4 ' Unix o Linux
Linux_Download (sURL, sPath )
Case Else
MsgBox "Il sistema operativo non è stato individuato." ,0 ,"Errore"
End Select
End Sub ' DownloadToFile
Sub Linux_Download (sURL As String, sPath As String)
'''Scaricate l'implementazione per il sistema GNU/Linux'''
Dim iVar%,i%
Dim dummy()
If FileExists(sPath) Then
iVar = MsgBox ("Il file " & Chr(10) & sPath & Chr(10) & " esiste già." & Chr(10) & _
"Il file esistente deve essere sostituito?",4,"Errore")
If iVar = 7 Then Exit Sub
End if
' Download del file
Shell("wget -q " & sURL &" -O " & "'" & sPath & "'")
For i = 1 To 10
Wait 1000
If FileExists(sPath) Then Exit For ' attendete fino a 10 secondi fino al termine del download
Next
If Not FileExists(sPath) Then ' Errore dopo 10 secondi
MsgBox "Il file potrebbe non essere stato scaricato. " & Chr(10) & _
"Per piacere fate doppio clic sull'indirizzo internet." ,0, "Errore"
Exit Sub
Else
MsgBox "Il download è stato completato." ,0, "Riuscito"
End If
End Sub ' Linux_Download
Sub Win_Download(sURL As String, sPath As String)
'''Scaricate l'implementazione per il sistema Windows'''
Dim iVar%
If FileExists(sPath)Then
iVar = MsgBox ("Il file " & Chr(10) & sPath & Chr(10) & " esiste già." & Chr(10) & _
"Il file esistente deve essere sostituito?",4,"Errore")
If iVar = 7 Then Exit Sub
End if
'File downloading
If DownloadFile(sURL, sPath) = False Then
MsgBox "Il file potrebbe non essere stato scaricato. " & Chr(10) & _
"Per piacere fate doppio clic sull'indirizzo internet." ,0, "Errore"
Exit Sub
Else
MsgBox "Il download è stato completato." ,0, "Riuscito"
End If
End Sub ' Win_Download
' Apre la procedura "urlmon" dall'API di 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
'''Ottiene la cartella della finestra di dialogo di selezione della cartella'''
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