Macros/General/007

    From The Document Foundation Wiki


    Description

    This macro downloads a file from a specified internet address to the local computer. It works Linux and Windows, but not on macOS at the moment. On Linux, the macro uses wget to download the file; while on Windows the macro uses the Windows API function urlmon. The internet address and the file name have to be customized in the declaration part of "DownloadToFile". You can try the actual data out, if you want to test the macro first. The German tool "accounting-tool" will be downloaded then.

    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
        '''Master subroutine, declares relevant parameters checks OS to call other OS-specific subroutines.'''
    
        Dim iSystem%
        Dim sURL As String
        Dim sPath$ 
    
        ' Internet address have to be a direct link to the download
        sURL="http://wurzelmanager.blogger.de/getfile?name=abrechnungs_tool2.1.1.ods"
    
        ' Path on the client computer
        sPath = GetPath	
    
        If sPath = "" Then
            MsgBox "You have not selected a proper directory path" ,0 ,"Error"
            Exit Sub
        End if
    
        sPath =  ConvertFromUrl(sPath)
        sPath = sPath  & "abrechnungs_tool2.1.1.ods" ' please customize
        iSystem = GetGUIType
    
        Select Case iSystem 	
            Case 1 ' The operating system is Windows
      	    Win_Download (sURL, sPath )		
            Case 3 ' macOS
                MsgBox "This macro does not work under Mac-OS." ,0 ,"Error"
            Case 4  ' Unix or Linux
                Linux_Download (sURL, sPath )
            Case Else
                MsgBox "The operating system was not detected." ,0 ,"Error"
        End Select
    
    End Sub ' DownloadToFile
    
    
    Sub Linux_Download (sURL As String, sPath As String)
        '''Download implementation for GNU/Linux system'''
    
        Dim iVar%,i%
        Dim dummy()
        If FileExists(sPath) Then
      	iVar = MsgBox ("The file " & Chr(10) & sPath & Chr(10) & " exists already." & Chr(10) & _
      	               "Should the existing file be replaced?",4,"Error")
      	If iVar = 7 Then Exit Sub  	
        End if
    
        ' File downloading
        Shell("wget -q " & sURL &" -O " & "'" & sPath & "'")
    
        For i = 1 To 10
            Wait 1000
            If FileExists(sPath) Then Exit For   ' wait up to 10 seconds until the download is finished
            Next
            If Not FileExists(sPath) Then ' Error after 10 seconds
                MsgBox "The file couldn't be downloaded. " & Chr(10) & _
                    "Please double check the internet address." ,0, "Error"
                Exit Sub  
                Else
                    MsgBox "The download was completed." ,0, "Successful"
            End If 
    
    End Sub ' Linux_Download
    
    
    Sub Win_Download(sURL As String, sPath As String)
        '''Download implementation for Windows system'''
    
        Dim iVar%
    
        If FileExists(sPath)Then 
            iVar = MsgBox ("The file " & Chr(10) & sPath & Chr(10) & " already exists." & Chr(10) & _
                    "Should the existing file be replaced?",4,"Error")
        If iVar = 7 Then Exit Sub
        End if
    
        'File downloading
        If DownloadFile(sURL, sPath) = False Then 
            MsgBox "The file couldn't be downloaded. " & Chr(10) & _
                "Please double check the internet address." ,0, "Error"
            Exit Sub
        Else
            MsgBox "The download was completed." ,0, "Successful"
        End If 
    
    End Sub ' Win_Download
    
    
    ' Open the procedure "urlmon" from Windows API.
    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
        '''Get the folder of the folder selection dialog'''
    
        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