ftp problem

[Wanderson]

Hi, why this code dont work? If I type a value of curl in internet browse runs ok.
Thanks in advance.

ftpproto ="ftp://"
ftpserver = "f10-preview.awardspace.net"
ftpuser = "xxxx"
ftppass = "xxxx"
curl:=ftpproto+ftpuser+":"+ftppass+"@"+ftpserver
oUrl:= turl():new(curl)
oCred:= tIPCredentials()
oFtp:= tipclientftp():NEW(oUrl,,.T.)
oFTP:nConnTimeout := 20000
oFTP:bUsePasv := .T.
IF oFTP:Open()
cLista := oFTP:List()
msginfo(cLista)
ELSE
msginfo("error")
ENDIF

[StefanHaupt]

Wanderson,

try without "ftp://", only the hostname

[Wanderson]

Wanderson,

try without "ftp://", only the hostname

Hi thanks for your answer but if i use without "ftp://" i get this error:

Error description: Error BASE/1081 Operation not supported: TIPCLIENTFTP:new()

[jll-fwh]

Here you have a complete FTP program your source code.

I hope you find it useful.

http://javierlloris.blogspot.com.es/

a greeting
JLL

[ORibeiro]

This is Ok.

Code: Select all

// Original work from Alex Shaft & Peter Kohler, with mods by Byron Hopp, Rimantas Usevicius
// Modified by Luis Krause May 10, 2003, Optimized and cleaned up code
//                                       Fixed ::Retr() & ::Dir() bugs
//                                       added progress bar capability
//                                       Made socket calls compatible with modified TSocket class (TSmtp, etc.)
//                                       Added a timeout to escape from ::DoWait() to avoid hanging up the system
//                                       Added Proxy support (needs more testing)
//                     October 14, 2003, Optimized ::Retr() & ::Dir() more - much faster now
//                                       ::oTrnSocket wasn't being properly released. Fixed!
//                     May 8, 2003       More fixes to ::Retr???() methods
//                                       Fixed ::Stor(), added IVAR nDelay to allow upload to work
// Entries in log file use the following codes:
//   "E:"  an error occurred; description follows
//   "I:"  info about the current operation executed
//   "S:"  data/action sent to the ftp server
//   "R:"  reply/response returned by ftp server

#include "FiveWin.ch"
#include "Directry.ch"

#ifndef __CLIPPER__
#xtranslate Memory(<n>) =>                       // only needed with Clipper, not Harbour
#endif

#define BLOCK_SIZE 10240

#define ST_CLOSED     0
#define ST_CONNECTING 1
#define ST_CONNECTED  2
#define ST_CONNECTERR 3

#define ST_DOCWD      4
#define ST_DONECWD    5
#define ST_CWDERROR   6

#define ST_DOTYPE     7
#define ST_TYPEOK     8
#define ST_TYPEBAD    9

#define ST_DOPORT     10
#define ST_PORTOK     11
#define ST_PORTBAD    12

#define ST_DOSTOR     13
#define ST_STOROK     14
#define ST_STORBAD    15
#define ST_STORDONE   16

#define ST_DOPASV     17
#define ST_PASVOK     18
#define ST_PASVBAD    19

#define ST_DOQUIT     20
#define ST_QUITOK     21
#define ST_QUITBAD    22

#define ST_DODIR      23
#define ST_DIROK      24
#define ST_DIRBAD     25
#define ST_DIRDONE    26
#define ST_DIRREADY   126

#define ST_DOPWD      27
#define ST_DONEPWD    28
#define ST_PWDERROR   29

#define ST_DORENFROM  30
#define ST_RENFROMOK  31
#define ST_RENFROMBAD 32
#define ST_DORENTO    33
#define ST_RENTOOK    34
#define ST_RENTOBAD   35

#define ST_DODELETE   36
#define ST_DELETEOK   37
#define ST_DELETEBAD  38

#define ST_DOMKDIR    39
#define ST_MKDIROK    40
#define ST_MKDIRBAD   41

#define ST_DORETR     42
#define ST_RETROK     43
#define ST_RETRBAD    44
#define ST_RETRDONE   45

#define ST_DOABOR     46
#define ST_ABOROK     47
#define ST_ABORBAD    48

#define ST_DORMDIR    49
#define ST_RMDIROK    50
#define ST_RMDIRBAD   51

#define NTRIM(n)    ( LTrim( Str( n ) ) )

/*
Function Main()
  local oWin
  DEFINE WINDOW oWin TITLE "FTP Test"
  ACTIVATE WINDOW oWin ON INIT FTPTest()
return nil
Static Function FTPTest()
  local oFTP
  Ferase("logftp.txt")
  oFTP := qFTPClient():New("200.xxx.x.xx", 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,"name", "password")
  // oFTP:bAbort := {|| oApp():oFrmmain:lFormClosed}
  oFTP:lPassive := .T.
  if oFTP:Connect()
    MsgInfo("Connection successful to " + oFTP:cServer + CRLF + oFTP:cServerIP + CRLF + oFTP:oSocket:ClientIP())
    if oFTP:Cd("/www/clientes")
      MSginfo("Successfully changed dir to /www/clientes")
      if oFTP:Dir()
        Msginfo("Got directory listing")
        //Aeval(oFTP:acDir, {| cDir, nCount | Msginfo(Str(nCount) + " " + cDir)})
        //oFTP:Retr("/etc/hosts", "hosts.txt")
        //oFTP:Del("hosts.backup")
        oFTP:Stor("C:\SIST\WOASYS\OASYS.TXT", "OASYS.TXT")
        //oFTP:Rename("hosts.txt", "hosts.backup")
        oFTP:Quit()
        oFTP:End()
        Msginfo("Done")
      else
        Msginfo("Directory listing failed!")
        oFTP:Quit()
        oFTP:End()
      endif
    else
      Msginfo("CD to /pub failed!")
      oFTP:Quit()
      oFTP:End()
    endif
  else
    Msginfo("Connect failed!")
  endif
return nil
*/

CLASS qFTPClient

   #ifdef __CLIPPER__
   DATA oSocket, oTrnSocket, oProxy              AS OBJECT, NIL
   #else
   DATA oSocket, oTrnSocket, oProxy              AS OBJECT INIT Nil
   #endif

   DATA cServer, cServerIP, cUser, cPass, cBuffer, cLastCmd, cReply, cDirBuffer, ;
        cDataIP                                  AS String INIT ""

   DATA nPort, nDataPort                         AS NUMERIC INIT 21

   DATA nStatus, nRetrHandle                     AS NUMERIC INIT 0

   DATA bResolving, bResolved, bDump, bAbort, bStorProgress ;
                                                 AS Codeblock INIT Nil

   DATA lResolved, lConnected, lClosed, lSent, lSendFile, lPassive, lSentUser ;
                                                 AS Logical Init .F.

   DATA acDir, acReply                           AS Array

   DATA nRetrFSize, nRetrBRead                   AS NUMERIC INIT 0

   // allow a small delay when uploading (STOR command) data if there's no way to get an acknowledgment from server
   DATA nDelay                                   AS NUMERIC INIT 3

   // allow 30 seconds before we bump out of ::DoWait() to avoid hanging up the system
   // set to 0 if you're pretty confident this won't happen to you :o)
   DATA nTimeOut                                 AS NUMERIC INIT 30


   Method New( cServer, nPort, bDump, bAbort, cUser, cPass, cProxyIP, nProxyPort, cProxyLog ) Constructor

   Method End()

   Method Connect()

   Method OnConnect( oSocket, nWSAError )
   Method OnRead( oSocket, nWSAError )
   Method OnClose( oSocket, nWSAError )

   Method Port( oTransSocket )

   Method CD( cPath )

   Method Pwd()

   Method XfrType( cType )

   Method Stor( cLocal, cRemote, bStorProgess, oMeter, oText )
   Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden

   Method Dir( cLoc )
   Method DirAccept( opSocket, nWSAError ) Hidden
   Method DirRead( oSocket, nWSAError ) Hidden
   Method DirClose( oSocket, nWSAError ) Hidden

   Method Dump( cMsg )

   Method Quit()
   Method Bye() Inline ::Quit()

   Method DoWait( nState ) Hidden

   Method Del( cFile )

   Method Rename( cFrom, cTo )

   Method MkDir( cDir )

   Method RmDir( cDir )

   Method Retr( cRemote, cLocal, oMeter, oText )
   Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden

   Method Abort()

   Method Pasv()

EndClass

//---------------------------------------------------------------------------------------------//
/*
   Creates FTP Object

   Parameters : cServer    : Servername e.g. ftp.microsoft.com or 207.46.133.140
                nPort      : Server FTP Port. Defaults to 21
                bDump      : Codeblock to send all commands sent, and replies received to. Useful for logging, etc.
                bAbort     : Codeblock, which if eval's to True, will abort any current waiting process.
                cUser      : User name to log-in with
                cPass      : Password to log-in with
                cProxyIP   : Optional Proxy IP Address
                nProxyPort : Optional Proxy Port No.
                cProxyLog  : Optional Proxy Logfile
*/
Method New( cServer, nPort, bDump, bAbort, cUser, cPass, ;
   cProxyIP, nProxyPort, cProxyLog ) Class qFTPClient

   Default cServer := "10.1.1.2", ;
      nPort  := 21, ;
      bAbort := {|| .F. }, ;
      cUser  := "anonymous", ;
      cPass  := "fwuser@fivetech.com", ;
      cProxyIP := "0.0.0.0", ;
      nProxyPort := 0

   ::cServer := cServer
   ::nPort   := nPort
   ::bAbort  := bAbort
   ::bDump   := bDump

   ::acDir   := {}
   ::acReply := {}

   ::cUser   := cUser
   ::cPass   := cPass

   If Val( cProxyIP ) > 0 .and. nProxyPort > 0
      ::oProxy := TProxy():New( nProxyPort, cProxyIP )
      ::oProxy:lDebug := bDump # Nil
      If cProxyLog # Nil
         ::oProxy:cLogFile := cProxyLog
      Endif
      ::oProxy:Activate()
   Endif

Return Self

//---------------------------------------------------------------------------------------------//
/*
   Internal method to give feedback to caller
*/
Method Dump( cMsg ) Class qFTPClient

   If ValType( ::bDump ) == "B" .and. ValType( cMsg ) == "C"
      Eval( ::bDump, cMsg )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Logs into the FTP Server, using parameters specified with New Method.
   Returns True or False based on connection success
