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