1

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.

2

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 *************************************************************
http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg

3

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ı?

4

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

www.espor.com/aa.zip

* 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

www.espor.com/aa.zip

* 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
**************************************************
http://www.soykansoft.com/images/twitter.jpghttp://www.soykansoft.com/images/wp.jpg

5

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 ''
********************

6

Re: İnternetten dosya indirmek

Merhaba bana ftp ile dosya gönderme komutu lazım.yardımcı olursanız çok sevinirim...

7

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ü

8

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

9

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ü ?