*/
Method Connect() Class qFTPClient
   Local nReturn
   Local lOK := .F.                              // was .T. - Thanks to Roberto Chiaiese

   ::lResolved := .F.

   ::oSocket := TSocket():New(0)
   lOK := ValType( ::oSocket ) == "O" .and. ::oSocket:nSocket > 0  // <lkm> 16/Dec/2004 try to avoid random error when attempting to connect later and ::oSocket seems to be NIL

   If ValType( ::bResolving ) == "B"
      Eval( ::bResolving, Self )
   Endif

   If IsAlpha( ::cServer )
      ::cServerIP := GetHostByName( AllTrim( ::cServer ) )  // PK Note this hogs the pc for up to 35 seconds if it cannot be resolved
   Else
      ::cServerIP := ::cServer
   Endif

   If lOK .and. ( ::lResolved := Val( ::cServerIP ) > 0 )

      ::oSocket:bConnect := {|o,n| ::OnConnect( o, n ) }  // lkm - see adjustment to TSocket class
      ::oSocket:bRead    := {|o,n| ::OnRead( o, n ) }
      ::oSocket:bClose   := {|o,n| ::OnClose( o, n ) }

      ::nStatus := ST_CONNECTING
      Memory(-1)                                 // cleanup memory when connecting frequently
      ::oSocket:Connect( ::cServerIP, ::nPort )

      ::DoWait( ST_CONNECTING )

      lOK := ::nStatus == ST_CONNECTED
      If ValType( ::bResolved ) == "B"
         Eval( ::bResolved, Self )
      Endif

   Endif

Return lOk

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle connection established.
   Note it only checks for a bad connection. The rest is done by OnRead
*/
Method OnConnect( oSocket, nWSAError ) Class qFTPClient

   If Val( oSocket:ClientIP() ) == 0
      ::lConnected := .F.
      ::nStatus := ST_CONNECTERR
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle data received by control socket
*/
Method OnRead( oSocket, nWSAError ) Class qFTPClient
   Local cData := ""
   Local nPos  := 0, nPos1, nPos2
   Local cCmd  := ""

   cData := oSocket:GetData()

   ::cBuffer += cData

   Do While ( nPos := At( CRLF, ::cBuffer ) ) > 0 .and. ! Eval( ::bAbort )
      AAdd( ::acReply, Left( ::cBuffer, nPos - 1 ) )
      ::cBuffer := SubStr( ::cBuffer, nPos + 2 )
   Enddo

   AEval( ::acReply, {|cReply| ::Dump( "R:" + NTRIM( ::nStatus ) + ":" + cReply ) } )
   If Len( ::acReply ) > 0 .and. ;
         Val( Left( ATail( ::acReply ), 3 ) ) > 0 .and. ;  // i.e. skip stuff like:
         SubStr( ATail( ::acReply ), 4, 1 ) == " "         // "230-" or " ***"

      // Full reply received
      ::cReply := ATail( ::acReply )
      cCmd := Left( ::cReply, 3 )                // Left( ::acReply[1], 3 ) <<- caused a ton of problems!

      Do Case
      Case cCmd == "530" .or. ;                  // Login incorrect. [or other error]
            ::nStatus == ST_CLOSED .or. ::nStatus == ST_CONNECTERR
         ::nStatus := ST_DOQUIT
         ::lConnected := .F.

      Case ::nStatus == ST_CONNECTING
         Do Case
         Case cCmd == "220"                      // Ready for user| ProFTPD 1.2.2rc1 Server (ProFTPD) [n.n.n.n]
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":USER *************" )  // + AllTrim( ::cUser )
            oSocket:SendData( "USER " + AllTrim( ::cUser ) + CRLF )
            ::lSentUser := .T.
         Case cCmd == "331"                      // Password required for ::cUser.
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":PASS *************" )
            oSocket:SendData( "PASS " + AllTrim( ::cPass ) + CRLF )
         Case cCmd == "230"                      // User ::cUser logged in.
            ::nStatus := ST_CONNECTED
            ::lConnected := .T.
         Otherwise
            ::nStatus := ST_CONNECTERR
         EndCase

      Case ::nStatus == ST_DOCWD
         Do Case
         Case cCmd == "250"                      // CWD command successful.
            ::nStatus := ST_DONECWD
         Otherwise
            ::nStatus := ST_CWDERROR
         EndCase

      Case ::nStatus == ST_DOQUIT
         ::lConnected := .F.
         Do Case
         Case cCmd == "221" .or. cCmd == "530"   // Goodbye.
            ::nStatus := ST_QUITOK
         Otherwise
            ::nStatus := ST_QUITBAD
         EndCase

      Case ::nStatus == ST_DODELETE
         Do Case
         Case cCmd == "250"                      // DEL command successful.
            ::nStatus := ST_DELETEOK
         Otherwise
            ::nStatus := ST_DELETEBAD
         EndCase

      Case ::nStatus == ST_DOPWD
         Do Case
         Case cCmd == "257"                      // PWD command successful.
            ::nStatus := ST_DONEPWD
         Otherwise
            ::nStatus := ST_PWDERROR
         EndCase

      Case ::nStatus == ST_DOPORT
         Do Case
         Case cCmd == "200"                      // OK
            ::nStatus := ST_PORTOK
         Otherwise
            ::nStatus := ST_PORTBAD
         EndCase

      Case ::nStatus == ST_DOTYPE
         Do Case
         Case cCmd == "200"                      // Type set to x.
            ::nStatus := ST_TYPEOK
         Otherwise
            ::nStatus := ST_TYPEBAD
         EndCase

      Case ::nStatus == ST_DOSTOR
         Do Case
         Case cCmd == "150"
            ::nStatus := ST_STOROK
            ::lSendFile := .T.
         Otherwise
            ::nStatus := ST_STORBAD
         EndCase

      Case ::nStatus == ST_STOROK
         Do Case
         Case cCmd == "226"                      // OK
            ::nStatus := ST_STORDONE
         Otherwise
            ::nStatus := ST_STORBAD
         EndCase

      Case ::nStatus == ST_DOPASV
         Do Case
         Case cCmd == "227"                      // Entering Passive Mode (n,n,n,n,m,m).
            ::nStatus := ST_PASVOK
         Otherwise
            ::nStatus := ST_PASVBAD
         EndCase

      Case ::nStatus == ST_DODIR
         Do Case
         Case cCmd == "150"                      // Opening ASCII mode data connection for [file list]
            ::nStatus := ST_DIROK
         Case cCmd == "125"                      // Data connection already open; Transfer starting.
            ::nStatus := ST_DIROK                // some ftp servers return 125 instead of 150
         Otherwise
            ::nStatus := ST_DIRBAD
         EndCase

      Case ::nStatus == ST_DIROK .or. ::nStatus == ST_DIRREADY
         Do Case
         Case cCmd == "226"                      // Transfer complete.
            ::nStatus := ST_DIRDONE
         Otherwise
            ::nStatus := ST_DIRBAD
         EndCase

      Case ::nStatus == ST_DORETR
         Do Case
         Case cCmd == "150"                      // Opening BINARY mode data connection for cFile (nnnnn bytes).
            If ::nRetrBRead == 0                 // in case it jumped the gun (with small files sometimes ST_RETRDONE jumps the gun and file has already arrived!)
               nPos1 := At( "(", ::cReply )
               nPos2 := At( " bytes)", ::cReply )
               ::nRetrFSize := Val( SubStr( ::cReply, nPos1 + 1, nPos2 - nPos1 - 1 ) )///+100
            Endif
            ::nStatus := ST_RETROK
         Case cCmd == "125"                      // command 150 never received, therefore we don't know the size of the file being retrieved
            If ::nRetrFSize == 0                 // horrible hack, but it's the only
               ::nRetrFSize := 1                 // way around this (for the time being)
            Endif
            ::nStatus := ST_RETROK
         Otherwise                               // a 550 means No such file or directory
            ::nStatus := ST_RETRBAD
         EndCase

      Case ::nStatus == ST_RETROK .or. ::nStatus == ST_RETRDONE
         Do Case
         Case cCmd == "226"                      // Transfer complete.
            ::nStatus := ST_RETRDONE
         Otherwise
            ::nStatus := ST_RETRBAD
         EndCase

      Case ::nStatus == ST_DORENFROM
         Do Case
         Case cCmd == "350"
            ::nStatus := ST_RENFROMOK
         Otherwise
            ::nStatus := ST_RENFROMBAD
         EndCase

      Case ::nStatus == ST_DORENTO
         Do Case
         Case cCmd == "250"
            ::nStatus := ST_RENTOOK
         Otherwise
            ::nStatus := ST_RENTOBAD
         EndCase

      Case ::nStatus == ST_DOMKDIR
         Do Case
         Case cCmd == "257"                      // OK
            ::nStatus := ST_MKDIROK
         Otherwise
            ::nStatus := ST_MKDIRBAD
         EndCase

      Case ::nStatus == ST_DOABOR
         Do Case
         Case cCmd == "426"                      // Data connection closed, file transfer cFile aborted.
            ::nStatus := ST_DOABOR               // stay put for successful reply from server
         Case cCmd == "225" .or. cCmd == "226"   // ABOR command successful.
            ::nStatus := ST_ABOROK
         Otherwise
            ::nStatus := ST_ABORBAD
         EndCase

      Case ::nStatus == ST_DORMDIR
         Do Case
         Case cCmd == "250"                      // OK
            ::nStatus := ST_RMDIROK
         Otherwise
            ::nStatus := ST_RMDIRBAD
         EndCase

      Otherwise
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":Unknown exception on cmd " + ::cReply )

      EndCase

   Endif
   ::acReply := {}

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Used to get directory listing.
   cLoc Parameter gives dir spec.
   Returns true or false based on success
   When True. Data var acDir will hold dir listing as returned by server.
