[Amin_Mansouri]

کد:

'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

[Ghoghnus]

امین جون خیلی کد جالبی بود!فقط فایر وال بهش گیر میده؟

[Amin_Mansouri]

فکر نکنم فایروال گیر بده اما بعضی از فایروال ها حتی یاهو مسنجر هم باز کنید از شما اجازه دسترسی میپرسه !