Visual Basic Internet Routines
DoFileDownload: Customize the IE Download Dialog
     
Posted:   Thursday November 28, 2002
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   None
Author:   VBnet - Randy Birch
     
Related:   URLDownloadToFile: Fast, Simple and Transparent File Downloads
URLDownloadToFile: Fast, Simple and Transparent File Downloads Bypassing the IE Cache

DoFileDownload: Download Files Using IE's Download Dialog
DoFileDownload: Customize the IE Download Dialog

FtpFindFirstFile: Connect and Retrieve FTP File Listings

FtpFindFirstFile: Download Files via FTP with a Download Progress Callback

     
 Prerequisites
Internet Explorer 4 or greater.

Devs often need to "encourage" the user to download a file to a specific folder. The DoFileDialog API call provides one of the easiest to use - and most user-familiar - download dialogs, but it has one flaw - it always displays pointing to the folder the user last used for a file download in Internet Explorer.

This demo shows how to make a tweak to the registry - on the fly - in order to specify the download folder of your choosing. As a bonus, it also shows how to perform some minor customize to the dialog title as well. DoFileDownload can be used to download files from both HTTP and FTP sites.

It is important to ensure that the download folder we specify is not persisted in the registry so as to not affect the user's normal download preference when using IE.  To achieve this the demo stores the current (existing) download path into a temporary variable. It then changes the registry key associated with the download folder and invokes the dialog which subsequently appears encouraging the user to save to the specified download folder. Once the download has completed, the demo code restores the user's previous download folder setting.

The result of the function returns True if the target file was successfully downloaded to the custom destination directory, and it will return False if the file was not downloaded for any reason, if the file was saved into a folder other than the folder you specified, or if the user pressed Cancel at any point during the download.

This code does does not (nor can not) prevent the user from navigating out of the folder you propose and therefore changing the download destination, nor can it prevent the Open or Open Folder buttons from becoming enabled when the download completes. But in a trusted environment where your goal is to simplify the user's interaction with the dialog and/or to guide the user into downloading to a specific path, this routine will do the trick.  Note that the download path you specify must already exist on the user's system.

The code itself is fairly simple; as usual, there's more comment than code below.

 BAS Module Code
None.

 Form Code
Add a command button and a textbox onto a form. Add the following code to a form, and set the initial values in Command1's click event to an appropriate file to test with:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const ERROR_SUCCESS As Long = 0&
Private Const INVALID_HANDLE_VALUE = -1
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const REG_SZ As Long = 1
Private Const READ_CONTROL As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ALL_ACCESS As Long = &HF003F
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL

Private Const KEY_READ As Long = ((READ_CONTROL Or _
                                   KEY_QUERY_VALUE Or _
                                   KEY_ENUMERATE_SUB_KEYS Or _
                                   KEY_NOTIFY) And _
                                   (Not SYNCHRONIZE))
                                    
Private Const KEY_WRITE As Long = ((STANDARD_RIGHTS_WRITE Or _
                                    KEY_SET_VALUE Or _
                                    KEY_CREATE_SUB_KEY) And _
                                    (Not SYNCHRONIZE))
                                     
Private Const KEY_EXECUTE As Long = (KEY_READ And (Not SYNCHRONIZE))

'registry key containing the Download Directory entry
Private Const sRegDownloadKey = "Software\Microsoft\Internet Explorer"

'a private type used to pass
'data to the function
Private Type FileRegistryDownloadData
   
   DownloadDlgTitle        As String 'custom download dialog title
   DownloadTempRegKey      As String 'temporary download destination folder to set in Reg
   DownloadRemoteFileUrl   As String 'full URL/name of download file
   DownloadLocalFileName   As String 'local file download filename
     
End Type
   
Private Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type
   
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
   Alias "RegOpenKeyExA" _
  (ByVal hKey As Long, _
   ByVal lpSubKey As String, _
   ByVal ulOptions As Long, _
   ByVal samDesired As Long, _
   phkResult As Long) As Long
  
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
   Alias "RegQueryValueExA" _
  (ByVal hKey As Long, _
   ByVal lpValueName As String, _
   ByVal lpReserved As Long, _
   ByVal lpType As Long, _
   ByVal lpData As Any, _
   lpcbData As Long) As Long