*/
Method Dir( cLoc ) CLASS qFTPClient
   Local lOK       := .T.
   Local cPort     := ""
   Local nPos      := 0
   Local cLine     := ""
   Local cSepChar  := ""

   Default cLoc := ""

   ::acDir := {}
   ::cDirBuffer := ""

   ::oTrnSocket := TSocket():New(0)

   If ! ::lPassive
      cPort := ::Port( ::oTrnSocket )

      ::oTrnSocket:bAccept := {|o,n| ::DirAccept( o, n ) }
      ::oTrnSocket:Listen()

      ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

      ::nStatus := ST_DOPORT
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
      ::oSocket:SendData( cPort + CRLF )

      ::DoWait( ST_DOPORT )
      lOK := ::nStatus == ST_PORTOK
   Else
      If ::Pasv()
         If lOK := ::nDataPort > 0
            ::oTrnSocket:bConnect := {|o,n| ::DirAccept( o, n ) }
            ::oTrnSocket:bRead    := {|o,n| ::DirRead( o, n ) }
            ::oTrnSocket:bClose   := {|o,n| ::DirClose( o, n ) }
            ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
            Memory(-1)                           // cleanup memory when connecting frequently
            ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
         Endif
      Endif
   Endif

   If lOK
      ::nStatus := ST_DODIR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":LIST " + AllTrim( cLoc ) )
      ::oSocket:SendData( "LIST " + AllTrim( cLoc ) + CRLF )

      ::DoWait( ST_DODIR )
      ::DoWait( ST_DIROK )

      If lOK := ::nStatus == ST_DIRDONE
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Interpreting dir listing" )
         cSepChar := CRLF
         nPos := At( cSepChar, ::cDirBuffer )
         If nPos == 0
            If ! Empty( ::cDirBuffer )  // single line, just one file, THEREFORE there won't be any CRLF's!
               ::cDirBuffer += CRLF
            Else
               cSepChar := Chr(10)
            Endif
            nPos := At( cSepChar, ::cDirBuffer )
         Endif
         ::acDir := {}
         Do While nPos > 0 .and. ! Eval( ::bAbort )
            cLine := AllTrim( Left( ::cDirBuffer, nPos - 1 ) )
            ::cDirBuffer := SubStr( ::cDirBuffer, nPos + Len( cSepChar ) )
            cLine := AllTrim( StrTran( cLine, Chr(0), "" ) )

            If( ! Empty( cLine ), AAdd( ::acDir, cLine ), Nil )

            nPos := At( cSepChar, ::cDirBuffer )
            SysRefresh()
         Enddo
         lOk := ! Empty( ::acDir )
         ::nStatus := ST_DIRREADY
         SysWait( ::nDelay )                     // allow time for server to respond
      Else
         ::Abort()
      Endif
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirAccept( opSocket, nWSAError ) Class qFTPClient
   Local oSocket

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bRead  := {|o,n| ::DirRead( o, n ) }
      oSocket:bClose := {|o,n| ::DirClose( o, n ) }
   Endif
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data connection established" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirRead( oSocket, nWSAError ) Class qFTPClient
   Local cData := oSocket:GetData()

   ::cDirBuffer += cData
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data received" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirClose( oSocket, nWSAError ) Class qFTPClient

   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data socket closed:" + CRLF + ::cDirBuffer )
   oSocket:Close()
   ::nStatus := ST_DIRDONE

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle socket closed by server
*/
Method OnClose( oSocket, nWSAError ) Class qFTPClient

   ::Dump( "I:" + NTRIM( ::nStatus ) + ":Server closed down" )
   ::lClosed := .T.
   ::nStatus := ST_CLOSED
   If ValType( ::oSocket ) == "O"
      ::oSocket:Close()
      ::oSocket := Nil
   Endif

   If ValType( ::oTrnSocket ) == "O"
      ::oTrnSocket:Close()
      ::oTrnSocket := Nil
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
 Kills connections
*/
Method End() Class qFTPClient

   If ValType( ::oSocket ) == "O"
      ::oSocket:End()
      ::oSocket := Nil
   Endif

   If ValType( ::oTrnSocket ) == "O"
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

   If ValType( ::oProxy ) == "O"
      ::oProxy:End()
      ::oProxy := Nil
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to obtain unused port no. for data connections.
*/
METHOD Port( oTransSocket ) Class qFTPClient
   Local cIP := GetIP( ::oSocket:nSocket )
   Local nPort
   Local cPort
   Local cComplement

   BindToPort( oTransSocket:nSocket, 0 )         // Get a free port from 1024 - 5000

   nPort       := GetPort( oTransSocket:nSocket )
   cPort       := AllTrim( Str( Int( nPort / 256 ), 3 ) )
   cComplement := AllTrim( Str( Int( nPort % 256 ), 3 ) )

   oTransSocket:nPort := nPort

Return "PORT " + StrTran( AllTrim( StrTran( cIP, ".", "," ) ) + ;
   "," + cPort + "," + cComplement, " ", "" )

//---------------------------------------------------------------------------------------------//
/*
   Change directory on FTP Server.
   Returns True or False based on success
*/
Method CD( cPath ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DOCWD
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":CWD " + cPath )
   ::oSocket:SendData( "CWD " + cPath + CRLF )
   ::DoWait( ST_DOCWD )

   lOK := ::nStatus == ST_DONECWD

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Used internally to set Binary transfer mode for transfers
*/
Method XfrType( cType ) Class qFTPClient
   Local lOK := .T.

   Default cType := "I"

   ::nStatus := ST_DOTYPE
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":TYPE " + cType )
   ::oSocket:SendData( "TYPE " + cType + CRLF )
   ::DoWait( ST_DOTYPE )

   lOK := ::nStatus == ST_TYPEOK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Used to store files on server.
   Parameters : cLocal        : Local File to send
                cRemote       : Location to store file remotely
                bStorProgess  : Codeblock to get percent complete
                oMeter        : Meter object progress bar [optional]
                oText         : Say object used with meter object to display bytes processed [optional]
   Returns True or False based on success
*/
Method Stor( cLocal, cRemote, bStorProgress, oMeter, oText ) Class qFTPClient
   Local cRemFile  := ""
   Local nPos      := 0
   Local cPort     := ""
   Local lOK       := .T.

   Default cRemote := "", ;
           bStorProgress := {|| Nil }

   ::bStorProgress := bStorProgress

   ::lSendFile := .F.
   If Empty( cRemote )
      If ( nPos := RAt( "\", cLocal ) ) > 0
         cRemFile := SubStr( cLocal, nPos + 1 )
      Else
         cRemFile := cLocal
      Endif
   Else
      cRemFile := cRemote
   Endif

   If oMeter # Nil
      oMeter:cargo := .T.                        // cancel button available while download in progress
      oMeter:oWnd:AEvalWhen()
   Endif

   ::XfrType( "I" )
   ::DoWait( ST_DOTYPE )

   ::oTrnSocket := TSocket():New(0)

   If lOK := ::nStatus == ST_TYPEOK

      If ! ::lPassive
         cPort := ::Port( ::oTrnSocket )
         ::oTrnSocket:bAccept := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
         ::oTrnSocket:Listen()
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

         ::nStatus := ST_DOPORT
         ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
         ::oSocket:SendData( cPort + CRLF )

         ::DoWait( ST_DOPORT )
         lOK := ::nStatus == ST_PORTOK
      Else
         If ::Pasv()
            If lOK := ::nDataPort > 0
               ::oTrnSocket:bConnect := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
               ::oTrnSocket:bClose   := {|o,n| ::StorClose( o, n, cLocal, oMeter, oText ) }
               ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
               Memory(-1)                        // cleanup memory when connecting frequently
               ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
            Endif
         Endif
      Endif
   Endif

   If lOk
      ::nStatus := ST_DOSTOR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":STOR " + cRemFile )
      ::oSocket:SendData( "STOR " + cRemFile + CRLF )

      ::DoWait( ST_DOSTOR )
      ::DoWait( ST_STOROK )

      lOK := ::nStatus == ST_STORDONE
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file store socket
*/
Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local oSocket
   Local hFile   := 0
   Local cBuffer := ""
   Local nSent   := 0
   Local nTotal  := 0
   Local lClosed := .F.
   Local nNow    := 0
   Local nSize

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bClose := {|o,n| ::StorClose( o, n, cFile, oMeter, oText ), lClosed := .T. }
   Else
      oSocket := opSocket
   Endif

   Do While ! ::lSendFile .and. ! ::lClosed .and. ! Eval( ::bAbort )
      SysRefresh()
   Enddo

   If ::lSendFile
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data connection established" )

      nNow := Seconds()
      If ( hFile := FOpen( cFile ) ) > 0
         nSize := Directory( cFile )[1,F_SIZE]
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Uploading " + cFile + ", " + NTRIM( nSize ) + " bytes in size" )
         If oMeter # Nil
            oMeter:Set(0)                        // reset
            oMeter:SetTotal( nSize )             // set bar length
         Endif
         cBuffer := Space( BLOCK_SIZE )
         Do While .T.
            nSent := FRead( hFile, @cBuffer, BLOCK_SIZE )
            oSocket:SendData( Left( cBuffer, nSent ) )
            nTotal += nSent
            If ::nDelay > 0
               SysWait( ::nDelay )               // this is trial and error... I'm using 0.5 to 1.5; default is 1.0
            Endif

            Eval( ::bStorProgress, Round( nTotal / nSize * 100, 2 ) )  // left for compatibility with original class
            If( oMeter # Nil, oMeter:Set( nTotal ), Nil )
            If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( nTotal ) + " bytes uploaded..." ), Nil )

            If nSent < BLOCK_SIZE .or. lClosed .or. ::nStatus == ST_STORBAD .or. Eval( ::bAbort )
               Exit
            Endif
            If ::nDelay == 0
               SysRefresh()
            Endif

         Enddo
         FClose( hFile )
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":" + NTRIM( nTotal ) + " bytes of file sent in " + LTrim( Str( Seconds() - nNow, 16, 2 ) ) + " seconds" )
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Waiting for acknowledgement" )

         oSocket:Close()
      Else
         oSocket:Close()
         oSocket:End()
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":FOpen() failed with file " + cFile + " DOS Error #" + NTRIM( FError() ) )
      Endif
      SysRefresh()
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file store socket
*/
Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient

   If oMeter # Nil
      oMeter:cargo := .F.                        // cancel button not available anymore
      oMeter:oWnd:AEvalWhen()
   Endif
   ::lSendFile := .F.
   oSocket:Close()
   If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
         ::nStatus == ST_ABORBAD .or. ::nStatus == ST_STORBAD
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data aborted" )
   Else
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data completed :-)" )
      ::nStatus := ST_STORDONE
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Close FTP Connection
*/
Method Quit() Class qFTPClient

   ::nStatus := ST_DOQUIT
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":QUIT" )
   If ValType( ::oSocket ) == "O"
      ::oSocket:SendData( "QUIT" + CRLF )
      ::DoWait( ST_DOQUIT )
   Endif

Return .T.

