How to use the FtpCommand (WinInet) in VFP - sample prg

[Guest_imported]

#DEFINE INTERNET_INVALID_PORT_NUMBER 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2

PUBLIC hOpen, hFtpSession
DO dodeclare && declare the external functions needed


IF connect2ftp ("ftp.linux.com", "anonymous", "vfp"+LEFT(SYS(3),5)+'@win32.com')
* DO test1
* DO test2
DO test3

= InternetCloseHandle (hFtpSession)
= InternetCloseHandle (hOpen)
ENDIF
RETURN && main

PROCEDURE test1
* list the root directory
= execCmd (hFtpSession, 'LIST', 1)
RETURN

PROCEDURE test2
* change working directory and list it
* actually, these two commands could be replaced with 'LIST pub'
= execCmd (hFtpSession, 'CWD pub', 0) && 0 is important
= execCmd (hFtpSession, 'LIST', 1)
RETURN

PROCEDURE test3
* retrieve the ASCII file
* during my testing this file existed in the root of this ftp server
= execCmd (hFtpSession, 'RETR welcome.msg', 1) && an ASCII response is expected
RETURN

PROCEDURE dodeclare
DECLARE INTEGER GetLastError IN kernel32

DECLARE INTEGER InternetOpen IN wininet.dll As "InternetOpenA";
STRING sAgent,;
INTEGER lAccessType,;
STRING sProxyName,;
STRING sProxyBypass,;
STRING lFlags

DECLARE INTEGER InternetCloseHandle IN wininet.dll INTEGER hInet

DECLARE INTEGER InternetConnect IN wininet.dll As "InternetConnectA";
INTEGER hInternetSession,;
STRING sServerName,;
INTEGER nServerPort,;
STRING sUsername,;
STRING sPassword,;
INTEGER lService,;
INTEGER lFlags,;
INTEGER lContext

DECLARE INTEGER FtpCommand IN wininet.dll;
INTEGER hConnect,;
INTEGER fExpectResponse,;
INTEGER dwFlags,;
STRING lpszCommand,;
STRING @ dwContext,;
INTEGER @ phFtpCommand

DECLARE INTEGER InternetReadFile IN wininet.dll;
INTEGER hFile,;
STRING @ sBuffer,;
INTEGER lNumBytesToRead,;
INTEGER @ dwNumberOfBytesRead
RETURN

FUNCTION connect2ftp (strHost, strUser, strPwd)
* open access to Inet functions
hOpen = InternetOpenA ("vfp", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)

IF hOpen = 0
? "Unable to get access to WinInet.Dll"
RETURN .F.
ENDIF

* connect to FTP
hFtpSession = InternetConnectA (hOpen, strHost, INTERNET_INVALID_PORT_NUMBER,;
strUser, strPwd, INTERNET_SERVICE_FTP, 0, 0)

IF hFtpSession = 0
* close access to Inet functions and exit
= InternetCloseHandle (hOpen)
? "FTP " + strHost + " is not available"
RETURN .F.
ELSE
? "Connected to " + strHost + " as: [" + strUser + ", " + strPwd + "]"
ENDIF
RETURN .T.

FUNCTION execCmd (hSession, lcCommand, fExpectResponse)
* note that ASCII type is hard-coded
hFile = 0
lnResult = FtpCommand (hFtpSession, fExpectResponse,;
FTP_TRANSFER_TYPE_ASCII, lcCommand, 0, @hFile)

IF lnResult = 0
? 'Command execution error: ' + LTRIM(STR(GetLastError()))
RETURN
ENDIF

IF hFile <> 0
* if there is a return - display it on the screen
SET MEMOWIDTH TO 100
lnBufsize = 128 && reading buffer size
?
DO WHILE .T.
lcBuffer = REPLI (Chr(0), lnBufsize)
lnBytesRead = 0

IF InternetReadFile (hFile, @lcBuffer, lnBufsize, @lnBytesRead) = 1
lcBuffer = LEFT(lcBuffer, lnBytesRead)
?? lcBuffer
IF lnBytesRead < lnBufsize
EXIT
ENDIF
ELSE
EXIT
ENDIF
ENDDO
= InternetCloseHandle (hFile)
ENDIF
RETURN

*| Some useful links
*| The File Transfer Protocol specification
*|

http://www.faqs.org/rfcs/rfc765.html

*|
*| WinInet VB library
*|

http://msdn.microsoft.com/msdn-files/026/001/985/

*| Server Components/Visual Basic COM/
*| FBLL (Fullfillment Business Logic Layer)/
*| wininet_bas.htm
*|
*| PRB: FTP WinInet APIs Report Error 12003
*|

http://support.microsoft.com/support/kb/articles/Q168/4/92.ASP

*|
*| FtpCommand() WinInet Function Stops Responding
*|

http://support.microsoft.com/support/kb/articles/Q255/2/04.ASP

*|
*| Using Win32 functions in VFP
*|

http://www.news2news.com/vfp

*| ----------------------------------------------------------------------------
*|
*| Comments
*| Because FTP allows only one active operation in each session,
*| you can run only single command
*| with expected response per session.
*|
*| On your FTP server you can try some other commands:
*| DELE <existing file name>
*|
*| Rename existing file through the following pair of commands running successively
*| RNFR <existing file name>
*| RNTO <new file name>