Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
FTP with VFP
Message
From
16/09/2004 10:19:58
Tc Holzer
Isle of Man
 
 
To
15/09/2004 21:41:51
Paul Pravong
Quebec, Canada
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Re: FTP with VFP
Miscellaneous
Thread ID:
00942691
Message ID:
00942901
Views:
552
I can't remember where I got this originally but it works. You can use it as is to test - the ftp site is valid, so is the file it downloads, and it does not require a login or password. To use it for your purposes, change the values at the top.
*--These values get changed
PRIVATE lcsite, lcuser, lcpassword, lcdir, lcremote, lclocal
lcsite = "ftp.funet.fi"
lcuser = ''
lcpassword = ''
lcdir = "pub/cbm/c128/programming/"
lcremote = "d-ass.txt"
lclocal = "c:\temp\test.txt"

*--Begin Program
IF FILE(lclocal)
	DELETE FILE (lclocal)
ENDIF

PRIVATE objFtp 
objFtp = CreateObject("Tftp") 

objFtp.FtpConnect(lcsite, lcuser, lcpassword) 

IF Not objFtp.IsConnected 
    WAIT WINDOW NOWAIT "Unable to connect" 
    RETURN 
ENDIF 

WITH objFtp 
    .SetCurrentDir(lcdir) 
    ? .GetCurrentDir() 
    .Dir2Cursor("cs") 
    * copy it to the c:\temp directory 
    IF .GetFromFtp(lcremote, lclocal) 
        MODI FILE (lclocal) NOWAIT 
*        BROWSE
    ENDIF 
ENDWITH 

DEFINE CLASS Tftp As clsFtp 
PROCEDURE OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten) 
    ?? "." 

FUNCTION BeforePutFile(lcLocalFile, lcRemoteFile) 
	* return .F. to cancel file transfer 
    ? lcLocalFile, "->", lcRemoteFile, "" 
RETURN .T. 

PROCEDURE AfterPutFile(lcLocalFile, lcRemoteFile, lResult) 
    ?? " Ok" 

FUNCTION BeforeGetFile(lcRemoteFile, lcLocalFile) 
	* return .F. to cancel file transfer 
    ? lcRemoteFile, "->", lcLocalFile, "" 
RETURN .T. 

PROCEDURE AfterGetFile(lcRemoteFile, lcLocalFile, lResult) 
    ?? " Ok" 

PROCEDURE OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesWritten) 
    ?? "." 

ENDDEFINE 

DEFINE CLASS clsFtp As Custom

#DEFINE INTERNET_OPEN_TYPE_DIRECT       1
#DEFINE INTERNET_INVALID_PORT_NUMBER    0
#DEFINE INTERNET_SERVICE_FTP            1
#DEFINE INTERNET_FLAG_NEED_FILE         16
#DEFINE FTP_TRANSFER_TYPE_ASCII         1
#DEFINE FTP_TRANSFER_TYPE_BINARY        2
#DEFINE FILE_ATTRIBUTE_READONLY         1
#DEFINE FILE_ATTRIBUTE_HIDDEN           2
#DEFINE FILE_ATTRIBUTE_SYSTEM           4
#DEFINE FILE_ATTRIBUTE_DIRECTORY        16
#DEFINE FILE_ATTRIBUTE_ARCHIVE          32
#DEFINE FILE_ATTRIBUTE_NORMAL           128
#DEFINE FILE_ATTRIBUTE_TEMPORARY        512
#DEFINE FILE_ATTRIBUTE_COMPRESSED       2048
#DEFINE FORMAT_MESSAGE_ALLOCATE_BUFFER  256
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM      4096
#DEFINE FORMAT_MESSAGE_IGNORE_INSERTS   512
#DEFINE GENERIC_READ                    2147483648   && 0x80000000
#DEFINE GENERIC_WRITE                   1073741824   && 0x40000000

	LastErr=0
	ErrMsg=""
	host=""
	usr=""
	pswd=""
	IsConnected=.F.
	hInternet=0
	hConn=0

PROCEDURE  Init
	DECLARE INTEGER InternetOpen IN wininet.dll;
		STRING sAgent, INTEGER lAccessType, STRING sProxyName,;
		STRING sProxyBypass, STRING lFlags  

	THIS.hInternet = InternetOpen ("VfpFtp 1.0", INTERNET_OPEN_TYPE_DIRECT, 0,0,0)
	IF THIS.hInternet = 0
		RETURN .F.
	ENDIF
	THIS.decl

PROCEDURE Destroy
	THIS.FtpDisconnect
	= InternetCloseHandle(THIS.hInternet)

PROCEDURE ClearError
	THIS.LastErr = 0
	THIS.ErrMsg = ""

PROCEDURE SetError()
	DECLARE INTEGER GetLastError IN kernel32 
	DECLARE INTEGER FormatMessage IN kernel32; 
		INTEGER dwFlags, INTEGER lpSource, INTEGER dwMsgId,; 
		INTEGER dwLangId, INTEGER @lpBuf, INTEGER nSz, INTEGER Args

	THIS.LastErr = GetLastError()

	LOCAL dwFlags, lpBuffer, lnLength
	dwFlags = FORMAT_MESSAGE_ALLOCATE_BUFFER +;
		FORMAT_MESSAGE_FROM_SYSTEM + FORMAT_MESSAGE_IGNORE_INSERTS

	lpBuffer = 0 
	lnLength = FormatMessage (dwFlags, 0, THIS.LastErr, 0, @lpBuffer, 0, 0) 
	IF lnLength <> 0 
		lpResult = REPLI (Chr(0), 500) 
		= CopyMemory (@lpResult, lpBuffer, lnLength) 
		THIS.ErrMsg = STRTRAN(LEFT(lpResult, lnLength), Chr(13)+Chr(10), "") 
	ELSE
		THIS.ErrMsg = "#undefined#"
	ENDIF 