//---------------------------------------------------------------------------------------------//
/*
   Get current directory on FTP Server
   Returns True or False based on success
*/
Method Pwd() Class qFTPClient
   Local cRetVal := ""
   Local nPos := ""
   Local cReply

   ::nStatus := ST_DOPWD
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":PWD" )
   ::oSocket:SendData( "PWD" + CRLF )

   ::DoWait( ST_DOPWD )

   cReply := ::cReply
   nPos := At( '"', cReply )
   cReply := SubStr( cReply, nPos + 1 )

   nPos := At( '"', cReply )
   cReply := SubStr( cReply, 1, nPos - 1 )
   cRetVal := cReply

Return cRetVal

//---------------------------------------------------------------------------------------------//
/*
   Delete file (cFile of server)
   Will return Success True or False
*/
Method Del( cFile ) Class qFTPClient
   Local lOK := .T.

   Default cFile := ""

   ::nStatus := ST_DODELETE

   If lOK := ! Empty( cFile )
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":DELE " + cFile )
      ::oSocket:SendData( "DELE " + cFile + CRLF )

      ::DoWait( ST_DODELETE )

      lOK := ::nStatus == ST_DELETEOK
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Rename file on server
   Parameters : cFrom  : Source file
                cTo    : Target file
   Will return Success True or False
*/
Method Rename( cFrom, cTo ) Class qFTPClient
   Local lOK := .F.

   Default cFrom := "", ;
           cTo   := ""

   If lOK := ! Empty( cFrom ) .and. ! Empty( cTo )
      ::nStatus := ST_DORENFROM
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":RNFR " + cFrom )
      ::oSocket:SendData( "RNFR " + cFrom + CRLF )

      ::DoWait( ST_DORENFROM )

      If lOK := ::nStatus == ST_RENFROMOK
         ::nStatus := ST_DORENTO
         ::Dump( "S:" + NTRIM( ::nStatus ) + ":RNTO " + cTo )
         ::oSocket:SendData( "RNTO " + cTo + CRLF )

         ::DoWait( ST_DORENTO )

         lOK := ::nStatus == ST_RENTOOK
      Endif
   Endif

Return lOk

//---------------------------------------------------------------------------------------------//
/*
   Create a directory
*/
Method MkDir( cDir ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DOMKDIR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":MKD " + cDir )
   ::oSocket:SendData( "MKD " + cDir + CRLF )

   ::DoWait( ST_DOMKDIR )

   lOK := ::nStatus == ST_MKDIROK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Remove a directory
*/
Method RmDir( cDir ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DORMDIR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":RMD " + cDir )
   ::oSocket:SendData( "RMD " + cDir + CRLF )

   ::DoWait( ST_DORMDIR )

   lOK := ::nStatus == ST_RMDIROK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Retrieve file from server.
   Parameters : cRemote  : Remote file name
                cLocal   : Local file name
                oMeter   : Meter object progress bar [optional]
                oText    : Say object used with meter object to display bytes processed [optional]
*/
Method Retr( cRemote, cLocal, oMeter, oText ) Class qFTPClient
   Local lOK   := .T.
   Local cPort := ""
   Local nPos  := 0
   Local cLine := ""
   Local nNow  := 0
   LOCAL nLoopTimer:=0

   nPos := RAt( "/", cRemote )
   If nPos == 0
      Default cLocal := cRemote
   Else
      Default cLocal := SubStr( cRemote, nPos + 1 )
   Endif

   If oMeter # Nil
      oMeter:cargo := .T.                        // cancel button available while download in progress
      oMeter:oWnd:AEvalWhen()
   Endif

   ::nRetrHandle := FCreate( cLocal )
   If lOK := ( ::nRetrHandle > 0 )

      ::XfrType( "I" )
      ::DoWait( ST_DOTYPE )

      If lOK := ::nStatus == ST_TYPEOK
         ::oTrnSocket := TSocket():New(0)
         If ! ::lPassive
            cPort := ::Port( ::oTrnSocket )

            ::oTrnSocket:bAccept := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
            ::oTrnSocket:Listen()

            ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

            ::nStatus := ST_DOPORT
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
            ::oSocket:SendData( cPort + CRLF )

            ::DoWait( ST_DOPORT )
            lOK := ::nStatus == ST_PORTOK
         Else
            If ::Pasv()
               If lOK := ::nDataPort > 0
                  ::oTrnSocket:bConnect := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
                  ::oTrnSocket:bRead    := {|o,n| ::RetrRead( o, n, cRemote, oMeter, oText ) }
                  ::oTrnSocket:bClose   := {|o,n| ::RetrClose( o, n, cRemote, oMeter, oText ) }
                  ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
                  Memory(-1)                     // cleanup memory when connecting frequently
                  ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
               Endif
            Endif
         Endif
      Endif
   Else
      ::Dump( "E:" + NTRIM( ::nStatus ) + ":FCreate() failed with file " + cLocal + " DOS Error #" + NTRIM( FError() ) )
   Endif
   If lOK
      ::nRetrBRead := 0                          // initialize here, not in ::OnRead()
      ::nStatus := ST_DORETR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":RETR " + cRemote )
      ::oSocket:SendData( "RETR " + cRemote + CRLF )

      ::DoWait( ST_DORETR )
      Do While ::nRetrBRead < ::nRetrFSize .and. ;  // stay put until file fully downloaded so it won't be truncated
            ! ::nRetrHandle == 0 .and. ! ::lClosed .and. ! Eval( ::bAbort ) .and. ;
            ! ::nStatus == ST_RETRBAD            // this is case the file was not found: 550 ?????.???: No such file or directory
///         nLoopTimer++
////         IF nLoopTimer > 50
            SysRefresh()
///            nLoopTimer:=0
///         ENDIF
      Enddo

      ::DoWait( ST_RETROK )

      lOK := ::nStatus == ST_RETRDONE
      SysWait( ::nDelay )                        // allow time for server to respond
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
*/
Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local oSocket

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bRead  := {|o,n| ::RetrRead( o, n, cFile, oMeter, oText ) }
      oSocket:bClose := {|o,n| ::RetrClose( o, n, cFile, oMeter, oText ) }
   Endif
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data connection established" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
*/
Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local cData := oSocket:GetData()


   If ::nRetrHandle > 0
      If ::nRetrBRead == 0 .and. oMeter # Nil
         oMeter:Set(0)                           // reset
         oMeter:SetTotal( ::nRetrFSize )         // set bar length
      Endif
      FWrite( ::nRetrHandle, cData )
      ::nRetrBRead += Len( cData )
      If( oMeter # Nil, oMeter:Set( ::nRetrBRead ), Nil )
      If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( ::nRetrBRead ) + " bytes downloaded..." ), Nil )
      ///::Dump( "I:" + NTRIM( ::nStatus ) + ":Bytes retrieved " + NTRIM( ::nRetrBRead ) + " out of " + NTRIM( ::nRetrFSize ) )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
   Note: When retrieving very small files, the file might already be downloaded
         before ::nRetrFSize can even be initialized (cmd 150). So it's OK if it's ZERO
*/
Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient

   If oMeter # Nil
      oMeter:cargo := .F.                        // cancel button not available anymore
      oMeter:oWnd:AEvalWhen()
   Endif
   ///FWrite( ::nRetrHandle, oSocket:GetData() )
   SYSWAIT(1)
   FClose( ::nRetrHandle )
   ::nRetrHandle := 0
   oSocket:Close()
   If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
         ::nStatus == ST_ABORBAD .or. ::nStatus == ST_RETRBAD
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data aborted" )
   Else
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data completed" + If( ::nRetrBRead < ::nRetrFSize, ;
         ", but file truncated by " + NTRIM( ::nRetrFSize - ::nRetrBRead ) + " bytes :-(", " :-)" ) )
      // this should avoid the occasional hanging in ::DoWait()
      ::nStatus := If( ::nRetrFSize == 0 .or. ::nRetrBRead >= ::nRetrFSize, ST_RETRDONE, ST_RETRBAD )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Cancel any transfer/command in progress.
   Called by class if bAbort block evals to true in wait state.
*/
Method Abort() Class qFTPClient
   Local lOK := .T., nStatus := ::nStatus, bAbort := ::bAbort

   ::bAbort := {|| .F. }                         // avoid nested calls to ::Abort()
   ::nStatus := ST_DOABOR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":ABOR while on " + NTRIM( nStatus ) )
   ::oSocket:SendData( "ABOR" + CRLF )

   ::DoWait( ST_DOABOR )

   lOK := ::nStatus == ST_ABOROK
   ::bAbort := bAbort                            // restore abort codeblock

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Switch next transfer to passive mode
*/
Method Pasv() Class qFTPClient
   Local cReply := ""
   Local nPos   := 0

   ::nStatus := ST_DOPASV
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":PASV" )
   ::oSocket:SendData( "PASV" + CRLF )

   ::DoWait( ST_DOPASV )

   If ::lPassive := ::nStatus == ST_PASVOK
      cReply := ::cReply
      nPos := At( "(", cReply )
      cReply := SubStr( cReply, nPos + 1 )

      nPos := At( ")", cReply )
      cReply := Left( cReply, nPos - 1 )

      ::cDataIP := StrToken( cReply, 1, "," ) + "."
      ::cDataIP += StrToken( cReply, 2, "," ) + "."
      ::cDataIP += StrToken( cReply, 3, "," ) + "."
      ::cDataIP += StrToken( cReply, 4, "," )

      ::nDataPort := 0
      ::nDataPort += 256 * Val( StrToken( cReply, 5, "," ) )
      ::nDataPort += Val( StrToken( cReply, 6, "," ) )
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":Server has opened connection on port " + NTRIM( ::nDataPort ) + " - IP:" + ::cDataIP )
   Endif

Return ::lPassive

//---------------------------------------------------------------------------------------------//
/*
   Internal method to wait for responses from server.
*/
Method DoWait( nState ) Class qFTPClient
   Local nStart := Seconds()
   LOCAL nRefresh:=0

   Do While ::nStatus == nState .and. ! ::lClosed .and. ! Eval( ::bAbort )
      If ::nTimeOut > 0 .and. Seconds() - nStart > ::nTimeOut
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":Timed out waiting for state " + NTRIM( nState ) + " to finish" )
         Exit
      Endif
      /*nRefresh++
      if nRefresh ==3
         SysRefresh()
         nRefresh:=0
      endif
      */
      SysRefresh()
      ///SysRefresh()
      ///SysRefresh()
   Enddo

   If nState # ST_DOABOR .and. Eval( ::bAbort )
      SYSWAIT(.5)
      ::Abort()
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//

[Wanderson]

Thanks to all, _ Ribeiro solution runs ok.

[Francisco Horta]

Javier

i need ssh connection via ftp, with your class it possible?
thanks
Paco

[Wanderson]

This is Ok.

