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.
Giriş yapmadınız. Lütfen giriş yapın yada kayıt olun.
fox4um » Web Uygulamaları » İ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.
selam Bilal,
FTP get ile indirebilirsin
**********************************************************************************
*... 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 *************************************************************
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ı?
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
**************************************************
*-- 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
**************************************************
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 ''
********************
Merhaba bana ftp ile dosya gönderme komutu lazım.yardımcı olursanız çok sevinirim...
Aşağıdaki linkleri incelemeni öneririm :
http://activevfp.codeplex.com/
http://www.ctl32.com.ar/default.asp
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.
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
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ü ?
fox4um » Web Uygulamaları » İnternetten dosya indirmek