FUNCTION FtpConnect(lcHost, lcUsr, lcPswd)
	THIS.FtpDisconnect

	DECLARE INTEGER InternetConnect IN wininet.dll;
		INTEGER hInetSession, STRING sSrvName, INTEGER nSrvPort,;  
		STRING sUsrname, STRING sPwd, INTEGER lService,;  
		INTEGER lFlags, INTEGER lContext  

	THIS.hConn = InternetConnect (THIS.hInternet, lcHost,;
		INTERNET_INVALID_PORT_NUMBER, lcUsr, lcPswd,;
		INTERNET_SERVICE_FTP, 0, 0)  

	IF THIS.hConn <> 0
		THIS.host = lcHost
		THIS.usr = lcUsr
		THIS.pswd = lcPswd
		THIS.IsConnected = .T.
	ELSE
		THIS.SetError()
	ENDIF

PROCEDURE FtpDisconnect
	IF THIS.IsConnected
		= InternetCloseHandle(THIS.hConn)
		STORE "" TO THIS.host, THIS.usr, THIS.pswd
		THIS.IsConnected = .F.
	ENDIF

FUNCTION GetCurrentDir
	if Not THIS.IsConnected
		THIS.SetError()
		RETURN "#not connected#"
	ELSE
		LOCAL lcDirectory, lnLen, lnResult
		lcDirectory = SPACE(250)   
		lnLen = Len(lcDirectory)
		lnResult = FtpGetCurrentDirectory (THIS.hConn, @lcDirectory, @lnLen)
		RETURN Iif (lnResult=1, LEFT(lcDirectory, lnLen), "#error#")
	ENDIF

FUNCTION SetCurrentDir(lcDir)
	if Not THIS.IsConnected
		RETURN .F.
	ELSE
		IF (FtpSetCurrentDirectory (THIS.hConn, @lcDir) = 1)
			RETURN .T.
		ELSE
			THIS.SetError()
			RETURN .F.
		ENDIF
	ENDIF

FUNCTION RemoveDir(lcDir)
	IF Not DirExists(lcDir)
		RETURN .T.
	ENDIF
	DECLARE INTEGER FtpRemoveDirectory IN wininet;
		INTEGER hConnect, STRING lpszDirectory
RETURN (FtpRemoveDirectory(THIS.hConn, lcDir) = 1)

FUNCTION CreateDir(lcDir)
	IF DirExists(lcDir)
		RETURN .F.
	ENDIF
	DECLARE INTEGER FtpCreateDirectory IN wininet;
		INTEGER hFtpSession, STRING lpszDirectory 
RETURN (FtpCreateDirectory(THIS.hConn, lcDir) = 1)

FUNCTION DirExists(lcDir)
	IF Not THIS.IsConnected
		RETURN .F.
	ELSE
		LOCAL lcCurrentDir
		lcCurrentDir = THIS.GetCurrentDir()

		IF THIS.SetCurrentDir(lcDir)
			THIS.SetCurrentDir(lcCurrentDir)
			RETURN .T.
		ELSE
			RETURN .F.
		ENDIF
	ENDIF

FUNCTION  Dir2Cursor(lcCursor)
	LOCAL lcFullPath, lcFullName, W32struct, lpFndFile, hFind, lnResult
	lcFullPath = THIS.GetCurrentDir()

	* create the cursor
	IF TYPE("lcCursor") <> "C"
		lcCursor = "ftpquery"
	ENDIF

	CREATE CURSOR (lcCursor) (;
		filename   C(250),;
		filesize   N(12),;
		created    T,;
		accessed   T,;
		modified   T,;
		fileattrib N(12),;
		rdonlyfile L,;
		hiddenfile L,;
		sysfile    L,;
		folder     L,;
		archfile   L,;
		normalfile L,;
		tempfile   L,;
		compressed L,;
		rootpath   M;
	)

	* object simulating the WIN32_FIND_DATA structure 
	W32struct = CreateObject("struct_WIN32_FIND_DATA") 

	* starting from the first file found
	lpFndFile = Repli(Chr(0), 320)
	hFind = FtpFindFirstFile (THIS.hConn, "*.*",;
		@lpFndFile, INTERNET_FLAG_NEED_FILE, 0)

	IF hFind = 0  
		lnResult = -1
	ELSE
		DO WHILE .T.  
			W32struct.setValue (lpFndFile) 
			DO CASE
			CASE W32struct.filename == ".." 
				lcFullName = SUBSTR (lcFullPath, 1, RAT("/", lcFullPath)-1)
			CASE W32struct.filename == "." 
				lcFullName = lcFullPath
			OTHER
				lcFullName = lcFullPath + "/" + W32struct.filename
			ENDCASE
			lcFullName = STRTRAN(lcFullName, "//","/")

			WITH W32struct
				INSERT INTO (lcCursor) VALUES (;
					.filename, .filesizelo, .creationtime, .lastaccesstime,;
					.lastwritetime, .fileattributes, .IsRdOnly(), .IsHidden(),;
					.IsSystem(), .IsDirectory(), .IsArchive(), .IsNormal(),;
					.IsTemporary(), .IsCompressed(), lcFullName;
			)
			ENDWITH
			IF InternetFindNextFile(hFind, @lpFndFile) <> 1  
				EXIT  
			ENDIF  
		ENDDO  
		lnResult = RECCOUNT(lcCursor)
		GO TOP IN (lcCursor)
		= InternetCloseHandle(hFind)  
	ENDIF  
	RELEASE W32struct  
RETURN lnResult

FUNCTION BeforePutFile(lcLocalFile, lcRemoteFile)
* virtual; return .F. to cancel file transfer
RETURN .T.

PROCEDURE AfterPutFile(lcLocalFile, lcRemoteFile, lResult)
* virtual

PROCEDURE OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten)
* virtual