Code: Select all

// Original work from Alex Shaft & Peter Kohler, with mods by Byron Hopp, Rimantas Usevicius
// Modified by Luis Krause May 10, 2003, Optimized and cleaned up code
//                                       Fixed ::Retr() & ::Dir() bugs
//                                       added progress bar capability
//                                       Made socket calls compatible with modified TSocket class (TSmtp, etc.)
//                                       Added a timeout to escape from ::DoWait() to avoid hanging up the system
//                                       Added Proxy support (needs more testing)
//                     October 14, 2003, Optimized ::Retr() & ::Dir() more - much faster now
//                                       ::oTrnSocket wasn't being properly released. Fixed!
//                     May 8, 2003       More fixes to ::Retr???() methods
//                                       Fixed ::Stor(), added IVAR nDelay to allow upload to work
// Entries in log file use the following codes:
//   "E:"  an error occurred; description follows
//   "I:"  info about the current operation executed
//   "S:"  data/action sent to the ftp server
//   "R:"  reply/response returned by ftp server

#include "FiveWin.ch"
#include "Directry.ch"

#ifndef __CLIPPER__
#xtranslate Memory(<n>) =>                       // only needed with Clipper, not Harbour
#endif

#define BLOCK_SIZE 10240

#define ST_CLOSED     0
#define ST_CONNECTING 1
#define ST_CONNECTED  2
#define ST_CONNECTERR 3

#define ST_DOCWD      4
#define ST_DONECWD    5
#define ST_CWDERROR   6

#define ST_DOTYPE     7
#define ST_TYPEOK     8
#define ST_TYPEBAD    9

#define ST_DOPORT     10
#define ST_PORTOK     11
#define ST_PORTBAD    12

#define ST_DOSTOR     13
#define ST_STOROK     14
#define ST_STORBAD    15
#define ST_STORDONE   16

#define ST_DOPASV     17
#define ST_PASVOK     18
#define ST_PASVBAD    19

#define ST_DOQUIT     20
#define ST_QUITOK     21
#define ST_QUITBAD    22

#define ST_DODIR      23
#define ST_DIROK      24
#define ST_DIRBAD     25
#define ST_DIRDONE    26
#define ST_DIRREADY   126

#define ST_DOPWD      27
#define ST_DONEPWD    28
#define ST_PWDERROR   29

#define ST_DORENFROM  30
#define ST_RENFROMOK  31
#define ST_RENFROMBAD 32
#define ST_DORENTO    33
#define ST_RENTOOK    34
#define ST_RENTOBAD   35

#define ST_DODELETE   36
#define ST_DELETEOK   37
#define ST_DELETEBAD  38

#define ST_DOMKDIR    39
#define ST_MKDIROK    40
#define ST_MKDIRBAD   41

#define ST_DORETR     42
#define ST_RETROK     43
#define ST_RETRBAD    44
#define ST_RETRDONE   45

#define ST_DOABOR     46
#define ST_ABOROK     47
#define ST_ABORBAD    48

#define ST_DORMDIR    49
#define ST_RMDIROK    50
#define ST_RMDIRBAD   51

#define NTRIM(n)    ( LTrim( Str( n ) ) )

/*
Function Main()
  local oWin
  DEFINE WINDOW oWin TITLE "FTP Test"
  ACTIVATE WINDOW oWin ON INIT FTPTest()
return nil
Static Function FTPTest()
  local oFTP
  Ferase("logftp.txt")
  oFTP := qFTPClient():New("200.xxx.x.xx", 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,"name", "password")
  // oFTP:bAbort := {|| oApp():oFrmmain:lFormClosed}
  oFTP:lPassive := .T.
  if oFTP:Connect()
    MsgInfo("Connection successful to " + oFTP:cServer + CRLF + oFTP:cServerIP + CRLF + oFTP:oSocket:ClientIP())
    if oFTP:Cd("/www/clientes")
      MSginfo("Successfully changed dir to /www/clientes")
      if oFTP:Dir()
        Msginfo("Got directory listing")
        //Aeval(oFTP:acDir, {| cDir, nCount | Msginfo(Str(nCount) + " " + cDir)})
        //oFTP:Retr("/etc/hosts", "hosts.txt")
        //oFTP:Del("hosts.backup")
        oFTP:Stor("C:\SIST\WOASYS\OASYS.TXT", "OASYS.TXT")
        //oFTP:Rename("hosts.txt", "hosts.backup")
        oFTP:Quit()
        oFTP:End()
        Msginfo("Done")
      else
        Msginfo("Directory listing failed!")
        oFTP:Quit()
        oFTP:End()
      endif
    else
      Msginfo("CD to /pub failed!")
      oFTP:Quit()
      oFTP:End()
    endif
  else
    Msginfo("Connect failed!")
  endif
return nil
*/

CLASS qFTPClient

   #ifdef __CLIPPER__
   DATA oSocket, oTrnSocket, oProxy              AS OBJECT, NIL
   #else
   DATA oSocket, oTrnSocket, oProxy              AS OBJECT INIT Nil
   #endif

   DATA cServer, cServerIP, cUser, cPass, cBuffer, cLastCmd, cReply, cDirBuffer, ;
        cDataIP                                  AS String INIT ""

   DATA nPort, nDataPort                         AS NUMERIC INIT 21

   DATA nStatus, nRetrHandle                     AS NUMERIC INIT 0

   DATA bResolving, bResolved, bDump, bAbort, bStorProgress ;
                                                 AS Codeblock INIT Nil

   DATA lResolved, lConnected, lClosed, lSent, lSendFile, lPassive, lSentUser ;
                                                 AS Logical Init .F.

   DATA acDir, acReply                           AS Array

   DATA nRetrFSize, nRetrBRead                   AS NUMERIC INIT 0

   // allow a small delay when uploading (STOR command) data if there's no way to get an acknowledgment from server
   DATA nDelay                                   AS NUMERIC INIT 3

   // allow 30 seconds before we bump out of ::DoWait() to avoid hanging up the system
   // set to 0 if you're pretty confident this won't happen to you :o)
   DATA nTimeOut                                 AS NUMERIC INIT 30


   Method New( cServer, nPort, bDump, bAbort, cUser, cPass, cProxyIP, nProxyPort, cProxyLog ) Constructor

   Method End()

   Method Connect()

   Method OnConnect( oSocket, nWSAError )
   Method OnRead( oSocket, nWSAError )
   Method OnClose( oSocket, nWSAError )

   Method Port( oTransSocket )

   Method CD( cPath )

   Method Pwd()

   Method XfrType( cType )

   Method Stor( cLocal, cRemote, bStorProgess, oMeter, oText )
   Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden

   Method Dir( cLoc )
   Method DirAccept( opSocket, nWSAError ) Hidden
   Method DirRead( oSocket, nWSAError ) Hidden
   Method DirClose( oSocket, nWSAError ) Hidden

   Method Dump( cMsg )

   Method Quit()
   Method Bye() Inline ::Quit()

   Method DoWait( nState ) Hidden

   Method Del( cFile )

   Method Rename( cFrom, cTo )

   Method MkDir( cDir )

   Method RmDir( cDir )

   Method Retr( cRemote, cLocal, oMeter, oText )
   Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Hidden
   Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden

   Method Abort()

   Method Pasv()

EndClass

//---------------------------------------------------------------------------------------------//
/*
   Creates FTP Object

   Parameters : cServer    : Servername e.g. ftp.microsoft.com or 207.46.133.140
                nPort      : Server FTP Port. Defaults to 21
                bDump      : Codeblock to send all commands sent, and replies received to. Useful for logging, etc.
                bAbort     : Codeblock, which if eval's to True, will abort any current waiting process.
                cUser      : User name to log-in with
                cPass      : Password to log-in with
                cProxyIP   : Optional Proxy IP Address
                nProxyPort : Optional Proxy Port No.
                cProxyLog  : Optional Proxy Logfile
*/
Method New( cServer, nPort, bDump, bAbort, cUser, cPass, ;
   cProxyIP, nProxyPort, cProxyLog ) Class qFTPClient

   Default cServer := "10.1.1.2", ;
      nPort  := 21, ;
      bAbort := {|| .F. }, ;
      cUser  := "anonymous", ;
      cPass  := "fwuser@fivetech.com", ;
      cProxyIP := "0.0.0.0", ;
      nProxyPort := 0

   ::cServer := cServer
   ::nPort   := nPort
   ::bAbort  := bAbort
   ::bDump   := bDump

   ::acDir   := {}
   ::acReply := {}

   ::cUser   := cUser
   ::cPass   := cPass

   If Val( cProxyIP ) > 0 .and. nProxyPort > 0
      ::oProxy := TProxy():New( nProxyPort, cProxyIP )
      ::oProxy:lDebug := bDump # Nil
      If cProxyLog # Nil
         ::oProxy:cLogFile := cProxyLog
      Endif
      ::oProxy:Activate()
   Endif

Return Self

//---------------------------------------------------------------------------------------------//
/*
   Internal method to give feedback to caller
*/
Method Dump( cMsg ) Class qFTPClient

   If ValType( ::bDump ) == "B" .and. ValType( cMsg ) == "C"
      Eval( ::bDump, cMsg )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Logs into the FTP Server, using parameters specified with New Method.
   Returns True or False based on connection success
*/
Method Connect() Class qFTPClient
   Local nReturn
   Local lOK := .F.                              // was .T. - Thanks to Roberto Chiaiese

   ::lResolved := .F.

   ::oSocket := TSocket():New(0)
   lOK := ValType( ::oSocket ) == "O" .and. ::oSocket:nSocket > 0  // <lkm> 16/Dec/2004 try to avoid random error when attempting to connect later and ::oSocket seems to be NIL

   If ValType( ::bResolving ) == "B"
      Eval( ::bResolving, Self )
   Endif

   If IsAlpha( ::cServer )
      ::cServerIP := GetHostByName( AllTrim( ::cServer ) )  // PK Note this hogs the pc for up to 35 seconds if it cannot be resolved
   Else
      ::cServerIP := ::cServer
   Endif

   If lOK .and. ( ::lResolved := Val( ::cServerIP ) > 0 )

      ::oSocket:bConnect := {|o,n| ::OnConnect( o, n ) }  // lkm - see adjustment to TSocket class
      ::oSocket:bRead    := {|o,n| ::OnRead( o, n ) }
      ::oSocket:bClose   := {|o,n| ::OnClose( o, n ) }

      ::nStatus := ST_CONNECTING
      Memory(-1)                                 // cleanup memory when connecting frequently
      ::oSocket:Connect( ::cServerIP, ::nPort )

      ::DoWait( ST_CONNECTING )

      lOK := ::nStatus == ST_CONNECTED
      If ValType( ::bResolved ) == "B"
         Eval( ::bResolved, Self )
      Endif

   Endif

