Macros/General/007

TDF LibreOffice Document Liberation Project Community Blogs Weblate Nextcloud Redmine Ask LibreOffice Donate

Other languages:

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