FUNCTION PutToFtp(lcLocalFile, lcRemoteFile, lnChunkSize)
	IF Not (THIS.IsConnected And FILE(lcLocalFile))
		RETURN .F.
	ENDIF

	IF TYPE("lcRemoteFile") <> "C" Or EMPTY(lcRemoteFile)
		lcRemoteFile = SUBSTR(lcLocalFile, RAT("\",lcLocalFile)+1)
	ENDIF
		
	IF Not THIS.BeforePutFile(lcLocalFile, lcRemoteFile)
		RETURN .F.
	ENDIF

	LOCAL lResult
	IF TYPE("lnChunkSize") = "N" And lnChunkSize > 0
		lResult = THIS.PutToFtp1(lcLocalFile, lcRemoteFile, lnChunkSize)
	ELSE
		lResult = (FtpPutFile(THIS.hConn, lcLocalFile, lcRemoteFile,;
			FTP_TRANSFER_TYPE_BINARY, 0) = 1)
	ENDIF
	THIS.AfterPutFile(lcLocalFile, lcRemoteFile, lResult)
RETURN lResult

PROTECTED FUNCTION PutToFtp1(lcLocalFile, lcRemoteFile, lnChunkSize)
* copying local file to the remote target by small portions
	LOCAL hLocal, hRemote, lnBytesWritten, lcBuffer, lnLength
	lnBytesWritten = 0
	hLocal = FOPEN(lcLocalFile)
	IF (hLocal = -1) 
		RETURN .F.
	ENDIF

	hRemote = FtpOpenFile(THIS.hConn, lcRemoteFile, GENERIC_WRITE,;
		FTP_TRANSFER_TYPE_BINARY, 0)

	IF hRemote = 0
		= FCLOSE(hLocal)
		RETURN .F.
	ENDIF

	DO WHILE Not FEOF(hLocal)
		lcBuffer = FREAD(hLocal, lnChunkSize)
		lnLength = Len(lcBuffer)
		IF lnLength > 0
			IF InternetWriteFile(hRemote, @lcBuffer, lnLength, @lnLength) = 1
				lnBytesWritten = lnBytesWritten + lnLength
				THIS.OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten)
			ELSE
				EXIT
			ENDIF
		ELSE
			EXIT
		ENDIF
	ENDDO
	= InternetCloseHandle(hRemote)
	= FCLOSE(hLocal)
RETURN .T.

FUNCTION BeforeGetFile(lcRemoteFile, lcLocalFile)
* virtual; return .F. to cancel file transfer
RETURN .T.

PROCEDURE AfterGetFile(lcRemoteFile, lcLocalFile, lResult)
* virtual

PROCEDURE OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesWritten)
* virtual

FUNCTION GetFromFtp (lcRemoteFile, lcLocalFile, lnChunkSize)
	IF Not THIS.IsConnected
		RETURN .F.
	ENDIF

	IF TYPE("lcLocalFile") <> "C" Or EMPTY(lcLocalFile)
		lcLocalFile = SUBSTR(lcRemoteFile, RAT("/",lcRemoteFile)+1)
		lcLocalFile = FULLPATH(lcLocalFile)
	ENDIF

	IF Not THIS.BeforeGetFile(lcRemoteFile, lcLocalFile)
		RETURN .F.
	ENDIF

	LOCAL lResult
	IF TYPE("lnChunkSize") = "N" And lnChunkSize > 0
		lResult = THIS.GetFromFtp1(lcRemoteFile, lcLocalFile, lnChunkSize)
	ELSE
		lResult = (FtpGetFile(THIS.hConn, lcRemoteFile, lcLocalFile,; 
			0, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY, 0) = 1)
	ENDIF
	THIS.AfterGetFile(lcRemoteFile, lcLocalFile, lResult)
RETURN lResult

PROTECTED FUNCTION GetFromFtp1(lcRemoteFile, lcLocalFile, lnChunkSize)
	LOCAL hRemote, hLocal, lnBytesRead, lcBuffer, lnBufSize
	hLocal = FCREATE (lcLocalFile)
	IF hLocal = -1
		RETURN .F.
	ENDIF
	
	hRemote = FtpOpenFile(THIS.hConn, lcRemoteFile, GENERIC_READ,;
		FTP_TRANSFER_TYPE_BINARY, 0)

	IF hRemote = 0
		FCLOSE(hLocal)
		RETURN .F.
	ENDIF
	
	lnBytesRead = 0
	DO WHILE .T.
		lcBuffer = Repli(Chr(0), lnChunkSize)
		lnBufSize = lnChunkSize
		IF InternetReadFile(hRemote, @lcBuffer, lnBufSize, @lnBufSize) = 1
			IF lnBufSize <> 0
				= FWRITE (hLocal, lcBuffer, lnBufSize)
				lnBytesRead = lnBytesRead + lnBufSize
				THIS.OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesRead)
			ELSE
				EXIT
			ENDIF
		ELSE
			EXIT
		ENDIF
	ENDDO
	= InternetCloseHandle(hRemote)
	= FCLOSE(hLocal)
RETURN .T.

PROCEDURE decl
	DECLARE INTEGER InternetCloseHandle IN wininet.dll INTEGER hInet  

	DECLARE RtlMoveMemory IN kernel32 As CopyMemory; 
		STRING @Destination, INTEGER Source, INTEGER nLength 

	DECLARE INTEGER FtpGetCurrentDirectory IN wininet.dll; 
		INTEGER  hFtpSession, STRING @lpszDir, INTEGER @lpdwCurDir 

	DECLARE INTEGER FtpSetCurrentDirectory IN wininet.dll; 
		INTEGER  hFtpSession, STRING @lpszDir

	DECLARE INTEGER FtpFindFirstFile IN wininet.dll;  
		INTEGER hFtpSession, STRING lpszSrchFile,;  
		STRING @lpFindFileData, INTEGER dwFlags, INTEGER dwContent  

	DECLARE INTEGER InternetFindNextFile IN wininet.dll;  
		INTEGER hFind, STRING @lpvFindData

	DECLARE INTEGER FileTimeToSystemTime IN kernel32.dll; 
		STRING @lpFileTime, STRING @lpSystemTime

	DECLARE INTEGER FtpOpenFile IN wininet;
		INTEGER hFtpSession, STRING sFileName, INTEGER lAccess,;
		INTEGER lFlags, INTEGER lContext

	DECLARE INTEGER FtpPutFile IN wininet.dll;  
		INTEGER hConnect, STRING lpszLocalFile,;  
		STRING lpszNewRmtFile, INTEGER dwFlags, INTEGER dwContext

	DECLARE INTEGER FtpGetFile IN wininet;
		INTEGER hConnect, STRING lpszRemoteFile,;
		STRING  lpszNewFile, INTEGER fFailIfExists,;
		INTEGER dwFlagsAndAttr, INTEGER dwFlags, INTEGER dwContext

	DECLARE INTEGER InternetWriteFile IN wininet;
		INTEGER hFile, STRING @sBuffer,;
		INTEGER lBytesToWrite, INTEGER @dwBytesWritten

	DECLARE INTEGER InternetReadFile IN wininet.dll;
		INTEGER hFile, STRING @lpBuffer,;
		INTEGER dwNumberOfBytesToRead, INTEGER @dwBytesRead