Return lOk

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle connection established.
   Note it only checks for a bad connection. The rest is done by OnRead
*/
Method OnConnect( oSocket, nWSAError ) Class qFTPClient

   If Val( oSocket:ClientIP() ) == 0
      ::lConnected := .F.
      ::nStatus := ST_CONNECTERR
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle data received by control socket
*/
Method OnRead( oSocket, nWSAError ) Class qFTPClient
   Local cData := ""
   Local nPos  := 0, nPos1, nPos2
   Local cCmd  := ""

   cData := oSocket:GetData()

   ::cBuffer += cData

   Do While ( nPos := At( CRLF, ::cBuffer ) ) > 0 .and. ! Eval( ::bAbort )
      AAdd( ::acReply, Left( ::cBuffer, nPos - 1 ) )
      ::cBuffer := SubStr( ::cBuffer, nPos + 2 )
   Enddo

   AEval( ::acReply, {|cReply| ::Dump( "R:" + NTRIM( ::nStatus ) + ":" + cReply ) } )
   If Len( ::acReply ) > 0 .and. ;
         Val( Left( ATail( ::acReply ), 3 ) ) > 0 .and. ;  // i.e. skip stuff like:
         SubStr( ATail( ::acReply ), 4, 1 ) == " "         // "230-" or " ***"

      // Full reply received
      ::cReply := ATail( ::acReply )
      cCmd := Left( ::cReply, 3 )                // Left( ::acReply[1], 3 ) <<- caused a ton of problems!

      Do Case
      Case cCmd == "530" .or. ;                  // Login incorrect. [or other error]
            ::nStatus == ST_CLOSED .or. ::nStatus == ST_CONNECTERR
         ::nStatus := ST_DOQUIT
         ::lConnected := .F.

      Case ::nStatus == ST_CONNECTING
         Do Case
         Case cCmd == "220"                      // Ready for user| ProFTPD 1.2.2rc1 Server (ProFTPD) [n.n.n.n]
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":USER *************" )  // + AllTrim( ::cUser )
            oSocket:SendData( "USER " + AllTrim( ::cUser ) + CRLF )
            ::lSentUser := .T.
         Case cCmd == "331"                      // Password required for ::cUser.
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":PASS *************" )
            oSocket:SendData( "PASS " + AllTrim( ::cPass ) + CRLF )
         Case cCmd == "230"                      // User ::cUser logged in.
            ::nStatus := ST_CONNECTED
            ::lConnected := .T.
         Otherwise
            ::nStatus := ST_CONNECTERR
         EndCase

      Case ::nStatus == ST_DOCWD
         Do Case
         Case cCmd == "250"                      // CWD command successful.
            ::nStatus := ST_DONECWD
         Otherwise
            ::nStatus := ST_CWDERROR
         EndCase

      Case ::nStatus == ST_DOQUIT
         ::lConnected := .F.
         Do Case
         Case cCmd == "221" .or. cCmd == "530"   // Goodbye.
            ::nStatus := ST_QUITOK
         Otherwise
            ::nStatus := ST_QUITBAD
         EndCase

      Case ::nStatus == ST_DODELETE
         Do Case
         Case cCmd == "250"                      // DEL command successful.
            ::nStatus := ST_DELETEOK
         Otherwise
            ::nStatus := ST_DELETEBAD
         EndCase

      Case ::nStatus == ST_DOPWD
         Do Case
         Case cCmd == "257"                      // PWD command successful.
            ::nStatus := ST_DONEPWD
         Otherwise
            ::nStatus := ST_PWDERROR
         EndCase

      Case ::nStatus == ST_DOPORT
         Do Case
         Case cCmd == "200"                      // OK
            ::nStatus := ST_PORTOK
         Otherwise
            ::nStatus := ST_PORTBAD
         EndCase

      Case ::nStatus == ST_DOTYPE
         Do Case
         Case cCmd == "200"                      // Type set to x.
            ::nStatus := ST_TYPEOK
         Otherwise
            ::nStatus := ST_TYPEBAD
         EndCase

      Case ::nStatus == ST_DOSTOR
         Do Case
         Case cCmd == "150"
            ::nStatus := ST_STOROK
            ::lSendFile := .T.
         Otherwise
            ::nStatus := ST_STORBAD
         EndCase

      Case ::nStatus == ST_STOROK
         Do Case
         Case cCmd == "226"                      // OK
            ::nStatus := ST_STORDONE
         Otherwise
            ::nStatus := ST_STORBAD
         EndCase

      Case ::nStatus == ST_DOPASV
         Do Case
         Case cCmd == "227"                      // Entering Passive Mode (n,n,n,n,m,m).
            ::nStatus := ST_PASVOK
         Otherwise
            ::nStatus := ST_PASVBAD
         EndCase

      Case ::nStatus == ST_DODIR
         Do Case
         Case cCmd == "150"                      // Opening ASCII mode data connection for [file list]
            ::nStatus := ST_DIROK
         Case cCmd == "125"                      // Data connection already open; Transfer starting.
            ::nStatus := ST_DIROK                // some ftp servers return 125 instead of 150
         Otherwise
            ::nStatus := ST_DIRBAD
         EndCase

      Case ::nStatus == ST_DIROK .or. ::nStatus == ST_DIRREADY
         Do Case
         Case cCmd == "226"                      // Transfer complete.
            ::nStatus := ST_DIRDONE
         Otherwise
            ::nStatus := ST_DIRBAD
         EndCase

      Case ::nStatus == ST_DORETR
         Do Case
         Case cCmd == "150"                      // Opening BINARY mode data connection for cFile (nnnnn bytes).
            If ::nRetrBRead == 0                 // in case it jumped the gun (with small files sometimes ST_RETRDONE jumps the gun and file has already arrived!)
               nPos1 := At( "(", ::cReply )
               nPos2 := At( " bytes)", ::cReply )
               ::nRetrFSize := Val( SubStr( ::cReply, nPos1 + 1, nPos2 - nPos1 - 1 ) )///+100
            Endif
            ::nStatus := ST_RETROK
         Case cCmd == "125"                      // command 150 never received, therefore we don't know the size of the file being retrieved
            If ::nRetrFSize == 0                 // horrible hack, but it's the only
               ::nRetrFSize := 1                 // way around this (for the time being)
            Endif
            ::nStatus := ST_RETROK
         Otherwise                               // a 550 means No such file or directory
            ::nStatus := ST_RETRBAD
         EndCase

      Case ::nStatus == ST_RETROK .or. ::nStatus == ST_RETRDONE
         Do Case
         Case cCmd == "226"                      // Transfer complete.
            ::nStatus := ST_RETRDONE
         Otherwise
            ::nStatus := ST_RETRBAD
         EndCase

      Case ::nStatus == ST_DORENFROM
         Do Case
         Case cCmd == "350"
            ::nStatus := ST_RENFROMOK
         Otherwise
            ::nStatus := ST_RENFROMBAD
         EndCase

      Case ::nStatus == ST_DORENTO
         Do Case
         Case cCmd == "250"
            ::nStatus := ST_RENTOOK
         Otherwise
            ::nStatus := ST_RENTOBAD
         EndCase

      Case ::nStatus == ST_DOMKDIR
         Do Case
         Case cCmd == "257"                      // OK
            ::nStatus := ST_MKDIROK
         Otherwise
            ::nStatus := ST_MKDIRBAD
         EndCase

      Case ::nStatus == ST_DOABOR
         Do Case
         Case cCmd == "426"                      // Data connection closed, file transfer cFile aborted.
            ::nStatus := ST_DOABOR               // stay put for successful reply from server
         Case cCmd == "225" .or. cCmd == "226"   // ABOR command successful.
            ::nStatus := ST_ABOROK
         Otherwise
            ::nStatus := ST_ABORBAD
         EndCase

      Case ::nStatus == ST_DORMDIR
         Do Case
         Case cCmd == "250"                      // OK
            ::nStatus := ST_RMDIROK
         Otherwise
            ::nStatus := ST_RMDIRBAD
         EndCase

      Otherwise
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":Unknown exception on cmd " + ::cReply )

      EndCase

   Endif
   ::acReply := {}

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Used to get directory listing.
   cLoc Parameter gives dir spec.
   Returns true or false based on success
   When True. Data var acDir will hold dir listing as returned by server.
*/
Method Dir( cLoc ) CLASS qFTPClient
   Local lOK       := .T.
   Local cPort     := ""
   Local nPos      := 0
   Local cLine     := ""
   Local cSepChar  := ""

   Default cLoc := ""

   ::acDir := {}
   ::cDirBuffer := ""

   ::oTrnSocket := TSocket():New(0)

   If ! ::lPassive
      cPort := ::Port( ::oTrnSocket )

      ::oTrnSocket:bAccept := {|o,n| ::DirAccept( o, n ) }
      ::oTrnSocket:Listen()

      ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

      ::nStatus := ST_DOPORT
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
      ::oSocket:SendData( cPort + CRLF )

      ::DoWait( ST_DOPORT )
      lOK := ::nStatus == ST_PORTOK
   Else
      If ::Pasv()
         If lOK := ::nDataPort > 0
            ::oTrnSocket:bConnect := {|o,n| ::DirAccept( o, n ) }
            ::oTrnSocket:bRead    := {|o,n| ::DirRead( o, n ) }
            ::oTrnSocket:bClose   := {|o,n| ::DirClose( o, n ) }
            ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
            Memory(-1)                           // cleanup memory when connecting frequently
            ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
         Endif
      Endif
   Endif

   If lOK
      ::nStatus := ST_DODIR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":LIST " + AllTrim( cLoc ) )
      ::oSocket:SendData( "LIST " + AllTrim( cLoc ) + CRLF )

      ::DoWait( ST_DODIR )
      ::DoWait( ST_DIROK )

      If lOK := ::nStatus == ST_DIRDONE
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Interpreting dir listing" )
         cSepChar := CRLF
         nPos := At( cSepChar, ::cDirBuffer )
         If nPos == 0
            If ! Empty( ::cDirBuffer )  // single line, just one file, THEREFORE there won't be any CRLF's!
               ::cDirBuffer += CRLF
            Else
               cSepChar := Chr(10)
            Endif
            nPos := At( cSepChar, ::cDirBuffer )
         Endif
         ::acDir := {}
         Do While nPos > 0 .and. ! Eval( ::bAbort )
            cLine := AllTrim( Left( ::cDirBuffer, nPos - 1 ) )
            ::cDirBuffer := SubStr( ::cDirBuffer, nPos + Len( cSepChar ) )
            cLine := AllTrim( StrTran( cLine, Chr(0), "" ) )

            If( ! Empty( cLine ), AAdd( ::acDir, cLine ), Nil )

            nPos := At( cSepChar, ::cDirBuffer )
            SysRefresh()
         Enddo
         lOk := ! Empty( ::acDir )
         ::nStatus := ST_DIRREADY
         SysWait( ::nDelay )                     // allow time for server to respond
      Else
         ::Abort()
      Endif
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirAccept( opSocket, nWSAError ) Class qFTPClient
   Local oSocket

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bRead  := {|o,n| ::DirRead( o, n ) }
      oSocket:bClose := {|o,n| ::DirClose( o, n ) }
   Endif
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data connection established" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirRead( oSocket, nWSAError ) Class qFTPClient
   Local cData := oSocket:GetData()

   ::cDirBuffer += cData
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data received" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage directory socket
*/
Method DirClose( oSocket, nWSAError ) Class qFTPClient

   ::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data socket closed:" + CRLF + ::cDirBuffer )
   oSocket:Close()
   ::nStatus := ST_DIRDONE

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to handle socket closed by server
*/
Method OnClose( oSocket, nWSAError ) Class qFTPClient

   ::Dump( "I:" + NTRIM( ::nStatus ) + ":Server closed down" )
   ::lClosed := .T.
   ::nStatus := ST_CLOSED
   If ValType( ::oSocket ) == "O"
      ::oSocket:Close()
      ::oSocket := Nil
   Endif

   If ValType( ::oTrnSocket ) == "O"
      ::oTrnSocket:Close()
      ::oTrnSocket := Nil
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
 Kills connections
