ecmsoft Posted April 22, 2015 Report Share Posted April 22, 2015 Estou precisando acessar um servidor FTP. Porém, ele só aceita conexão utilizando os recursos SSL/TSL. Eu utilizo a Classe tIPClientFtp() para fazer o acesso. FTP não seguro, abre normalmente, porém, FTP com criptografia, eu consigo conexão, mas ele não deixa logar, pelo fato das informações não estarem criptografadas. Alguem já passou por isso ? Alguma ideia alternativa ? Lembrando que o FireFox e o Crhome conseguem abrir, porém, o IE não consegue ! Quote Link to comment Share on other sites More sharing options...
gilmer Posted April 22, 2015 Report Share Posted April 22, 2015 Eu usei a DLL Chilkat Software e funciona muito bem Quote Link to comment Share on other sites More sharing options...
Ariston Santos Posted April 22, 2015 Report Share Posted April 22, 2015 Olá. Você está usando a classe qFTPClient? Se não, testa aí. *------------------------------------------------------------------------------* STATIC FUNCTION ChecaEntTxt() LOCAL cFldEn := "C:\" LOCAL c_Ftp := "" LOCAL c_Usr := "" LOCAL c_Psw := "" LOCAL c_Fld := "" TRY oFTP := qFTPClient():New(c_Ftp, 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,c_Usr, c_Psw) oFTP:lPassive := .T. if oFTP:Connect() if oFTP:Cd(c_Fld) if oFTP:Dir() a_Fls := {} FOR nLin := 1 TO LEN(oFTP:acDir) IF ".TXT" $ Alltrim(Substr(oFTP:acDir[nLin],40,256)) // Não pegar se não for txt (ex: index.php) n_At := AT("ARPED_", oFTP:acDir[nLin]) AADD(a_Fls, Alltrim(Substr(oFTP:acDir[nLin],n_At,256)) ) ENDIF NEXT IF LEN(a_Fls) > 0 for nPd := 1 TO LEN(a_Fls) c_Arq := a_Fls[nPd] IF ! EMPTY(c_Arq) IF ! FILE(cFldEn+"\"+c_Arq) lRtr := oFTP:Retr(c_Arq, cFldEn+"\"+c_Arq) // c_Fld+"/"+ IF lRtr MsgInfo(c_Arq, "Novo pedido") ELSE MsgInfo(c_Arq+": Não recuperado", "Pedido externo") ENDIF ENDIF ENDIF next ELSE MsgInfo("Sem novos pedidos.", "Sem novos pedidos") ENDIF oFTP:Quit() oFTP:End() else oFTP:Quit() oFTP:End() endif else oFTP:Quit() oFTP:End() endif endif CATCH oErr MsgInfo(oErr:Description, "Erro de FTP") END TRY RETURN NIL Classe: // 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 ) ) ) /* Início - Testes */ Function FtpTestMain() local oWin DEFINE WINDOW oWin TITLE "FTP Test" oWin:Center() ACTIVATE WINDOW oWin ON INIT FTPTest(oWin) return nil Static Function FTPTest(oWin) local oFTP Ferase("logftp.txt") USE CONTROLE SHARED NEW ordListClear() OrdListAdd("CONTROLE", "CTRLCODI") CONTROLE->(DBGOTOP()) IF CONTROLE->(EOF()) CONTROLE->(DBAPPEND()) ENDIF c_Ftp := ALLTRIM(CONTROLE->FTP_FTP) c_Usr := ALLTRIM(CONTROLE->FTP_USR) c_Psw := ALLTRIM(CONTROLE->FTP_PSW) c_Fld := ALLTRIM(CONTROLE->FTP_FLD) CLOSE CONTROLE SELECT 0 oFTP := qFTPClient():New(c_Ftp, 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,c_Usr, c_Psw) // 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(c_Fld) MSginfo("Successfully changed dir to "+c_Fld) if oFTP:Dir() a_Dir := {} a_Fls := {} FOR nLin := 1 TO LEN(oFTP:acDir) IF EMPTY(Substr(oFTP:acDir[nLin],26,3)) // Tipo: DIR=Pasta; Vazio=Arquivo AADD(a_Fls, Alltrim(Substr(oFTP:acDir[nLin],40,256)) ) ENDIF /* AADD(a_Dir, {Alltrim(Substr(oFTP:acDir[nLin],40,256)),; // Nome do arquivo ou pasta Alltrim(Substr(oFTP:acDir[nLin],1,8)),; // Data de modificação Alltrim(Substr(oFTP:acDir[nLin],11,7)),; // Hora de modificação Alltrim(Substr(oFTP:acDir[nLin],26,3)),; // Tipo: DIR=Pasta; Vazio=Arquivo Alltrim(Substr(oFTP:acDir[nLin],30,9))}) // Tamanho do arquivo */ NEXT * xBrowse(a_Dir, "Got directory listing") IF LEN(a_Fls) > 0 c_Arq := MsgSelect(a_Fls, "", "Selecione o arquivo", "&Download", "Ca&ncelar") IF ! EMPTY(c_Arq) IF oFTP:Retr(c_Fld+"/"+c_Arq, c_Arq) MsgInfo("Arquivo "+c_Arq+" baixado com êxito","Downlaod") ENDIF ENDIF ENDIF // 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 oWin:End() return nil /* Fim - Testes */ 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 ) 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.