12-30-2011، 03:31 PM
کد:
'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