*/
Method End() Class qFTPClient

   If ValType( ::oSocket ) == "O"
      ::oSocket:End()
      ::oSocket := Nil
   Endif

   If ValType( ::oTrnSocket ) == "O"
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

   If ValType( ::oProxy ) == "O"
      ::oProxy:End()
      ::oProxy := Nil
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to obtain unused port no. for data connections.
*/
METHOD Port( oTransSocket ) Class qFTPClient
   Local cIP := GetIP( ::oSocket:nSocket )
   Local nPort
   Local cPort
   Local cComplement

   BindToPort( oTransSocket:nSocket, 0 )         // Get a free port from 1024 - 5000

   nPort       := GetPort( oTransSocket:nSocket )
   cPort       := AllTrim( Str( Int( nPort / 256 ), 3 ) )
   cComplement := AllTrim( Str( Int( nPort % 256 ), 3 ) )

   oTransSocket:nPort := nPort

Return "PORT " + StrTran( AllTrim( StrTran( cIP, ".", "," ) ) + ;
   "," + cPort + "," + cComplement, " ", "" )

//---------------------------------------------------------------------------------------------//
/*
   Change directory on FTP Server.
   Returns True or False based on success
*/
Method CD( cPath ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DOCWD
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":CWD " + cPath )
   ::oSocket:SendData( "CWD " + cPath + CRLF )
   ::DoWait( ST_DOCWD )

   lOK := ::nStatus == ST_DONECWD

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Used internally to set Binary transfer mode for transfers
*/
Method XfrType( cType ) Class qFTPClient
   Local lOK := .T.

   Default cType := "I"

   ::nStatus := ST_DOTYPE
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":TYPE " + cType )
   ::oSocket:SendData( "TYPE " + cType + CRLF )
   ::DoWait( ST_DOTYPE )

   lOK := ::nStatus == ST_TYPEOK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Used to store files on server.
   Parameters : cLocal        : Local File to send
                cRemote       : Location to store file remotely
                bStorProgess  : Codeblock to get percent complete
                oMeter        : Meter object progress bar [optional]
                oText         : Say object used with meter object to display bytes processed [optional]
   Returns True or False based on success
*/
Method Stor( cLocal, cRemote, bStorProgress, oMeter, oText ) Class qFTPClient
   Local cRemFile  := ""
   Local nPos      := 0
   Local cPort     := ""
   Local lOK       := .T.

   Default cRemote := "", ;
           bStorProgress := {|| Nil }

   ::bStorProgress := bStorProgress

   ::lSendFile := .F.
   If Empty( cRemote )
      If ( nPos := RAt( "\", cLocal ) ) > 0
         cRemFile := SubStr( cLocal, nPos + 1 )
      Else
         cRemFile := cLocal
      Endif
   Else
      cRemFile := cRemote
   Endif

   If oMeter # Nil
      oMeter:cargo := .T.                        // cancel button available while download in progress
      oMeter:oWnd:AEvalWhen()
   Endif

   ::XfrType( "I" )
   ::DoWait( ST_DOTYPE )

   ::oTrnSocket := TSocket():New(0)

   If lOK := ::nStatus == ST_TYPEOK

      If ! ::lPassive
         cPort := ::Port( ::oTrnSocket )
         ::oTrnSocket:bAccept := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
         ::oTrnSocket:Listen()
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

         ::nStatus := ST_DOPORT
         ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
         ::oSocket:SendData( cPort + CRLF )

         ::DoWait( ST_DOPORT )
         lOK := ::nStatus == ST_PORTOK
      Else
         If ::Pasv()
            If lOK := ::nDataPort > 0
               ::oTrnSocket:bConnect := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
               ::oTrnSocket:bClose   := {|o,n| ::StorClose( o, n, cLocal, oMeter, oText ) }
               ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
               Memory(-1)                        // cleanup memory when connecting frequently
               ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
            Endif
         Endif
      Endif
   Endif

   If lOk
      ::nStatus := ST_DOSTOR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":STOR " + cRemFile )
      ::oSocket:SendData( "STOR " + cRemFile + CRLF )

      ::DoWait( ST_DOSTOR )
      ::DoWait( ST_STOROK )

      lOK := ::nStatus == ST_STORDONE
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file store socket
*/
Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local oSocket
   Local hFile   := 0
   Local cBuffer := ""
   Local nSent   := 0
   Local nTotal  := 0
   Local lClosed := .F.
   Local nNow    := 0
   Local nSize

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bClose := {|o,n| ::StorClose( o, n, cFile, oMeter, oText ), lClosed := .T. }
   Else
      oSocket := opSocket
   Endif

   Do While ! ::lSendFile .and. ! ::lClosed .and. ! Eval( ::bAbort )
      SysRefresh()
   Enddo

   If ::lSendFile
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data connection established" )

      nNow := Seconds()
      If ( hFile := FOpen( cFile ) ) > 0
         nSize := Directory( cFile )[1,F_SIZE]
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Uploading " + cFile + ", " + NTRIM( nSize ) + " bytes in size" )
         If oMeter # Nil
            oMeter:Set(0)                        // reset
            oMeter:SetTotal( nSize )             // set bar length
         Endif
         cBuffer := Space( BLOCK_SIZE )
         Do While .T.
            nSent := FRead( hFile, @cBuffer, BLOCK_SIZE )
            oSocket:SendData( Left( cBuffer, nSent ) )
            nTotal += nSent
            If ::nDelay > 0
               SysWait( ::nDelay )               // this is trial and error... I'm using 0.5 to 1.5; default is 1.0
            Endif

            Eval( ::bStorProgress, Round( nTotal / nSize * 100, 2 ) )  // left for compatibility with original class
            If( oMeter # Nil, oMeter:Set( nTotal ), Nil )
            If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( nTotal ) + " bytes uploaded..." ), Nil )

            If nSent < BLOCK_SIZE .or. lClosed .or. ::nStatus == ST_STORBAD .or. Eval( ::bAbort )
               Exit
            Endif
            If ::nDelay == 0
               SysRefresh()
            Endif

         Enddo
         FClose( hFile )
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":" + NTRIM( nTotal ) + " bytes of file sent in " + LTrim( Str( Seconds() - nNow, 16, 2 ) ) + " seconds" )
         ::Dump( "I:" + NTRIM( ::nStatus ) + ":Waiting for acknowledgement" )

         oSocket:Close()
      Else
         oSocket:Close()
         oSocket:End()
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":FOpen() failed with file " + cFile + " DOS Error #" + NTRIM( FError() ) )
      Endif
      SysRefresh()
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file store socket
*/
Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient

   If oMeter # Nil
      oMeter:cargo := .F.                        // cancel button not available anymore
      oMeter:oWnd:AEvalWhen()
   Endif
   ::lSendFile := .F.
   oSocket:Close()
   If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
         ::nStatus == ST_ABORBAD .or. ::nStatus == ST_STORBAD
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data aborted" )
   Else
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data completed :-)" )
      ::nStatus := ST_STORDONE
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Close FTP Connection
*/
Method Quit() Class qFTPClient

   ::nStatus := ST_DOQUIT
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":QUIT" )
   If ValType( ::oSocket ) == "O"
      ::oSocket:SendData( "QUIT" + CRLF )
      ::DoWait( ST_DOQUIT )
   Endif

Return .T.

//---------------------------------------------------------------------------------------------//
/*
   Get current directory on FTP Server
   Returns True or False based on success
*/
Method Pwd() Class qFTPClient
   Local cRetVal := ""
   Local nPos := ""
   Local cReply

   ::nStatus := ST_DOPWD
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":PWD" )
   ::oSocket:SendData( "PWD" + CRLF )

   ::DoWait( ST_DOPWD )

   cReply := ::cReply
   nPos := At( '"', cReply )
   cReply := SubStr( cReply, nPos + 1 )

   nPos := At( '"', cReply )
   cReply := SubStr( cReply, 1, nPos - 1 )
   cRetVal := cReply

Return cRetVal

//---------------------------------------------------------------------------------------------//
/*
   Delete file (cFile of server)
   Will return Success True or False
*/
Method Del( cFile ) Class qFTPClient
   Local lOK := .T.

   Default cFile := ""

   ::nStatus := ST_DODELETE

   If lOK := ! Empty( cFile )
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":DELE " + cFile )
      ::oSocket:SendData( "DELE " + cFile + CRLF )

      ::DoWait( ST_DODELETE )

      lOK := ::nStatus == ST_DELETEOK
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Rename file on server
   Parameters : cFrom  : Source file
                cTo    : Target file
   Will return Success True or False