ENDDEFINE

DEFINE CLASS struct_WIN32_FIND_DATA As Custom  
* this class emulates WIN32_FIND_DATA structure  
	value			 = ""  
	fileAttributes   = 0  
	creationTimeLo   = 0  
	creationTimeHi   = 0  
	lastAccessTimeHi = 0  
	lastAccessTimeLo = 0  
	lastWriteTimeHi  = 0  
	lastWriteTimeLo  = 0  
	fileSizeLo		 = 0 && fileSizeHi omitted 
	fileName		 = ""  
	creationTime	 = CTOT ("") 
	lastAccessTime   = CTOT ("") 
	lastWriteTime	 = CTOT ("") 

PROCEDURE  setValue (lcValue)	  
* translates the buffer"s content into the object"s properties 
	THIS.value			  = lcValue  
	THIS.fileAttributes   = THIS.buf2num (THIS.value,  0, 4)  
	THIS.creationTimeLo   = THIS.buf2num (THIS.value,  4, 4)  
	THIS.creationTimeHi   = THIS.buf2num (THIS.value,  8, 4)  
	THIS.lastAccessTimeHi = THIS.buf2num (THIS.value, 12, 4)  
	THIS.lastAccessTimeLo = THIS.buf2num (THIS.value, 16, 4)  
	THIS.lastWriteTimeHi  = THIS.buf2num (THIS.value, 20, 4)  
	THIS.lastWriteTimeLo  = THIS.buf2num (THIS.value, 24, 4)  
	THIS.fileSizeLo		  = THIS.buf2num (THIS.value, 32, 4)  
	THIS.creationTime	  = THIS.ftime2dtime (SUBSTR(THIS.value,  5, 8)) 
	THIS.lastAccessTime   = THIS.ftime2dtime (SUBSTR(THIS.value, 13, 8)) 
	THIS.lastWriteTime	  = THIS.ftime2dtime (SUBSTR(THIS.value, 21, 8)) 
	THIS.fileName		  = ALLTRIM(SUBSTR(THIS.value, 45,250))  
	IF AT(Chr(0), THIS.fileName) <> 0  
		THIS.fileName = SUBSTR (THIS.fileName, 1, AT(Chr(0), THIS.fileName)-1)  
	ENDIF  

FUNCTION AttribSet (lnAttrib)
RETURN BitAnd(THIS.fileAttributes, lnAttrib) = lnAttrib

FUNCTION IsRdOnly
RETURN THIS.AttribSet(FILE_ATTRIBUTE_READONLY)

FUNCTION IsHidden
RETURN THIS.AttribSet(FILE_ATTRIBUTE_HIDDEN)

FUNCTION IsSystem
RETURN THIS.AttribSet(FILE_ATTRIBUTE_SYSTEM)

FUNCTION IsDirectory
RETURN THIS.AttribSet(FILE_ATTRIBUTE_DIRECTORY)

FUNCTION IsArchive
RETURN THIS.AttribSet(FILE_ATTRIBUTE_ARCHIVE)

FUNCTION IsNormal
RETURN THIS.AttribSet(FILE_ATTRIBUTE_NORMAL)

FUNCTION IsTemporary
RETURN THIS.AttribSet(FILE_ATTRIBUTE_TEMPORARY)

FUNCTION IsCompressed
RETURN THIS.AttribSet(FILE_ATTRIBUTE_COMPRESSED)

FUNCTION buf2num(lcBuffer, lnOffset, lnBytes) 
* converts N bytes from the buffer into a numeric value  
	lnResult = 0   
	FOR ii=1 TO lnBytes 
		lnResult = lnResult +;   
			BitLShift(Asc(SUBSTR(lcBuffer, lnOffset+ii, 1)), (ii-1)*8)
	ENDFOR   
RETURN lnResult  

FUNCTION  ftime2dtime (lcFileTime) 
	LOCAL lcSystemTime, ltResult, lcStoredSet
	IF lcFileTime = REPLI (Chr(0), 8)
		ltResult = CTOT ("")
	ELSE
		lcSystemTime = REPLI (Chr(0), 16) 
		= FileTimeToSystemTime (@lcFileTime, @lcSystemTime) 
		wYear   = THIS.buf2num (lcSystemTime,  0, 2) 
		wMonth  = THIS.buf2num (lcSystemTime,  2, 2) 
		wDay	= THIS.buf2num (lcSystemTime,  6, 2) 
		wHour   = THIS.buf2num (lcSystemTime,  8, 2) 
		wMinute = THIS.buf2num (lcSystemTime, 10, 2) 
		wSecond = THIS.buf2num (lcSystemTime, 12, 2) 

		lcStoredSet = SET ("DATE") 
		SET DATE TO MDY 
		lcDate = STRTRAN (STR(wMonth,2) + "/" + STR(wDay,2) + "/" + STR(wYear,4), " ","0") 
		lcTime = STRTRAN (STR(wHour,2) + ":" + STR(wMinute,2) + ":" + STR(wSecond,2), " ","0") 
		ltResult = CTOT (lcDate + " " + lcTime) 
		SET DATE TO &lcStoredSet 
	ENDIF
