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