Private Declare Function RegSetValueEx Lib "advapi32.dll" _
   Alias "RegSetValueExA" _
  (ByVal hKey As Long, _
   ByVal lpszValueName As String, _
   ByVal dwReserved As Long, _
   ByVal dwType As Long, _
   lpData As Any, _
   ByVal nSize As Long) As Long
   
Private Declare Function RegCloseKey Lib "advapi32.dll" _
  (ByVal hKey As Long) As Long

Private Declare Function DoFileDownload Lib "shdocvw.dll" _
  (ByVal lpszFile As String) As Long
 
Private Declare Function FindWindow Lib "user32" _
   Alias "FindWindowA" _
  (ByVal lpClassName As String, _
   ByVal lpWindowName As String) As Long
  
Private Declare Sub Sleep Lib "kernel32" _
  (ByVal dwMilliseconds As Long)

Private Declare Function IsWindow Lib "user32" _
  (ByVal hwnd As Long) As Long

Private Declare Function SetWindowText Lib "user32" _
   Alias "SetWindowTextA" _
  (ByVal hwnd As Long, _
   ByVal lpString As String) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long
         
Private Declare Function FindFirstFile Lib "kernel32" _
   Alias "FindFirstFileA" _
  (ByVal lpFileName As String, _
   lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" _
  (ByVal hFindFile As Long) As Long



Private Sub Form_Load()

   Command1.Caption = "Do Custom Download"
   Text1.Text = ""
   
End Sub


Private Sub Command1_Click()

   Dim dldata As FileRegistryDownloadData
   
   With dldata
   
     'custom string, if desired, to
     'set as the title of the dialog.
     'Leave blank if the default title
     ''File Download' is adequate
      .DownloadDlgTitle = "VBnet Custom File Download Demo"
      
     'the full URL (http or ftp) of the
     'file to download to the above directory
      .DownloadRemoteFileUrl = "http://www.mvps.org/vbnet/files/misc/powertoyxpsio.zip"
      
     'local or network path where the
     'download dialog should offer to
     'place the file - THIS PATH MUST EXIST
      .DownloadTempRegKey = "C:\downloads"
      
     'remember to set the filename here to the same name 
     'as the file being downloaded, otherwise you will receive 
     'a Failed message even though the file was successfully 
     'retrieved. If this code is being used in an app 
     'that needs to dynamically set the save filename, you 
     'can add code from PathStripPath: Removes Path Portion of Fully-qualified Path/Filename 
     'to automatically retrieve the file part of the URL being downloaded. 
      .DownloadLocalFileName = .DownloadTempRegKey & "\" & "powertoyxpsio.zip"
      
     '--------------------
     'this next If Then is for debugging;
     'it deletes the file each time called
     'so as to allow the proper message to
     'be displayed following the call. This
     'is not required for production
      If FileExists(.DownloadLocalFileName) Then
         Kill .DownloadLocalFileName
      End If
     '--------------------
     
      If DownloadRemoteFile(dldata) = True Then
      
         Text1.Text = "Download success!"
      
      Else
      
         Text1.Text = "Download failed or user pressed Cancel"
      
      End If
   
   End With
   
End Sub


Private Function DownloadRemoteFile(dldata As FileRegistryDownloadData) As Boolean

   Dim hwndDlg As Long
   Dim sDownloadFile As String
   Dim sTmpRegHold As String
   Dim bRegChanged As Boolean
   
  'retrieve the user's current download
  'directory by querying the registry under
  'HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer
   sTmpRegHold = RegGetDownloadDirectory()
       
  'if the current download folder from
  'the registry is not the same as the
  'desired download folder, change it
   If LCase$(sTmpRegHold) <> LCase$(dldata.DownloadTempRegKey) Then
     
     'Change the registry from the user's
     'last-saved folder to the desired
     'download folder. Return and save
     'a local flag indicating a change
     'to the registry was made.
      bRegChanged = RegSetDownloadDirectory(dldata.DownloadTempRegKey)
      
   End If

  'DoFileDownload requires a Unicode
  'string so convert the desired path
  'to Unicode and call api
   sDownloadFile = StrConv(dldata.DownloadRemoteFileUrl, vbUnicode)
   Call DoFileDownload(sDownloadFile)
   
  'if a custom dialog title was specified
  'in the dldata type, we have to give
  'the dialog a chance to appear, then
  'we can retrieve its handle and change
  'the caption.
   If Len(dldata.DownloadDlgTitle) > 0 Then
     
     'Ensure dialog is displayed.
     'You can either use the loop below,
     'which waits for the hwndDlg to
     'become valid, or you can use the
     'commented out code below instead,
     'which puts the app to sleep for a
     'few milliseconds to let Windows
     'create the dialog. Note that only
     'one of the two method are needed!
     '
     'The advantage of the first is the
     'dialog title is changed as soon as
     'the dialog hwnd becomes valid, whereas
     'the delay method may require tweaking
     'to ensure sufficient delay is introduced
     'to allow Windows to create the dialog.
     'The disadvantage of the first method is,
     'should the dialog creation fail, you'll
     'stay in the loop. The downside to the
     'delay method is a possible perceptible
     'caption change, or, if the dialog is slow
     'to appear, no title change will occur.
     'You're choice!
      
     'Loop method
      Do
         hwndDlg = FindWindow("#32770", "File Download")
      Loop While hwndDlg = 0
      
     'Delay method
     'Call Sleep(150)
     'hwndDlg = FindWindow("#32770", "File Download")
   
     'assign the custom caption
      If hwndDlg <> 0 Then
         Call SetWindowText(hwndDlg, dldata.DownloadDlgTitle)
      End If

   End If
   
  'Since we've changed the registry,
  'it is only polite to change it
  'back once we're done. This is
  'accomplished by entering a loop
  'and pausing the app while the
  'dialog is on-screen. DoEvents
  'ensures the app can process messages.
  'The loop will terminate when the
  'dialog has closed, either from a
  'successful download or from the
  'user selecting Cancel. This
  'information can't be determined here,
  'so later we do a test for the file
  '(a FileExists) to determine the
  'success of the action.
   Do
   
      Call Sleep(50)
      DoEvents
      
   Loop Until IsWindow(hwndDlg) = False
     
  'The download is done or has been
  'cancelled, so first reset the user's
  'original download folder if changed
   If bRegChanged Then
      Call RegSetDownloadDirectory(sTmpRegHold)
   End If
   
  'now check the download was successful,
  'and return that as the success of this
  'routine
   DownloadRemoteFile = FileExists(dldata.DownloadLocalFileName)
   
End Function


Private Function RegGetDownloadDirectory() As String

   Dim hKey As Long
   Dim sizeData As Long
   Dim tmpdata As String
    
   If RegOpenKeyEx(HKEY_CURRENT_USER, _
                   sRegDownloadKey, _
                   0, _
                   KEY_READ, _
                   hKey) = ERROR_SUCCESS Then
      
      tmpdata = Space$(MAX_PATH)
      sizeData = Len(tmpdata)
      Call RegQueryValueEx(hKey, _
                           "Download Directory", _
                           0, 0, _
                           tmpdata, _
                           sizeData)
      
     'strip trailing nulls and return
      RegGetDownloadDirectory = TrimNull(tmpdata)
      
   End If
  
  Call RegCloseKey(hKey)
  
  
End Function


Private Function RegSetDownloadDirectory(sRegDownloadDir As String) As Boolean

   Dim hKey As Long
   Dim tmpdata As String
 
   If RegOpenKeyEx(HKEY_CURRENT_USER, _
                   sRegDownloadKey, _
                   0, _
                   KEY_WRITE, _
                   hKey) = ERROR_SUCCESS Then
                   
                   
      RegSetDownloadDirectory = RegSetValueEx(hKey, _
                                              "Download Directory", _
                                              0&, _
                                              REG_SZ, _
                                              ByVal sRegDownloadDir & vbNullChar, _
                                              Len(sRegDownloadDir) + 1) = ERROR_SUCCESS
      
      
   End If
  
  Call RegCloseKey(hKey)
  
End Function


Private Function FileExists(sSource As String) As Boolean

   Dim WFD As WIN32_FIND_DATA
   Dim hFile As Long
   
   hFile = FindFirstFile(sSource, WFD)
   FileExists = hFile <> INVALID_HANDLE_VALUE
   
   Call FindClose(hFile)
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter