Scarica il file direttamente sul client

TDF LibreOffice Document Liberation Project Blog comunitari Weblate Nextcloud Redmine Ask LibreOffice Donazione

• Pagina principale
• Sviluppo
• Design
• Controllo qualità
• Eventi
• Documentazione
• Sito web
• Traduzione
• Accessibilità
• Commerciale
• Inclusione
• Aiuto

• Macro
• Macro generiche
• Macro per Writer
• Macro per Calc
• Macro per Impress
• Macro per Draw
• Macro per Base
• Macro per Math
• Basic/Python

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