oribeiro Posted February 23, 2015 Report Share Posted February 23, 2015 Pessoal, Qual é melhor modo de fazer UpLoad / Download de arquivos (por dentro do sistema) num site hospedado no LocalWeb? Aguardo, obrigado. WelchDats 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 23, 2015 Report Share Posted February 23, 2015 Veja se te ajuda: http://fivewin.com.br/index.php?/topic/21793-fuentes-javier-lloris/ abs. Quote Link to comment Share on other sites More sharing options...
Wellington Vieira Posted February 23, 2015 Report Share Posted February 23, 2015 Veja se ajuda também.. http://fontefivewin.site88.net/transferencias-de-arquivos-via-ftp-com-fivewin-for-xharbour/ abs. kapiaba 1 Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 23, 2015 Author Report Share Posted February 23, 2015 Rapaz, Que negócio complicado! Não estou conseguindo. Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 23, 2015 Report Share Posted February 23, 2015 Olá, baixe o LeechFTP, para entender melhor como funciona. http://www.leechftp.de/ É velhinho, mas funciona. abs. Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 23, 2015 Author Report Share Posted February 23, 2015 Obrigado pela dica, vou estudá-la, entretanto: Tem que usar programa externo? Não tem função nativa no xHarbour para controlar FTP? kapiaba 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 23, 2015 Report Share Posted February 23, 2015 Obrigado pela dica, vou estudá-la, entretanto: Tem que usar programa externo? Não tem função nativa no xHarbour para controlar FTP? Tem, tanto que tem dois links para voce estudar. Veja primeiro como é um programa em FTP, para poder entender em five. Outra coisa, seria pedir o FTP do Vagner Wirts, que se não me falha a memória, funciona de boa... Se bem que é dificil pra xuxu. kkkkkkkkkkkkkkkkkkkkkkkkkkkk abs. Quote Link to comment Share on other sites More sharing options...
aferra Posted February 23, 2015 Report Share Posted February 23, 2015 Veja se ajuda também.. http://fontefivewin.site88.net/transferencias-de-arquivos-via-ftp-com-fivewin-for-xharbour/ abs. Esse é o que estou usando e funciona de boa... Theotokos 1 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 23, 2015 Report Share Posted February 23, 2015 Esse é o que estou usando e funciona de boa... Parece fácil, mas o Matheus Farias, não colocou um exemplo completo. Você poderia colocar algo mais completo meu rey()?? obg. abs. Se bem que o Matheus Farias, tá no skype... qualquer coisa, eu aperto ele... kkkkkkkkkkkkkkkkkkkkkk Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 23, 2015 Author Report Share Posted February 23, 2015 Esse exemplo parece bem fácil, mas não consegui fazer funcionar. Um exemplo de utilização seria muito útil. Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 23, 2015 Author Report Share Posted February 23, 2015 O Exemplo do Wagner é esse, uso por anos e nunca tive problemas, mas foi só mudar para LOCALWEB que as vezes funciona e as vezes não. // 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("xxx.xxx.xxx.xxx", 21, {|cMessage| Logfile("logftp.txt",{cMessage})},,"oasys", "senhaftpoasys") // 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 ) 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, nSize ) 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 .AND. ::nRetrFSize == 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 ) SysWait(0.2) // para ler todo o diretório no LocalWeb // msginfo(len(::acdir),::acdir[len(::acdir)]) 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 .and. oText#Nil oMeter:Set(0) // reset oMeter:SetTotal( nSize ) // set bar length oText:SetText( "Uploading file: "+cFile ) 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 ) oMeter:cText = cFile + ": " + NTRIM( nTotal ) + " bytes uploaded =" EndIf 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, nSize ) 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 Default nSize := 0 ::nRetrFSize := nSize 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 .and. oText#Nil oMeter:Set(0) // reset oMeter:SetTotal( ::nRetrFSize ) // set bar length oText:SetText( "Aguarde o download do arquivo: "+Upper(cFile)+" com "+Alltrim(Transform(::nRetrFSize,'@E 999,999,999,999'))+" bytes.") Endif FWrite( ::nRetrHandle, cData ) ::nRetrBRead += Len( cData ) If oMeter#Nil oMeter:cText = "Baixados "+Alltrim(Transform(::nRetrBRead,'@E 999,999,999,999'))+" de "+Alltrim(Transform(::nRetrFSize,'@E 999,999,999,999'))+" bytes =" oMeter:Set( ::nRetrBRead ) EndIf 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...
kapiaba Posted February 23, 2015 Report Share Posted February 23, 2015 O Matheus disse que com LOCALWEB o exemplo dele funciona de boa. Melhor falar diretamente com ele. abs. Quote Link to comment Share on other sites More sharing options...
sambomb Posted February 23, 2015 Report Share Posted February 23, 2015 Sua internet usa proxy? Se tiver pode ser esse o problema, tem configuração específica para quando usa proxy... Quote Link to comment Share on other sites More sharing options...
aferra Posted February 23, 2015 Report Share Posted February 23, 2015 Atendendo pedidos. segue exemplos. //o que significa cada campo FtpUpload( "ftp.<seu_dominio>.com.br",<usuario>, <senha>, <um_arquivo>,<toda_a_pasta>,<pasta_do_ftp>,<objeto_windows>,<mensagem> ) //como usar //Primeiro quero salvar os dbf´s e salvar em uma pasta do ftp FtpUpload( "ftp.<seu_dominio>.com.br",; <usuario>, ; <senha>, ; "", ; //deixo vazio pois não quero um arquivo "C:\programa\dados\",; //indico o caminho dos dbf´s "/DBF/",; // indico a pasta no FTP que quero salvar "","" ) //os dois ultimos eu deixo em branco pois não quero mostrar nada somente salvar...e coloco depois em dbf se deu certo ou não Function FtpUpload(cServer,cUser,cPassword,cFile,cDirectory,cUploadDirectory,oObjeto,cMensagem, tipo ) Local cUrl,oUrl,oFTP,aFiles,cStr ,lRetorno local cTime := TIME() // Default cServer:="",cUser:="",cPassword:="",cFile:="",cDirectory:="",cUploadDirectory:="" cServer:=alltrim(cServer) cUser:=alltrim(cUser) cPassword:=alltrim(cPassword) if Empty(cServer) msgAlert("Atenção Host não informado!","Alerta") return .f. endif if Empty(cUser) msgAlert("Atenção Usuario não informado!","Alerta") return .f. endif if Empty(cPassword) msgAlert("Atenção Senha não informado!","Alerta") return .f. endif if Empty(cFile) if Empty(cDirectory) msgAlert("Atenção Arquivo ou Diretório não informado!","Alerta") return .f. endif endif if !isConnected() msgAlert("Atenção Sem Conexão com a Internet!","Alerta") return .f. endif cUrl := "ftp://" + cUser + ":" + cPassword + "@" + cServer + cUploadDirectory oUrl := tUrl():New( cUrl ) oFTP := tIPClientFtp():New( oUrl, .T. ) oFTP:nDefaultPort := 21 oFTP:nConnTimeout := 3000 oFTP:bUsePasv := .T. if At("@",cUrl)>0 oFTP:oUrl:cServer := cServer oFTP:oUrl:cUserID := cUser oFTP:oUrl:cPassword := cPassword endif if Empty(cDirectory) if !Empty(cFile) IF oFTP:Open( oFTP:oUrl ) Try cMensagem:="Enviando: "+cFile oObjeto:Refresh() Catch SysRefresh() end IF !oFtp:UploadFile( cFile ) *msgstop("Falha ao enviar ,"+if(!file(cFile),"Arquivo não existe","arquivo em uso")+" : "+cFile,"Erro") Logfile("FTPFALHA.log",{if(!file(cDirectory+cFile[ 1 ]),"arquivo não existe","arquivo em uso"), cDirectory+cFile[ 1 ]}) oFTP:oUrl:cPath := "" lRetorno := .f. ELSE oFTP:oUrl:cPath := "" lRetorno := .t. ENDIF SysWait() oFTP:Close() ELSE lRetorno:=.f. ENDIF endif Else aFiles := Directory( cDirectory + "*.DBF", "D" ) IF Len( aFiles ) > 0 IF oFTP:Open( oFTP:oUrl ) FOR each cFile IN afiles IF cFile[ 1 ] == "." .OR. cFile[ 1 ] == ".." ELSE Try cMensagem:="Enviando: "+cFile[ 1 ] oObjeto:Refresh() Catch SysRefresh() end IF !oFtp:UploadFile( cDirectory+cFile[ 1 ],cFile[ 1 ] ) *msgstop("Falha ao enviar ,"+if(!file(cDirectory+cFile[ 1 ]),"arquivo não existe","arquivo em uso")+" : "+cDirectory+cFile[ 1 ],"Erro") Logfile("FTPFALHA.log",{if(!file(cDirectory+cFile[ 1 ]),"arquivo não existe","arquivo em uso"), cDirectory+cFile[ 1 ]}) oFTP:oUrl:cPath := "" lRetorno := .F. ELSE oFTP:oUrl:cPath := "" lRetorno := .t. ENDIF ENDIF SysWait() NEXT oFTP:Close() ELSE lRetorno := .F. ENDIF ENDIF endif if !lRetorno cStr := "Não foi possivel conectar ao Ftp:" + oURL:cServer IF oFTP:SocketCon == NIL cStr += Chr( 13 ) + Chr( 10 ) + "Conexão não iniciada!" ELSEIF InetErrorCode( oFTP:SocketCon ) == 0 cStr += Chr( 13 ) + Chr( 10 ) + "Resposta do Servidor:" + " " + oFTP:cReply ELSE cStr += Chr( 13 ) + Chr( 10 ) + "Erro na Conexão:" + " " + InetErrorDesc( oFTP:SocketCon ) ENDIF SysRefresh() *msgstop(cStr,"Erro") Logfile("FTPERRO.log",{cStr}) lRetorno := .F. else Logfile("FTP.log",{cTime,TIME(),oTravaSis:cUser}) cUrl := NIL oFTP := NIL endif RETURN lRetorno troquei onde salvo no dbf pelo logfile para vcs terem uma ideia do que pode ser feito...mas qualquer coisa, basta GRITAR. ainda não fiz o teste do upload, assim que fizer eu tb posto aquiPS: "Demorô" um pouco patrão, desculpe tá kapiaba 1 Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 24, 2015 Author Report Share Posted February 24, 2015 Alessandro, Vou testar o seu exemplo de upload, obrigado. Se não for pedir demais, posta também o exemplo de Download? Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 24, 2015 Author Report Share Posted February 24, 2015 Esta apresentando a mesma instabilidade que a minha funcao: Ora aparece que 24/02/2015 07:52:12: Não foi possivel conectar ao Ftp:ftp.oasysitu.com Ora conecta: 24/02/2015 07:55:01: Conexão não iniciada! Ora envia, ora diz que o mesmo arquivo que conseguiu enviar esta sendo usado: 24/02/2015 07:56:04: arquivo não existe ou esta em uso Quote Link to comment Share on other sites More sharing options...
aferra Posted February 24, 2015 Report Share Posted February 24, 2015 então não sei o que pode ser Oscar...e qto ao download eu ainda não consegui....tem pouco material sobre o assunto...mas irei continuar a "luta" dou noticias kapiaba 1 Quote Link to comment Share on other sites More sharing options...
william Posted February 24, 2015 Report Share Posted February 24, 2015 Olá Oscar, eu utilizo as funcoes de ftp nativas do xharbour. No link abaixo tem um exemplo completo em fivewin que eu fiz, funcoes para download e upload com barra de progresso. Apenas adicione a LIB TIP.LIB na compilação. Abraço William Adami LINK: http://www.4shared.com/rar/j7hmst-Jba/meuftp.html Quote Link to comment Share on other sites More sharing options...
aferra Posted February 25, 2015 Report Share Posted February 25, 2015 tudo funcionando....obrigado William kapiaba 1 Quote Link to comment Share on other sites More sharing options...
william Posted February 25, 2015 Report Share Posted February 25, 2015 Ok brother , estamos aqui pra ajudar e ser ajudado ! Abraço William Adami aferra and kapiaba 2 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 25, 2015 Report Share Posted February 25, 2015 William, uma dúvida: Dentro do FTP, temos várias subspastas, supondo que eu queira enviar TESTE.TXT para a pasta TESTE, tem jeito? Obg. abs. WelchDats 1 Quote Link to comment Share on other sites More sharing options...
william Posted February 25, 2015 Report Share Posted February 25, 2015 Olá Kapi faça assim: oFTP:Cwd("www/pasta/sistema") // muda o diretorio no FTP obs.: aqui tem as funções de FTP da lib: METHOD New( oUrl, lTrace, oCredentials ) METHOD Open() METHOD Read( nLen ) METHOD Write( nLen ) METHOD Close() METHOD TransferStart() METHOD Commit() METHOD GetReply() METHOD Pasv() METHOD TypeI() METHOD TypeA() METHOD NoOp() METHOD Rest( nPos ) METHOD List( cSpec ) METHOD UserCommand( cCommand, lPasv, lReadPort, lGetReply ) METHOD Pwd() METHOD Cwd( cPath ) METHOD Dele( cPath ) METHOD Port() METHOD SendPort() METHOD Retr( cFile ) METHOD Stor( cFile ) METHOD Quit() METHOD ScanLength() METHOD ReadAuxPort() METHOD mget() // Method bellow contributed by Rafa Carmona METHOD LS( cSpec ) METHOD Rename( cFrom, cTo ) // new method for file upload METHOD UpLoadFile( cLocalFile, cRemoteFile ) // new method to download file METHOD DownLoadFile( cLocalFile, cRemoteFile ) // new method to create an directory on ftp server METHOD MKD( cPath ) METHOD RMD( cPath ) METHOD listFiles( cList ) METHOD MPut METHOD StartCleanLogFile() METHOD fileSize( cFileSpec ) Abraço William Adami Quote Link to comment Share on other sites More sharing options...
william Posted February 25, 2015 Report Share Posted February 25, 2015 aqui 1 exemplo de como fazer via HTTP . Essa lib TIP.LIB é boa mesmo. *************** FUNCTION MAIN() *************** Local cURL, lRet:=.F. Local nTAMANHO:=0 LOCAL oConn cURL := "http://www.meusite.com.br/arquivo.rar" nTAMANHO := GET_FILE_SIZE('arquivo.rar') // aqui uso uma função em PHP para pegar o tamanho do arquivo TRY oConn := TipClientHttp():New(TURL():New(cURL)) oConn:nConnTimeout := 10000 oConn:exGauge := { | done, size| ShowGauge(done, size, nTAMANHO ) } IF oConn:Open(cURL) oConn:ReadToFile('c:\salva_nessa_pasta\nome_do_arquivo.rar') oConn:Close() ENDIF lRet:=.T. CATCH lRet:=.F. END RETURN(lRet) ****************************************** PROCEDURE SHOWGAUGE( nSent, nSize, nTotal) ****************************************** IF nSent > 0 @ 10,10 SAY STR(nSent/1000000)+" Mb de: " + str(nTotal/1000000)+ " Mb "+str((nSent/nTotal)*100,4) +" %" ENDIF RETURN ************************************ FUNCTION GET_FILE_SIZE(cCAMINHO_URL) ************************************ LOCAL nRET_BYTS:=0 LOCAL oHttp, cHtml:='' IF Empty( cCAMINHO_URL ) Return(nRET_BYTS) ENDIF TRY oHttp:= TIpClientHttp():new( "http://www.meusite.com.br/tamanhoArquivo.php?caminho="+alltrim(cCAMINHO_URL)) CATCH Return(nRET_BYTS) END IF oHttp:open() cHtml := oHttp:readAll() IF !EMPTY(cHtml) IF LEN(cHTML) > 0 .AND. LEN(cHTML) < 20 nRET_BYTS:=VAL(alltrim(cHTML)) ENDIF ENDIF ENDIF oHttp:close() RETURN(nRET_BYTS) a função tamanhoarquivo.php para pegar o tamanho do arquivo: <?php function obterTamanho($url){ if(file_exists($url)){ //SE O ARQUIVO EXISTE $tamanho = filesize($url); return $tamanho; } else{ return 'Arquivo não encontrado'; } } ?> <?php if(isset($_GET['caminho'])){ $caminho = $_GET['caminho']; echo obterTamanho($caminho); } ?> Os créditos deste exemplo vão para Leonardo Machado (Sygecom), do site Clipper on Line. Ele quem postou este exemplo lá. att. William Adami Quote Link to comment Share on other sites More sharing options...
oribeiro Posted February 25, 2015 Author Report Share Posted February 25, 2015 No meu caso não vai: O Enviar dá falha no envio e o Lista dá erro: Application =========== Path and name: C:\FWH\samples\ftp.exe (32 bits) Size: 2,537,984 bytes Compiler version: xHarbour 1.2.3 Intl. (SimpLex) (Build 20141206) FiveWin Version: FWHX 13.11 Windows version: 6.0, Build 6002 Service Pack 2 Time from start: 0 hours 0 mins 5 secs Error occurred at: 02/25/15, 13:11:14 Error description: Error BASE/1132 Bound error: array access Args: [ 1] = A { ... } [ 2] = N 1 Stack Calls =========== Called from: ftp.prg => LISTA( 476 ) Called from: ftp.prg => (b)MAIN( 26 ) Called from: .\source\classes\BUTTON.PRG => TBUTTON:CLICK( 163 ) Called from: .\source\classes\CONTROL.PRG => TBUTTON:HANDLEEVENT( 1687 ) Called from: .\source\classes\WINDOW.PRG => _FWH( 3236 ) Called from: => SENDMESSAGE( 0 ) Called from: .\source\classes\DIALOG.PRG => TDIALOG:COMMAND( 389 ) Called from: => TWINDOW:HANDLEEVENT( 0 ) Called from: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT( 892 ) Called from: => DIALOGBOX( 0 ) Called from: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE( 274 ) Called from: ftp.prg => MAIN( 31 ) Quote Link to comment Share on other sites More sharing options...
kapiaba Posted February 25, 2015 Report Share Posted February 25, 2015 Oscar, tente em outra máquina. aqui vai normal. 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.