RETURN ltResult 
ENDDEFINE


*******************************
FUNCTION FtpConnect(lcHost, lcUsr, lcPswd)
PROCEDURE FtpDisconnect
PROPERTY IsConnected

FUNCTION GetCurrentDir
FUNCTION SetCurrentDir(lcDir)

FUNCTION RemoveDir(lcDir)
FUNCTION CreateDir(lcDir)
FUNCTION DirExists(lcDir)

FUNCTION Dir2Cursor(lcCursor)

FUNCTION PutToFtp(lcLocalFile, lcRemoteFile, lnChunkSize)
FUNCTION GetFromFtp(lcRemoteFile, lcLocalFile, lnChunkSize)

FUNCTION BeforePutFile(lcLocalFile, lcRemoteFile)
PROCEDURE AfterPutFile(lcLocalFile, lcRemoteFile, lResult)
PROCEDURE OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten)

FUNCTION BeforeGetFile(lcRemoteFile, lcLocalFile)
PROCEDURE AfterGetFile(lcRemoteFile, lcLocalFile, lResult)
PROCEDURE OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesWritten)

*******************************************
 
DEFINE CLASS clsFtp As Custom 

#DEFINE INTERNET_OPEN_TYPE_DIRECT       1 
#DEFINE INTERNET_INVALID_PORT_NUMBER    0 
#DEFINE INTERNET_SERVICE_FTP            1 
#DEFINE INTERNET_FLAG_NEED_FILE         16 
#DEFINE FTP_TRANSFER_TYPE_ASCII         1 
#DEFINE FTP_TRANSFER_TYPE_BINARY        2 
#DEFINE FILE_ATTRIBUTE_READONLY         1 
#DEFINE FILE_ATTRIBUTE_HIDDEN           2 
#DEFINE FILE_ATTRIBUTE_SYSTEM           4 
#DEFINE FILE_ATTRIBUTE_DIRECTORY        16 
#DEFINE FILE_ATTRIBUTE_ARCHIVE          32 
#DEFINE FILE_ATTRIBUTE_NORMAL           128 
#DEFINE FILE_ATTRIBUTE_TEMPORARY        512 
#DEFINE FILE_ATTRIBUTE_COMPRESSED       2048 
#DEFINE FORMAT_MESSAGE_ALLOCATE_BUFFER  256 
#DEFINE FORMAT_MESSAGE_FROM_SYSTEM      4096 
#DEFINE FORMAT_MESSAGE_IGNORE_INSERTS   512 
#DEFINE GENERIC_READ                    2147483648   && 0x80000000 
#DEFINE GENERIC_WRITE                   1073741824   && 0x40000000 

    LastErr=0 
    ErrMsg="" 
    host="" 
    usr="" 
    pswd="" 
    IsConnected=.F. 
    hInternet=0 
    hConn=0 

PROCEDURE  Init 
    DECLARE INTEGER InternetOpen IN wininet.dll; 
        STRING sAgent, INTEGER lAccessType, STRING sProxyName,; 
        STRING sProxyBypass, STRING lFlags   

    THIS.hInternet = InternetOpen ("VfpFtp 1.0", INTERNET_OPEN_TYPE_DIRECT, 0,0,0) 
    IF THIS.hInternet = 0 
        RETURN .F. 
    ENDIF 
    THIS.decl 

PROCEDURE Destroy 
    THIS.FtpDisconnect 
    = InternetCloseHandle(THIS.hInternet) 

PROCEDURE ClearError 
    THIS.LastErr = 0 
    THIS.ErrMsg = "" 

PROCEDURE SetError() 
    DECLARE INTEGER GetLastError IN kernel32 
    DECLARE INTEGER FormatMessage IN kernel32; 
        INTEGER dwFlags, INTEGER lpSource, INTEGER dwMsgId,; 
        INTEGER dwLangId, INTEGER @lpBuf, INTEGER nSz, INTEGER Args 

    THIS.LastErr = GetLastError() 

    LOCAL dwFlags, lpBuffer, lnLength 
    * specifying format parameters 
    dwFlags = FORMAT_MESSAGE_ALLOCATE_BUFFER +; 
        FORMAT_MESSAGE_FROM_SYSTEM + FORMAT_MESSAGE_IGNORE_INSERTS 

    lpBuffer = 0 
    lnLength = FormatMessage (dwFlags, 0, THIS.LastErr, 0, @lpBuffer, 0, 0) 
    IF lnLength <> 0 
        lpResult = REPLI (Chr(0), 500) 
        = CopyMemory (@lpResult, lpBuffer, lnLength) 
        THIS.ErrMsg = STRTRAN(LEFT(lpResult, lnLength), Chr(13)+Chr(10), "") 
    ELSE 
        THIS.ErrMsg = "#undefined#" 
    ENDIF 

FUNCTION FtpConnect(lcHost, lcUsr, lcPswd) 
    THIS.FtpDisconnect 

    DECLARE INTEGER InternetConnect IN wininet.dll; 
        INTEGER hInetSession, STRING sSrvName, INTEGER nSrvPort,;   
        STRING sUsrname, STRING sPwd, INTEGER lService,;   
        INTEGER lFlags, INTEGER lContext   

    THIS.hConn = InternetConnect (THIS.hInternet, lcHost,; 
        INTERNET_INVALID_PORT_NUMBER, lcUsr, lcPswd,; 
        INTERNET_SERVICE_FTP, 0, 0)   

    IF THIS.hConn <> 0 
        THIS.host = lcHost 
        THIS.usr = lcUsr 
        THIS.pswd = lcPswd 
        THIS.IsConnected = .T. 
    ELSE 
        THIS.SetError() 
    ENDIF 

PROCEDURE FtpDisconnect 
    IF THIS.IsConnected 
        = InternetCloseHandle(THIS.hConn) 
        STORE "" TO THIS.host, THIS.usr, THIS.pswd 
        THIS.IsConnected = .F. 
    ENDIF 

