Fox4um - İnternetten dosya indirmek

Re: İnternetten dosya indirmek

2009-10-09T06:43:51Z

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

Re: İnternetten dosya indirmek

2009-08-28T20:17:07Z

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

2009-08-28T14:31:42Z

Aşağıdaki linkleri incelemeni öneririm :
http://activevfp.codeplex.com/
http://www.ctl32.com.ar/default.asp

Re: İnternetten dosya indirmek

2009-08-28T14:06:26Z

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

Re: İnternetten dosya indirmek

2007-02-05T15:24:22Z

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

2007-02-05T14:18:08Z

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

**************************************************

Re: İnternetten dosya indirmek

2007-02-05T12:49:21Z

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

Re: İnternetten dosya indirmek

2007-02-05T11:32:16Z

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

İnternetten dosya indirmek

2007-02-05T09:36:50Z

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.