Konu: İnternetten dosya indirmek
Merhaba.
Belli bir url deki dosyayı bilgisayarda sitediğimiz bir klasöre vfp içinden kullanıcıya bulaşmadan download edebilirmiyiz?
Teşekkürler.
- soykanozcelik
- Uzman Üye
- Offline
Re: İnternetten dosya indirmek
selam Bilal,
FTP get ile indirebilirsin
Visual Fox Pro
**********************************************************************************
*... FTPGet.PRG ...*
PARAMETERS lcHost, lcUser, lcPwd, lcRemoteFile, lcNewFile, lnXFerType
*.................................................................................
*: Usage: DO ftpget WITH ;
*: '[url=ftp://ftp.host]ftp.host[/url]', 'name', 'password', 'source.file', 'target.file'[, 1 | 2]
*:
*: Where: lcHost = Host computer IP address or name
*: lcUser = user name - anonymous may be used
*: lcPwd = password
*: lcRemoteFile = source file name
*: lcNewFile = target file name
*: lnXFerType = 1 (default) for ascii, 2 for binary
*.................................................................................
*...set up API calls
DECLARE INTEGER InternetOpen IN wininet;
STRING sAgent, INTEGER lAccessType, STRING sProxyName,;
STRING sProxyBypass, STRING lFlags
DECLARE INTEGER InternetCloseHandle IN wininet INTEGER hInet
DECLARE INTEGER InternetConnect IN wininet.DLL;
INTEGER hInternetSession,;
STRING lcHost,;
INTEGER nServerPort,;
STRING lcUser,;
STRING lcPassword,;
INTEGER lService,;
INTEGER lFlags,;
INTEGER lContext
DECLARE INTEGER FtpGetFile IN wininet;
INTEGER hftpSession, ;
STRING lcRemoteFile,;
STRING lcNewFile, ;
INTEGER fFailIfExists,;
INTEGER dwFlagsAndAttributes,;
INTEGER dwFlags, ;
INTEGER dwContext
lcHost = ALLTRIM(lcHost)
lcUser = ALLTRIM(lcUser)
lcPwd = ALLTRIM(lcPwd)
lcRemoteFile = ALLTRIM(lcRemoteFile)
lcNewFile = ALLTRIM(lcNewFile)
sAgent = "vfp"
sProxyName = CHR(0) &&... no proxy
sProxyBypass = CHR(0) &&... nothing to bypass
lFlags = 0 &&... no flags used
*... initialize access to Inet functions
hOpen = InternetOpen (sAgent, 1,;
sProxyName, sProxyBypass, lFlags)
IF hOpen = 0
WAIT WINDOW "Unable to get access to WinInet.Dll" TIMEOUT 2
RETURN
ENDIF
*... The first '0' says use the default port, usually 21.
hftpSession = InternetConnect (hOpen, lcHost,;
0, lcUser, lcPwd, 1, 0, 0) &&... 1 = ftp protocol
IF hftpSession = 0
*... close access to Inet functions and exit
= InternetCloseHandle (hOpen)
WAIT WINDOW "Unable to connect to " + lcHost + '.' TIMEOUT 2
RETURN
ELSE
WAIT WINDOW "Connected to " + lcHost + " as: [" + lcUser + "]" TIMEOUT 1
ENDIF
*... 0 to automatically overwrite file
*... 1 to fail if file already exists
fFailIfExists = 0
dwContext = 0 &&... used for callback
WAIT WINDOW 'Transferring ' + lcRemoteFile + ' to ' + lcNewFile + '...' NOWAIT
lnResult = FtpGetFile (hftpSession, lcRemoteFile, lcNewFile,;
fFailIfExists, 128, lnXFerType,;
dwContext)
*... 128 = #define FILE_ATTRIBUTE_NORMAL 0x00000080
*... See CreateFile for other attributes
* close handles
= InternetCloseHandle (hftpSession)
= InternetCloseHandle (hOpen)
IF lnResult = 1
*... successful download, do what you want here
WAIT WINDOW 'Completed.' TIMEOUT 1
* MODI FILE (lcNewFile)
ELSE
WAIT WINDOW "Unable to download selected file" TIMEOUT 2
ENDIF
RETURN
*** End of ftpGet.PRG *************************************************************
Re: İnternetten dosya indirmek
Soykan çok teşekkür ederim.
Ancak FTP kullanmadan da örneğin http://www.espor.com.tr/aa.zip isimli dosyayı hard diskte istediğim bir yere download etmenin bir yolu varmı?
- soykanozcelik
- Uzman Üye
- Offline
Re: İnternetten dosya indirmek
var tabii , eski bir yontem hazir elime gecti onu ornekliyorum burada
asagidaki bir custom class kodu
kullanilisi
class ı form üzerine surukleyip bırakıyorsun , form uzerine bir label kontrolu koyuyorsun
* label caption
* label click event
&& e-mail linki
&&IF !EMPTY(This.Tag) AND TYPE('ThisForm.Webexplorer1') = 'O'
&& ThisForm.Webexplorer1.SendMail(This.Tag)
&& ENDIF
IF !EMPTY(This.Tag) AND TYPE('ThisForm.Webexplorer1') = 'O'
ThisForm.Webexplorer1.Showpage(This.Tag)
ENDIF
* label tag
* label tooltiptext &&kullanmayada bilirsin
=this.tag
Visual Fox Pro
**************************************************
*-- Class: webexplorer (d:\soykan\mysoftware\emin_elk\lib\webexplorer.vcx)
*-- ParentClass: custom
*-- BaseClass: custom
*-- Time Stamp: 07/26/99 04:48:02 PM
*-- Call Internet Explorer, send e-mail
*
#INCLUDE "c:\program files\microsoft visual studio\vfp98\foxpro.h"
*
DEFINE CLASS webexplorer AS custom
PROTECTED nlasterr
nlasterr = 0
Name = "webexplorer"
PROTECTED oexplorer
PROTECTED bnotsupport
PROCEDURE showpage
LPARAMETERS tcURL
IF This.bNotSupport
RETURN .F.
ENDIF
IF VARTYPE(tcURL) # 'C' OR EMPTY(tcURL)
RETURN .F.
ENDIF
IF VARTYPE(This.oExplorer) # 'O' OR ISNULL(This.oExplorer)
This.nLastErr = 0
This.oExplorer = GetObject(,'InternetExplorer.Application')
IF VARTYPE(This.oExplorer) # 'O' OR ISNULL(This.oExplorer)
This.oExplorer = CreateObject('InternetExplorer.Application')
ENDIF
IF VARTYPE(This.oExplorer) # 'O' OR ISNULL(This.oExplorer)
This.bNotSupport = .T.
RETURN .F.
ENDIF
ENDIF
This.nLastErr = 0
WITH This.oExplorer
.Navigate(tcURL,,"_self")
WITH This
IF .nLastErr = 1426
.nLastErr = 0
.oExplorer = NULL
RETURN .ShowPage(tcURL)
ENDIF
ENDWITH
IF !.Visible
.Visible = .T.
ENDIF
SetForegroundWindow(.HWND)
ENDWITH
RETURN .T.
ENDPROC
PROCEDURE sendmail
#DEFINE SW_SHOWNORMAL 1
LPARAMETERS tcAddress
IF VARTYPE(tcAddress) # 'C' OR EMPTY(tcAddress)
RETURN .F.
ENDIF
LOCAL lhWnd, lnRetVal, lcAddress
lhWnd = FindWindow(NULL, _SCREEN.Caption)
lcAddress = ALLTRIM(tcAddress)
IF ATC("mailto:", LOWER(lcAddress)) = 0
lcAddress = "mailto:"+lcAddress
ENDIF
lnRetVal = ShellExecute(lhWnd, NULL, lcAddress, NULL, NULL, SW_SHOWNORMAL)
ENDPROC
PROCEDURE Destroy
This.oExplorer = NULL
ENDPROC
PROCEDURE Init
DECLARE INTEGER SetForegroundWindow IN Win32API ;
LONG hWnd
DECLARE LONG FindWindow IN Win32API ;
STRING lpClassName;
,STRING lpWindowName
DECLARE INTEGER ShellExecute IN shell32 ;
LONG hwnd;
,STRING lpOperation;
,STRING lpFile;
,STRING lpParameters;
,STRING lpDirectory;
,INTEGER nShowCmd
ENDPROC
PROCEDURE Error
LPARAMETERS nError, cMethod, nLine
IF VARTYPE(nError) # 'N'
nError = 0
ENDIF
DO CASE
CASE nerror = 1733
NODEFAULT
ACTIVATE SCREEN
?CHR(7)
MessageBox("Æàëü, íî íà Âàøåé ìàøèíå íåò ïîääåğæêè Èíòåğíåò.", 16, This.Name)
RETURN
CASE nError = 1426
This.nLastErr = nError
NODEFAULT
RETURN
OTHERWISE
RETURN DODEFAULT(nError, cMethod, nLine)
ENDCASE
ENDPROC
ENDDEFINE
*
*-- EndDefine: webexplorer
**************************************************
- smentes
- Uzman Üye
- Offline
Re: İnternetten dosya indirmek
ben de kullandığım kodu gönderiyorum
***Commandbuton clik
SET CURSOR OFF
Set Safety Off
Wait "İnternetten Dosyalar Alınıyor. Bekleyiniz." window at 10,41 timeout 5
ftpx="ftp.xxxxxx.com"
adix="ftpdenbil"
sifrex="1denbil"
ftpdekidosyax="xxxxxxxx/xxxxxxxx.zip"
cdekiyerix="C:\xxxxxx\xxxxxx.zip"
do ftpdosyaal with ftpx,adix,sifrex,ftpdekidosyax,cdekiyerix
Wait "Dosyalar Alındı. Yükleme Yapılıyor." window at 10,41 nowait
SET SAFETY ON
SET cursor on
Wait "Yükleme İşlemi Tamamlandı." window at 10,41 timeout 5
Wait clear
****
function ftpdosyaal
LParameter furl, fuser, fpwd, fdosya1, fdosya2
* furl : Bağlantı yapılacak ftp adresi. Örnek: ftp.okul.com *
* fuser : Kullanıcı adı. Örnek: okulyonetimi *
* fpwd : Şifre. Örnek: 1453 *
* fdosya1 : FTP 'deki dosya yeri ve adı *
* fdosya2 : Bilgisayardaki dosya yeri ve adı *
#Define ERROR_INTERNET_EXTENDED_ERROR 12003
#Define ERROR_NO_MORE_FILES 18
#Define FORMAT_MESSAGE_IGNORE_INSERTS 0x00000200
#Define FORMAT_MESSAGE_FROM_SYSTEM 0x00001000
#Define INTERNET_OPEN_TYPE_PRECONFIG 0
#Define INTERNET_SERVICE_FTP 1
#Define GENERIC_READ 0x80000000
#Define INTERNET_DEFAULT_FTP_PORT 21 && FTP serverlar için default değer.
#Define MESAJ_KUTUSU 2 && 0 Gösterme, 1 Messagebox, 2 Wait Window Nowait
#Define TRANSFER_MODU 2 && 1 ASCII, 2 BINARY
* Parametreler kontrol eddiliyor.
If Type("furl") # "C"
furl=""
Else
furl=AllTrim(furl)
Endif
If Type("fuser") # "C"
fuser=""
Else
fuser=AllTrim(fuser)
Endif
If Type("fpwd") # "C"
fpwd=""
Else
fpwd=AllTrim(fpwd)
Endif
If Type("fdosya1") # "C"
fdosya1=""
Else
fdosya1=AllTrim(fdosya1)
Endif
If Type("fdosya2") # "C"
fdosya2=""
Else
fdosya2=AllTrim(fdosya2)
Endif
*Active X ler Yükleniyor
Declare integer InternetConnect in "wininet.dll" ;
integer hInternetSession, string @ sServerName, integer nServerPort, ;
string @ sUsername, string @ sPassword, integer dwService, ;
integer dwFlags, integer dwContext
Declare integer InternetOpen in "wininet.dll" ;
string @ sAgent, integer dwAccessType, string @ sProxyName, ;
string @ sProxyBypass, integer dwFlags
Declare integer InternetCloseHandle in "wininet.dll" integer hInet
Declare integer InternetWriteFile in "wininet.dll" ;
integer hFile, string @ sBuffer, integer lNumBytesToWite, ;
integer @ dwNumberOfBytesWritten
Declare short InternetReadFile in "wininet.dll" ;
integer hFile, string @ lpBuffer, integer dwNumberOfBytesToRead, ;
integer @lpdwNumberOfBytesRead
Declare integer FtpOpenFile in "wininet.dll" ;
integer hFtpSession, string @ sFileName, integer AccessType, ;
integer Flags, integer Context
Declare integer FtpGetFileSize in "wininet.dll" ;
integer hFile, integer @lpdwFileSizeHigh
Declare short FtpGetFile in "wininet.dll" ;
integer hFtpSession, string @ lpszRemoteFile, string @ lpszNewFile, ;
short fFailIfExists, integer dwFlagsAndAttributes, integer dwFlags, ;
integer dwContext
Declare short InternetGetLastResponseInfo in "wininet.dll" ;
integer @ lpdwError, string @ lpszErrorBuffer, integer @ lpdwErrorBufferLength
Declare integer FormatMessage in "kernel32" ;
integer dwFlags, string @ lpSource, integer dwMessageId, ;
integer dwLanguageId, string @ lpBuffer, integer nSize, ;
string @ Arguments
Declare integer GetLastError in win32API
* Test Bağlantı yapılıyor.
Public hOpen, dwSemantic, hConnection
hOpen = InternetOpen("My Test", INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
If hOpen = 0
Messagebox("İnternet Başlatılamıyor. İnternet Bağlantılarınızı Kontrol Ediniz.", 48, "Uyarı")
Return
Endif
dwSemantic = 0
hConnection = 0
*Bağlantı kuruluyor.
If Empty(furl)
Messagebox("URL Adresinizi Kontrol Ediniz. Örnek : ftp.okul.com", 48, "Uyarı")
Return
Endif
If Empty(fuser)
Messagebox("Kullanıcı Adı Bilgisini Kontrol Ediniz. Örnek : okulyonetimi", 48, "Uyarı")
Return
Endif
If Empty(fpwd)
Messagebox("Şifre Bilgisini Kontrol Ediniz. Örnek : 12345", 48, "Uyarı")
Return
Endif
If hConnection # 0
InternetCloseHandle(hConnection)
Endif
hConnection = InternetConnect(hOpen, furl, INTERNET_DEFAULT_FTP_PORT, fuser, fpwd, ;
INTERNET_SERVICE_FTP, dwSemantic, 0)
If hConnection = 0
=FtpResponse('Server FTP bağlantısı sağlanamıyor.')
Else
=FtpResponse('Bağlantı kuruldu.')
Endif
*Dosya Alınıyor.
If Empty(fdosya1)
Messagebox("FTP 'deki Dosya Yeri Ve Adını Belirtmelisiniz. Örnek: db/okul.mdb", 48, "Uyarı")
Return
Endif
If Empty(fdosya2)
Messagebox("Bilgisayardaki Dosya Yeri Ve Adını Belirtmelisiniz. Örnek: c:\data\okul.mdb", 48, "Uyarı")
Return
Endif
hFile = FtpOpenFile(hConnection, fdosya1, GENERIC_READ, TRANSFER_MODU, 0)
If hFile = 0
=FTPResponse("FTP Sunucusunda Dosya Açılamıyor.")
Return
Endif
lpdwFileSizeHigh = 0
lnSize = FtpGetFileSize(hFile, lpdwFileSizeHigh)
lnSize = lnSize + lpdwFileSizeHigh * (0xFFFFFFFF+1)
hOut = FCreate(fdosya2)
lnBytesWritten = 0
Do While lnBytesWritten < lnSize
lpdwNumberOfBytesRead = 0
lcRead = space(100)
If InternetReadFile(hFile, @lcRead, 100, @lpdwNumberOfBytesRead) = 0
=FTPResponse("FTP Sunucunuzdaki Dosya Okunamıyor.")
Return
Endif
lnBytesWritten = lnBytesWritten + FWrite(hOut,lcRead,lpdwNumberOfBytesRead)
Enddo
=FClose(hOut)
InternetCloseHandle(hFile)
=FTPResponse('Dosya Alma İşlemi Tamamlandı')
Release hOpen, dwSemantic, hConnection
Clear Dlls
Inkey(2)
Wait clear
Return
********************
*FTP Hata mesajları
********************
Procedure FTPRESPONSE
Lparameters tcMsg
local szString, dwTemp,buflen,lcMessage, lnError
szString = space(2048)
dwTemp = 0
buflen = 2048
lnError = GetLastError()
If !InList(lnError,0,ERROR_NO_MORE_FILES)
lcMessage = ErrorInfo(lnError)
Else
If InternetGetLastResponseInfo(@dwTemp, @szString, @buflen) = 0 and buflen > 2048
szString = Space(buflen)
InternetGetLastResponseInfo(@dwTemp, @szString, @buflen)
Endif
lcMessage = SubStr(szString, 1, buflen)
Endif
Do Case
Case MESAJ_KUTUSU = 1
*Messagebox(tcMsg+Chr(13)+lcMessage, 48, "Uyarı")
Messagebox(tcmsg, 48, "Uyarı")
Case MESAJ_KUTUSU = 2
*Wait Window tcMsg+Chr(13)+lcMessage NoWait
*Wait Window tcmsg NoWait timeout 5
Wait tcmsg window at 10,41 NoWait timeout 5
EndCase
Return
********************
*Hata kodlarının tespiti
********************
Procedure ERRORINFO
LParameters dwError
Local szString, dwTemp, buflen, szErrorMessage,dwRet, Arguments
szString = space(2048)
dwTemp = 0
buflen = 2048
If (dwError = ERROR_INTERNET_EXTENDED_ERROR)
If InternetGetLastResponseInfo(@dwTemp, @szString, @buflen) # 0
Return SubStr(szString, 1, buflen)
Else
szString = Space(buflen)
InternetGetLastResponseInfo(@dwTemp, @szString, @buflen)
Return SubStr(szString, 1, buflen)
Endif
Else
lnRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM+FORMAT_MESSAGE_IGNORE_INSERTS, ;
0, dwError, 0, @szString, 2048, 0)
if lnRet # 0
szErrorMessage = "Error code: " + ;
TransForm(dwError) + " Message: " + SubStr(szString, 1, lnRet)
Return szErrorMessage
Endif
EndIf
Return ''
********************
Re: İnternetten dosya indirmek
Merhaba bana ftp ile dosya gönderme komutu lazım.yardımcı olursanız çok sevinirim...
- ugurlu2001
- Uzman Üye
- Offline
Re: İnternetten dosya indirmek
Aşağıdaki linkleri incelemeni öneririm :
http://activevfp.codeplex.com/
http://www.ctl32.com.ar/default.asp
Uğur
-------------------------------------------------------------------------------------------------------------
Hayat bir bisiklete binmek gibidir. Pedalı çevirmeye devam ettiğiniz sürece düşmezsiniz. Claude Peppeer
Kusuru söylenmeyen adam, ayıbını hüner sanır. Türk Atasözü
-------------------------------------------------------------------------------------------------------------
Hayat bir bisiklete binmek gibidir. Pedalı çevirmeye devam ettiğiniz sürece düşmezsiniz. Claude Peppeer
Kusuru söylenmeyen adam, ayıbını hüner sanır. Türk Atasözü
- birol
- Uzman Üye
- Offline
Re: İnternetten dosya indirmek
Bu kodla dosya indirebilirsin. Ayrıca dosya indirme sırasında progressbar göstermek istersen başka bir kod daha vardı, istersen bulabilirim.
Birde wget.exe'i kullanarak DOS'tan da dosya indirebilirsin.
Visual Fox Pro
xurl="www.espor.com/aa.zip"
xfilename="C:\aa.zip"
if getfilefromurl(xurl,xfilename)=0
? "OK"
else
? "HATA"
endif
************************
procedure getfilefromurl
lparameters tcremotefile,tclocalfile
declare integer URLDownloadToFile in urlmon.dll integer pCaller,string szURL,string szFileName,integer dwReserved,integer lpfnCB
return urldownloadtofile(0,m.tcremotefile,m.tclocalfile,0,0)
endproc
Re: İnternetten dosya indirmek
Birol, yazdığın kod harika çalışıyor süper. Teşekkürler.
Peki arkadaşlar, yukarıdaki örnekteki tek bir kütük yerine bir klasör ismini vererek tüm klasörün içeriğini kopyalatmak mümkün mü ?