*/
Method Rename( cFrom, cTo ) Class qFTPClient
   Local lOK := .F.

   Default cFrom := "", ;
           cTo   := ""

   If lOK := ! Empty( cFrom ) .and. ! Empty( cTo )
      ::nStatus := ST_DORENFROM
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":RNFR " + cFrom )
      ::oSocket:SendData( "RNFR " + cFrom + CRLF )

      ::DoWait( ST_DORENFROM )

      If lOK := ::nStatus == ST_RENFROMOK
         ::nStatus := ST_DORENTO
         ::Dump( "S:" + NTRIM( ::nStatus ) + ":RNTO " + cTo )
         ::oSocket:SendData( "RNTO " + cTo + CRLF )

         ::DoWait( ST_DORENTO )

         lOK := ::nStatus == ST_RENTOOK
      Endif
   Endif

Return lOk

//---------------------------------------------------------------------------------------------//
/*
   Create a directory
*/
Method MkDir( cDir ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DOMKDIR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":MKD " + cDir )
   ::oSocket:SendData( "MKD " + cDir + CRLF )

   ::DoWait( ST_DOMKDIR )

   lOK := ::nStatus == ST_MKDIROK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Remove a directory
*/
Method RmDir( cDir ) Class qFTPClient
   Local lOK := .T.

   ::nStatus := ST_DORMDIR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":RMD " + cDir )
   ::oSocket:SendData( "RMD " + cDir + CRLF )

   ::DoWait( ST_DORMDIR )

   lOK := ::nStatus == ST_RMDIROK

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Retrieve file from server.
   Parameters : cRemote  : Remote file name
                cLocal   : Local file name
                oMeter   : Meter object progress bar [optional]
                oText    : Say object used with meter object to display bytes processed [optional]
*/
Method Retr( cRemote, cLocal, oMeter, oText ) Class qFTPClient
   Local lOK   := .T.
   Local cPort := ""
   Local nPos  := 0
   Local cLine := ""
   Local nNow  := 0
   LOCAL nLoopTimer:=0

   nPos := RAt( "/", cRemote )
   If nPos == 0
      Default cLocal := cRemote
   Else
      Default cLocal := SubStr( cRemote, nPos + 1 )
   Endif

   If oMeter # Nil
      oMeter:cargo := .T.                        // cancel button available while download in progress
      oMeter:oWnd:AEvalWhen()
   Endif

   ::nRetrHandle := FCreate( cLocal )
   If lOK := ( ::nRetrHandle > 0 )

      ::XfrType( "I" )
      ::DoWait( ST_DOTYPE )

      If lOK := ::nStatus == ST_TYPEOK
         ::oTrnSocket := TSocket():New(0)
         If ! ::lPassive
            cPort := ::Port( ::oTrnSocket )

            ::oTrnSocket:bAccept := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
            ::oTrnSocket:Listen()

            ::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )

            ::nStatus := ST_DOPORT
            ::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
            ::oSocket:SendData( cPort + CRLF )

            ::DoWait( ST_DOPORT )
            lOK := ::nStatus == ST_PORTOK
         Else
            If ::Pasv()
               If lOK := ::nDataPort > 0
                  ::oTrnSocket:bConnect := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
                  ::oTrnSocket:bRead    := {|o,n| ::RetrRead( o, n, cRemote, oMeter, oText ) }
                  ::oTrnSocket:bClose   := {|o,n| ::RetrClose( o, n, cRemote, oMeter, oText ) }
                  ::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
                  Memory(-1)                     // cleanup memory when connecting frequently
                  ::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
               Endif
            Endif
         Endif
      Endif
   Else
      ::Dump( "E:" + NTRIM( ::nStatus ) + ":FCreate() failed with file " + cLocal + " DOS Error #" + NTRIM( FError() ) )
   Endif
   If lOK
      ::nRetrBRead := 0                          // initialize here, not in ::OnRead()
      ::nStatus := ST_DORETR
      ::Dump( "S:" + NTRIM( ::nStatus ) + ":RETR " + cRemote )
      ::oSocket:SendData( "RETR " + cRemote + CRLF )

      ::DoWait( ST_DORETR )
      Do While ::nRetrBRead < ::nRetrFSize .and. ;  // stay put until file fully downloaded so it won't be truncated
            ! ::nRetrHandle == 0 .and. ! ::lClosed .and. ! Eval( ::bAbort ) .and. ;
            ! ::nStatus == ST_RETRBAD            // this is case the file was not found: 550 ?????.???: No such file or directory
///         nLoopTimer++
////         IF nLoopTimer > 50
            SysRefresh()
///            nLoopTimer:=0
///         ENDIF
      Enddo

      ::DoWait( ST_RETROK )

      lOK := ::nStatus == ST_RETRDONE
      SysWait( ::nDelay )                        // allow time for server to respond
   Endif

   If ::oTrnSocket # Nil
      ::oTrnSocket:End()
      ::oTrnSocket := Nil
   Endif

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
*/
Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local oSocket

   If ! ::lPassive
      oSocket := TSocket():Accept( opSocket:nSocket )
      oSocket:bRead  := {|o,n| ::RetrRead( o, n, cFile, oMeter, oText ) }
      oSocket:bClose := {|o,n| ::RetrClose( o, n, cFile, oMeter, oText ) }
   Endif
   ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data connection established" )

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
*/
Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
   Local cData := oSocket:GetData()


   If ::nRetrHandle > 0
      If ::nRetrBRead == 0 .and. oMeter # Nil
         oMeter:Set(0)                           // reset
         oMeter:SetTotal( ::nRetrFSize )         // set bar length
      Endif
      FWrite( ::nRetrHandle, cData )
      ::nRetrBRead += Len( cData )
      If( oMeter # Nil, oMeter:Set( ::nRetrBRead ), Nil )
      If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( ::nRetrBRead ) + " bytes downloaded..." ), Nil )
      ///::Dump( "I:" + NTRIM( ::nStatus ) + ":Bytes retrieved " + NTRIM( ::nRetrBRead ) + " out of " + NTRIM( ::nRetrFSize ) )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Internal method to manage file retrieval socket
   Note: When retrieving very small files, the file might already be downloaded
         before ::nRetrFSize can even be initialized (cmd 150). So it's OK if it's ZERO
*/
Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient

   If oMeter # Nil
      oMeter:cargo := .F.                        // cancel button not available anymore
      oMeter:oWnd:AEvalWhen()
   Endif
   ///FWrite( ::nRetrHandle, oSocket:GetData() )
   SYSWAIT(1)
   FClose( ::nRetrHandle )
   ::nRetrHandle := 0
   oSocket:Close()
   If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
         ::nStatus == ST_ABORBAD .or. ::nStatus == ST_RETRBAD
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data aborted" )
   Else
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data completed" + If( ::nRetrBRead < ::nRetrFSize, ;
         ", but file truncated by " + NTRIM( ::nRetrFSize - ::nRetrBRead ) + " bytes :-(", " :-)" ) )
      // this should avoid the occasional hanging in ::DoWait()
      ::nStatus := If( ::nRetrFSize == 0 .or. ::nRetrBRead >= ::nRetrFSize, ST_RETRDONE, ST_RETRBAD )
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//
/*
   Cancel any transfer/command in progress.
   Called by class if bAbort block evals to true in wait state.
*/
Method Abort() Class qFTPClient
   Local lOK := .T., nStatus := ::nStatus, bAbort := ::bAbort

   ::bAbort := {|| .F. }                         // avoid nested calls to ::Abort()
   ::nStatus := ST_DOABOR
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":ABOR while on " + NTRIM( nStatus ) )
   ::oSocket:SendData( "ABOR" + CRLF )

   ::DoWait( ST_DOABOR )

   lOK := ::nStatus == ST_ABOROK
   ::bAbort := bAbort                            // restore abort codeblock

Return lOK

//---------------------------------------------------------------------------------------------//
/*
   Switch next transfer to passive mode
*/
Method Pasv() Class qFTPClient
   Local cReply := ""
   Local nPos   := 0

   ::nStatus := ST_DOPASV
   ::Dump( "S:" + NTRIM( ::nStatus ) + ":PASV" )
   ::oSocket:SendData( "PASV" + CRLF )

   ::DoWait( ST_DOPASV )

   If ::lPassive := ::nStatus == ST_PASVOK
      cReply := ::cReply
      nPos := At( "(", cReply )
      cReply := SubStr( cReply, nPos + 1 )

      nPos := At( ")", cReply )
      cReply := Left( cReply, nPos - 1 )

      ::cDataIP := StrToken( cReply, 1, "," ) + "."
      ::cDataIP += StrToken( cReply, 2, "," ) + "."
      ::cDataIP += StrToken( cReply, 3, "," ) + "."
      ::cDataIP += StrToken( cReply, 4, "," )

      ::nDataPort := 0
      ::nDataPort += 256 * Val( StrToken( cReply, 5, "," ) )
      ::nDataPort += Val( StrToken( cReply, 6, "," ) )
      ::Dump( "I:" + NTRIM( ::nStatus ) + ":Server has opened connection on port " + NTRIM( ::nDataPort ) + " - IP:" + ::cDataIP )
   Endif

Return ::lPassive

//---------------------------------------------------------------------------------------------//
/*
   Internal method to wait for responses from server.
*/
Method DoWait( nState ) Class qFTPClient
   Local nStart := Seconds()
   LOCAL nRefresh:=0

   Do While ::nStatus == nState .and. ! ::lClosed .and. ! Eval( ::bAbort )
      If ::nTimeOut > 0 .and. Seconds() - nStart > ::nTimeOut
         ::Dump( "E:" + NTRIM( ::nStatus ) + ":Timed out waiting for state " + NTRIM( nState ) + " to finish" )
         Exit
      Endif
      /*nRefresh++
      if nRefresh ==3
         SysRefresh()
         nRefresh:=0
      endif
      */
      SysRefresh()
      ///SysRefresh()
      ///SysRefresh()
   Enddo

   If nState # ST_DOABOR .and. Eval( ::bAbort )
      SYSWAIT(.5)
      ::Abort()
   Endif

Return Nil

//---------------------------------------------------------------------------------------------//

_ retr works to you? I try:

oFTP:Retr("/empresa1/avisos.txt")
The file is created in exe folder but size 0.

Thanks.

[jll-fwh]

Hola Francisco:

Tendría que revisar la clase de harbour porque hace mucho que hice el programa pFTP y llevo muchos meses sin tocar nada de programación. Pero así de memoria creo que no va a ser posible, ya que no recuerdo que las clases de harbour tuvieran algún DATA al respecto.

Ya lo reviso y te comento.

Un saludo
JLL