File download direct to the client

From The Document Foundation Wiki
Jump to: navigation, search

Description

This macro downloads a file from a customized internet address to the local computer. It does work under Windows as well as Linux. Mac OS X is not supported.

The macro uses "wget" to download the file; under 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

'Copyright (c) 2011 Frieder Delor, Mailto: delorfr@googlemail.com
'The Funktion "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
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 cmputer
sPath = GetPath    
If sPath = "" Then
  MsgBox "You don't have selected a directory" _
            ,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 'Mac os
    MsgBox "This macro does not work under Mac-OS." _
            ,0 ,"Error"
  case 4  'Unix oder Linux
        Linux_Download (sURL, sPath )
  case else
      MsgBox "The operating system wasn't detected." _
            ,0 ,"Error"
  end select
end sub
'--------------------------------------------------------------------------------------------
Sub Linux_Download (sURL As String, sPath As String )
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, "Fehler"
    exit Sub  
  Else
    MsgBox "The download was completed. " ,0, "Successful"
  End If 

End Sub

'---------------------------------------------------------------------
Sub Win_Download(sURL As String, sPath As String )
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, "Fehler"
    exit Sub
  Else
    MsgBox "The download was completed. " ,0, "Successful"
  End If 
End Sub
'--------------------------------------------------------------------------------
'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 
'--------------------------------------------------------------------------
'Get the folder of the folder selection dialog
Function GetPath() As String
  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