FiveTech Software tech support forums

by **Wanderson** » Mon Feb 10, 2014 1:37 pm

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

by **StefanHaupt** » Tue Feb 11, 2014 12:30 pm

Wanderson,

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

by **Wanderson** » Wed Feb 12, 2014 12:49 pm

StefanHaupt wrote: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()

by **jll-fwh** » Wed Feb 12, 2014 4:22 pm

Here you have a complete FTP program your source code.

I hope you find it useful.

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

a greeting
JLL

by **ORibeiro** » Wed Feb 12, 2014 4:35 pm

This is Ok.

Code: Select all Expand view: // 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 //---------------------------------------------------------------------------------------------//

by **Wanderson** » Thu Feb 13, 2014 2:22 am

Thanks to all, Oscar Ribeiro solution runs ok.

by **Francisco Horta** » Thu Feb 13, 2014 3:18 pm

Javier

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

by **Wanderson** » Fri Feb 14, 2014 12:24 am

ORibeiro wrote:This is Ok.

Code: Select all Expand view
// 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 //---------------------------------------------------------------------------------------------//

Oscar retr works to you? I try:

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

Thanks.

by **jll-fwh** » Wed Feb 19, 2014 1:13 am

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

FiveTech Software tech support forums

ftp problem

ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Re: ftp problem

Who is online