سورس کد دانلود فایل در Temp

کد:
'Download a file into 'Temporary Internet Files'

'Move to Folder

'Kill Temp



Private Declare Function URLDownloadToCacheFile Lib "urlmon" Alias "URLDownloadToCacheFileA" (ByVal lpUnkcaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwBufLength As Long, ByVal dwReserved As Long, ByVal IBindStatusCallback As Long) As Long



Function DownloadFile(URL As String) As String

Dim szFileName As String

szFileName = Space$(300)

If URLDownloadToCacheFile(0, URL, szFileName, Len(szFileName), 0, 0) = 0 Then DownloadFile = Trim(szFileName)

End Function



Private Sub Command1_Click()

On Error GoTo Err

Dim tmp As String, fName As String, Pos As Long, fPath As String

tmp = DownloadFile("http://eur.i1.yimg.com/eur.yimg.com/i/eu/hp/yuk1.gif")



'Copy to directory, grab the filename, remove the [x] added by Windows''\yuk1[1].gif ''

fName = Mid$(tmp, InStrRev((tmp), "\"))

Pos = InStr(1, fName, ".")

'Note: fName includes leading "\", eg: "\yuk1.gif"

fName = Mid$(fName, 1, Pos - 4) & Mid$(fName, Pos)



'Move file to Directory

fPath = App.Path & fName 

FileCopy tmp, fPath



'Delete Temp

Kill tmp



MsgBox "Saved to " & fPath, vbInformation + vbOKOnly, "Success!"



Exit Sub

Err: MsgBox "Error", vbCritical + vbOKOnly, "Error!"

End Sub