FUNCTION GetCurrentDir 
    if Not THIS.IsConnected 
        THIS.SetError() 
        RETURN "#not connected#" 
    ELSE 
        LOCAL lcDirectory, lnLen, lnResult 
        lcDirectory = SPACE(250)    
        lnLen = Len(lcDirectory) 
        lnResult = FtpGetCurrentDirectory (THIS.hConn, @lcDirectory, @lnLen) 
        RETURN Iif (lnResult=1, LEFT(lcDirectory, lnLen), "#error#") 
    ENDIF 

FUNCTION SetCurrentDir(lcDir) 
    if Not THIS.IsConnected 
        RETURN .F. 
    ELSE 
        IF (FtpSetCurrentDirectory (THIS.hConn, @lcDir) = 1) 
            RETURN .T. 
        ELSE 
            THIS.SetError() 
            RETURN .F. 
        ENDIF 
    ENDIF 

FUNCTION RemoveDir(lcDir) 
    IF Not DirExists(lcDir) 
        RETURN .T. 
    ENDIF 
    DECLARE INTEGER FtpRemoveDirectory IN wininet; 
        INTEGER hConnect, STRING lpszDirectory 
RETURN (FtpRemoveDirectory(THIS.hConn, lcDir) = 1) 

FUNCTION CreateDir(lcDir) 
    IF DirExists(lcDir) 
        RETURN .F. 
    ENDIF 
    DECLARE INTEGER FtpCreateDirectory IN wininet; 
        INTEGER hFtpSession, STRING lpszDirectory 
RETURN (FtpCreateDirectory(THIS.hConn, lcDir) = 1) 

FUNCTION DirExists(lcDir) 
    IF Not THIS.IsConnected 
        RETURN .F. 
    ELSE 
        LOCAL lcCurrentDir 
        lcCurrentDir = THIS.GetCurrentDir() 

        IF THIS.SetCurrentDir(lcDir) 
            THIS.SetCurrentDir(lcCurrentDir) 
            RETURN .T. 
        ELSE 
            RETURN .F. 
        ENDIF 
    ENDIF 

FUNCTION  Dir2Cursor(lcCursor) 
    LOCAL lcFullPath, lcFullName, W32struct, lpFndFile, hFind, lnResult 
    lcFullPath = THIS.GetCurrentDir() 

    * create the cursor 
    IF TYPE("lcCursor") <> "C" 
        lcCursor = "ftpquery" 
    ENDIF 

    CREATE CURSOR (lcCursor) (; 
        filename   C(250),; 
        filesize   N(12),; 
        created    T,; 
        accessed   T,; 
        modified   T,; 
        fileattrib N(12),; 
        rdonlyfile L,; 
        hiddenfile L,; 
        sysfile    L,; 
        folder     L,; 
        archfile   L,; 
        normalfile L,; 
        tempfile   L,; 
        compressed L,; 
        rootpath   M; 
    ) 

    * object simulating the WIN32_FIND_DATA structure 
    W32struct = CreateObject("struct_WIN32_FIND_DATA") 

    * starting from the first file found 
    lpFndFile = Repli(Chr(0), 320) 
    hFind = FtpFindFirstFile (THIS.hConn, "*.*",; 
        @lpFndFile, INTERNET_FLAG_NEED_FILE, 0) 

    IF hFind = 0   
        lnResult = -1 
    ELSE 
        DO WHILE .T.   
            W32struct.setValue (lpFndFile) 
            DO CASE 
            CASE W32struct.filename == ".." 
                lcFullName = SUBSTR (lcFullPath, 1, RAT("/", lcFullPath)-1) 
            CASE W32struct.filename == "." 
                lcFullName = lcFullPath 
            OTHER 
                lcFullName = lcFullPath + "/" + W32struct.filename 
            ENDCASE 
            lcFullName = STRTRAN(lcFullName, "//","/") 

            WITH W32struct 
                INSERT INTO (lcCursor) VALUES (; 
                    .filename, .filesizelo, .creationtime, .lastaccesstime,; 
                    .lastwritetime, .fileattributes, .IsRdOnly(), .IsHidden(),; 
                    .IsSystem(), .IsDirectory(), .IsArchive(), .IsNormal(),; 
                    .IsTemporary(), .IsCompressed(), lcFullName; 
            ) 
            ENDWITH 
            IF InternetFindNextFile(hFind, @lpFndFile) <> 1   
                EXIT   
            ENDIF   
        ENDDO   
        lnResult = RECCOUNT(lcCursor) 
        GO TOP IN (lcCursor) 
        = InternetCloseHandle(hFind)   
    ENDIF   
    RELEASE W32struct   
RETURN lnResult 

FUNCTION BeforePutFile(lcLocalFile, lcRemoteFile) 
* virtual; return .F. to cancel file transfer 
RETURN .T. 

PROCEDURE AfterPutFile(lcLocalFile, lcRemoteFile, lResult) 
* virtual 

PROCEDURE OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten) 
* virtual 

