Scarica il file direttamente sul client

    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:

    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