İnternetten dosya indirmek

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

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

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

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

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

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