FUNCTION PutToFtp(lcLocalFile, lcRemoteFile, lnChunkSize) 
    IF Not (THIS.IsConnected And FILE(lcLocalFile)) 
        RETURN .F. 
    ENDIF 

    IF TYPE("lcRemoteFile") <> "C" Or EMPTY(lcRemoteFile) 
        lcRemoteFile = SUBSTR(lcLocalFile, RAT("\",lcLocalFile)+1) 
    ENDIF 
         
    IF Not THIS.BeforePutFile(lcLocalFile, lcRemoteFile) 
        RETURN .F. 
    ENDIF 

    LOCAL lResult 
    IF TYPE("lnChunkSize") = "N" And lnChunkSize > 0 
        lResult = THIS.PutToFtp1(lcLocalFile, lcRemoteFile, lnChunkSize) 
    ELSE 
        lResult = (FtpPutFile(THIS.hConn, lcLocalFile, lcRemoteFile,; 
            FTP_TRANSFER_TYPE_BINARY, 0) = 1) 
    ENDIF 
    THIS.AfterPutFile(lcLocalFile, lcRemoteFile, lResult) 
RETURN lResult 

PROTECTED FUNCTION PutToFtp1(lcLocalFile, lcRemoteFile, lnChunkSize) 
* copying local file to the remote target by small portions 
    LOCAL hLocal, hRemote, lnBytesWritten, lcBuffer, lnLength 
    lnBytesWritten = 0 
    hLocal = FOPEN(lcLocalFile) 
    IF (hLocal = -1) 
        RETURN .F. 
    ENDIF 

    hRemote = FtpOpenFile(THIS.hConn, lcRemoteFile, GENERIC_WRITE,; 
        FTP_TRANSFER_TYPE_BINARY, 0) 

    IF hRemote = 0 
        = FCLOSE(hLocal) 
        RETURN .F. 
    ENDIF 

    DO WHILE Not FEOF(hLocal) 
        lcBuffer = FREAD(hLocal, lnChunkSize) 
        lnLength = Len(lcBuffer) 
        IF lnLength > 0 
            IF InternetWriteFile(hRemote, @lcBuffer, lnLength, @lnLength) = 1 
                lnBytesWritten = lnBytesWritten + lnLength 
                THIS.OnPutChunk(lcLocalFile, lcRemoteFile, lnBytesWritten) 
            ELSE 
                EXIT 
            ENDIF 
        ELSE 
            EXIT 
        ENDIF 
    ENDDO 
    = InternetCloseHandle(hRemote) 
    = FCLOSE(hLocal) 
RETURN .T. 

FUNCTION BeforeGetFile(lcRemoteFile, lcLocalFile) 
* virtual; return .F. to cancel file transfer 
RETURN .T. 

PROCEDURE AfterGetFile(lcRemoteFile, lcLocalFile, lResult) 
* virtual 

PROCEDURE OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesWritten) 
* virtual 

FUNCTION GetFromFtp (lcRemoteFile, lcLocalFile, lnChunkSize) 
    IF Not THIS.IsConnected 
        RETURN .F. 
    ENDIF 

    IF TYPE("lcLocalFile") <> "C" Or EMPTY(lcLocalFile) 
        lcLocalFile = SUBSTR(lcRemoteFile, RAT("/",lcRemoteFile)+1) 
        lcLocalFile = FULLPATH(lcLocalFile) 
    ENDIF 

    IF Not THIS.BeforeGetFile(lcRemoteFile, lcLocalFile) 
        RETURN .F. 
    ENDIF 

    LOCAL lResult 
    IF TYPE("lnChunkSize") = "N" And lnChunkSize > 0 
        lResult = THIS.GetFromFtp1(lcRemoteFile, lcLocalFile, lnChunkSize) 
    ELSE 
        lResult = (FtpGetFile(THIS.hConn, lcRemoteFile, lcLocalFile,; 
            0, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY, 0) = 1) 
    ENDIF 
    THIS.AfterGetFile(lcRemoteFile, lcLocalFile, lResult) 
RETURN lResult 

PROTECTED FUNCTION GetFromFtp1(lcRemoteFile, lcLocalFile, lnChunkSize) 
    LOCAL hRemote, hLocal, lnBytesRead, lcBuffer, lnBufSize 
    hLocal = FCREATE (lcLocalFile) 
    IF hLocal = -1 
        RETURN .F. 
    ENDIF 
     
    hRemote = FtpOpenFile(THIS.hConn, lcRemoteFile, GENERIC_READ,; 
        FTP_TRANSFER_TYPE_BINARY, 0) 

    IF hRemote = 0 
        FCLOSE(hLocal) 
        RETURN .F. 
    ENDIF 
     
    lnBytesRead = 0 
    DO WHILE .T. 
        lcBuffer = Repli(Chr(0), lnChunkSize) 
        lnBufSize = lnChunkSize 
        IF InternetReadFile(hRemote, @lcBuffer, lnBufSize, @lnBufSize) = 1 
            IF lnBufSize <> 0 
                = FWRITE (hLocal, lcBuffer, lnBufSize) 
                lnBytesRead = lnBytesRead + lnBufSize 
                THIS.OnGetChunk(lcRemoteFile, lcLocalFile, lnBytesRead) 
            ELSE 
                EXIT 
            ENDIF 
        ELSE 
            EXIT 
        ENDIF 
    ENDDO 
    = InternetCloseHandle(hRemote) 
    = FCLOSE(hLocal) 
RETURN .T. 

PROCEDURE decl 
    DECLARE INTEGER InternetCloseHandle IN wininet.dll INTEGER hInet   

    DECLARE RtlMoveMemory IN kernel32 As CopyMemory; 
        STRING @Destination, INTEGER Source, INTEGER nLength 

    DECLARE INTEGER FtpGetCurrentDirectory IN wininet.dll; 
        INTEGER  hFtpSession, STRING @lpszDir, INTEGER @lpdwCurDir 

    DECLARE INTEGER FtpSetCurrentDirectory IN wininet.dll; 
        INTEGER  hFtpSession, STRING @lpszDir 

    DECLARE INTEGER FtpFindFirstFile IN wininet.dll;   
        INTEGER hFtpSession, STRING lpszSrchFile,;   
        STRING @lpFindFileData, INTEGER dwFlags, INTEGER dwContent   

    DECLARE INTEGER InternetFindNextFile IN wininet.dll;   
        INTEGER hFind, STRING @lpvFindData 

    DECLARE INTEGER FileTimeToSystemTime IN kernel32.dll; 
        STRING @lpFileTime, STRING @lpSystemTime 

    DECLARE INTEGER FtpOpenFile IN wininet; 
        INTEGER hFtpSession, STRING sFileName, INTEGER lAccess,; 
        INTEGER lFlags, INTEGER lContext 

    DECLARE INTEGER FtpPutFile IN wininet.dll;   
        INTEGER hConnect, STRING lpszLocalFile,;   
        STRING lpszNewRmtFile, INTEGER dwFlags, INTEGER dwContext 

    DECLARE INTEGER FtpGetFile IN wininet; 
        INTEGER hConnect, STRING lpszRemoteFile,; 
        STRING  lpszNewFile, INTEGER fFailIfExists,; 
        INTEGER dwFlagsAndAttr, INTEGER dwFlags, INTEGER dwContext 

    DECLARE INTEGER InternetWriteFile IN wininet; 
        INTEGER hFile, STRING @sBuffer,; 
        INTEGER lBytesToWrite, INTEGER @dwBytesWritten 

    DECLARE INTEGER InternetReadFile IN wininet.dll; 
        INTEGER hFile, STRING @lpBuffer,; 
        INTEGER dwNumberOfBytesToRead, INTEGER @dwBytesRead 

ENDDEFINE 

DEFINE CLASS struct_WIN32_FIND_DATA As Custom   
* this class emulates WIN32_FIND_DATA structure   
    value             = ""   
    fileAttributes   = 0   
    creationTimeLo   = 0   
    creationTimeHi   = 0   
    lastAccessTimeHi = 0   
    lastAccessTimeLo = 0   
    lastWriteTimeHi  = 0   
    lastWriteTimeLo  = 0   
    fileSizeLo         = 0 && fileSizeHi omitted 
    fileName         = ""   
    creationTime     = CTOT ("") 
    lastAccessTime   = CTOT ("") 
    lastWriteTime     = CTOT ("") 

PROCEDURE  setValue (lcValue)       
* translates the buffer"s content into the object"s properties 
    THIS.value              = lcValue   
    THIS.fileAttributes   = THIS.buf2num (THIS.value,  0, 4)   
    THIS.creationTimeLo   = THIS.buf2num (THIS.value,  4, 4)   
    THIS.creationTimeHi   = THIS.buf2num (THIS.value,  8, 4)   
    THIS.lastAccessTimeHi = THIS.buf2num (THIS.value, 12, 4)   
    THIS.lastAccessTimeLo = THIS.buf2num (THIS.value, 16, 4)   
    THIS.lastWriteTimeHi  = THIS.buf2num (THIS.value, 20, 4)   
    THIS.lastWriteTimeLo  = THIS.buf2num (THIS.value, 24, 4)   
    THIS.fileSizeLo          = THIS.buf2num (THIS.value, 32, 4)   
    THIS.creationTime      = THIS.ftime2dtime (SUBSTR(THIS.value,  5, 8)) 
    THIS.lastAccessTime   = THIS.ftime2dtime (SUBSTR(THIS.value, 13, 8)) 
    THIS.lastWriteTime      = THIS.ftime2dtime (SUBSTR(THIS.value, 21, 8)) 
    THIS.fileName          = ALLTRIM(SUBSTR(THIS.value, 45,250))   
    IF AT(Chr(0), THIS.fileName) <> 0   
        THIS.fileName = SUBSTR (THIS.fileName, 1, AT(Chr(0), THIS.fileName)-1)   
    ENDIF   

FUNCTION AttribSet (lnAttrib) 
RETURN BitAnd(THIS.fileAttributes, lnAttrib) = lnAttrib 

FUNCTION IsRdOnly 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_READONLY) 

FUNCTION IsHidden 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_HIDDEN) 

FUNCTION IsSystem 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_SYSTEM) 

FUNCTION IsDirectory 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_DIRECTORY) 

FUNCTION IsArchive 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_ARCHIVE) 

FUNCTION IsNormal 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_NORMAL) 

FUNCTION IsTemporary 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_TEMPORARY) 

FUNCTION IsCompressed 
RETURN THIS.AttribSet(FILE_ATTRIBUTE_COMPRESSED) 

FUNCTION buf2num(lcBuffer, lnOffset, lnBytes) 
* converts N bytes from the buffer into a numeric value   
    lnResult = 0    
    FOR ii=1 TO lnBytes 
        lnResult = lnResult +;    
            BitLShift(Asc(SUBSTR(lcBuffer, lnOffset+ii, 1)), (ii-1)*8) 
    ENDFOR    
RETURN lnResult   

FUNCTION  ftime2dtime (lcFileTime) 
    LOCAL lcSystemTime, ltResult, lcStoredSet 
    IF lcFileTime = REPLI (Chr(0), 8) 
        ltResult = CTOT ("") 
    ELSE 
        lcSystemTime = REPLI (Chr(0), 16) 
        = FileTimeToSystemTime (@lcFileTime, @lcSystemTime) 
        wYear   = THIS.buf2num (lcSystemTime,  0, 2) 
        wMonth  = THIS.buf2num (lcSystemTime,  2, 2) 
        wDay    = THIS.buf2num (lcSystemTime,  6, 2) 
        wHour   = THIS.buf2num (lcSystemTime,  8, 2) 
        wMinute = THIS.buf2num (lcSystemTime, 10, 2) 
        wSecond = THIS.buf2num (lcSystemTime, 12, 2) 

        lcStoredSet = SET ("DATE") 
        SET DATE TO MDY 
        lcDate = STRTRAN (STR(wMonth,2) + "/" + STR(wDay,2) + "/" + STR(wYear,4), " ","0") 
        lcTime = STRTRAN (STR(wHour,2) + ":" + STR(wMinute,2) + ":" + STR(wSecond,2), " ","0") 
        ltResult = CTOT (lcDate + " " + lcTime) 
        SET DATE TO &lcStoredSet 
    ENDIF 
RETURN ltResult 
ENDDEFINE
.·*´¨)
.·`TCH
(..·*

010000110101001101101000011000010111001001110000010011110111001001000010011101010111001101110100
"When the debate is lost, slander becomes the tool of the loser." - Socrates
Vita contingit, Vive cum eo. (Life Happens, Live With it.)
"Life is not measured by the number of breaths we take, but by the moments that take our breath away." -- author unknown
"De omnibus dubitandum"
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform