Ariston Santos

Uso assim e funciona: oBrw:bLClicked := {|| MsgInfo("Sua função","Ok") }

Olá. Eu uso a classe qFTPClient. Não me lembro se obtive ela aqui ou no forum internacional: // 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 //---------------------------------------------------------------------------------------------// Uso esta função para pegar (download) do FTP: *-------------------( Ler no ftp )------------------* STATIC FUNCTION ChecaEntTxt() LOCAL cFldEn := ALLTRIM(GetPvProfString( "ENTIRE_CFG", "PastaEntrada", " ", cAppPath+"\SISCOM.INI")) LOCAL c_Ftp := GetPvProfString( "CONNECTION", "eFtp", " ", ".\siscomon.ini") LOCAL c_Usr := GetPvProfString( "CONNECTION", "eLog", " ", ".\siscomon.ini") LOCAL c_Psw := GetPvProfString( "CONNECTION", "ePsw", " ", ".\siscomon.ini") LOCAL c_Fld := GetPvProfString( "CONNECTION", "eDir", " ", ".\siscomon.ini") LOCAL cMsg := "", lNovo := .F. 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 lNovo := .T. MsgAlert(c_Arq, "Novo pedido") ELSE MsgAlert(c_Arq+": Não recuperado", "Pedido externo") ENDIF ENDIF ENDIF next ENDIF oFTP:Quit() oFTP:End() else oFTP:Quit() oFTP:End() endif else oFTP:Quit() oFTP:End() endif endif CATCH oErr MsgAlert(oErr:Description, "Erro de FTP") END TRY RETURN NIL

Funcionou exatamente como eu queria. Obrigado.

Dá para exemplificar? Obrigado.

Amigos, Estou querendo enviar o conteúdo de um DBF para uma tabela do MySQL sem repetir cadastros. O motivo é que eu já enviei o conteúdo uma vez e agora quero que grave apenas os registros novos. Como são muitos, quero que a validação seja feita via comando, para eu não ter que enviar os novos um a um. Qual comando INSERT me permite incluir apenas os registros não existentes na tabela, validando por CNPJ? Quero algo do tipo (Exemplo abaixo, não testado, apenas para demonstrar): INSERT INTO CLIENTES (CNPJ, RAZAO, FANTASIA, ENDERECO, TELEFONE) SET ('12345678000101', 'RAZAO SOCIAL 01', 'NOME FANTASIA 01', 'ENDEREÇO 01', '9 9123-9991') IF NOT EXIST CNPJ = '12345678000101' SET ('12345678000102', 'RAZAO SOCIAL 02', 'NOME FANTASIA 02', 'ENDEREÇO 02', '9 9123-9992') IF NOT EXIST CNPJ = '12345678000102' SET ('12345678000103', 'RAZAO SOCIAL 03', 'NOME FANTASIA 03', 'ENDEREÇO 03', '9 9123-9993') IF NOT EXIST CNPJ = '12345678000103' SET ('12345678000104', 'RAZAO SOCIAL 04', 'NOME FANTASIA 04', 'ENDEREÇO 04', '9 9123-9994') IF NOT EXIST CNPJ = '12345678000104' SET ('12345678000105', 'RAZAO SOCIAL 05', 'NOME FANTASIA 05', 'ENDEREÇO 05', '9 9123-9995') IF NOT EXIST CNPJ = '12345678000105' SET ('12345678000106', 'RAZAO SOCIAL 06', 'NOME FANTASIA 06', 'ENDEREÇO 06', '9 9123-9996') IF NOT EXIST CNPJ = '12345678000106' Grato.

Coleguinhas, Por que não usar a QRCodeLib.Dll? Testei ela e achei prática e funcional!

Pesquisando a legislação e, de acordo com o que entendi, não seria ilegal quando o dado pessoal fosse divulgado pela própria pessoa. Portanto, para existir esse tipo de serviço, cada pessoa teria que autorizara divulgação de seus dados pessoais, e que dados seriam disponibilizados além do CPF. Ou seja, teria que haver uma espécie de SINTEGRA para pessoa física. Particularmente, acho que essa seria uma boa idéia. Não sei como o governo ainda não criou esse tipo de serviço.

Se isso existisse, provavelmente seria ilegal. Veja este: http://blogs.diariodonordeste.com.br/navegando/geral/site-que-revela-informacoes-intimas-de-pessoas-fisicas-vira-polemica-na-internet/

Oi, amigo. Salve o que deseja imprimir em um TXT, pode ser via TDOSPRN se quiser enviar comandos de formatação, e imprima usando a função PrintFileRaw(). Exemplo: // ImpressÆo em Spool ------------------------------------------------------- function ImpSpool(cArquivoTxt, cImpressora) nResult := PrintFileRaw(cImpressora, cArquivoTxt, "Trabalho de impressão") cMsg := "" SWITCH nResult CASE -1 cMsg += "Erro nos parêmetros passados para a função" ; EXIT CASE -2 cMsg += "Falha na chamada à função OpenPrinter()" ; EXIT CASE -3 cMsg += "Falha na chamada à função StartDocPrinter()" ; EXIT CASE -4 cMsg += "Falha na chamada à função StartPagePrinter()" ; EXIT CASE -5 cMsg += "Falha na alocação de memória" ; EXIT CASE -6 cMsg += "Arquivo " + c_Spool + " não encontrado" ; EXIT END IF ! EMPTY(cMsg) SysRefresh() MsgInfo(cMsg, "Informação") ENDIF return .t.

No exemplo simples abaixo, eu consigo selecionar clicando em qualquer célula da coluna 1. Vê se ajuda. REDEFINE XBROWSE oBrow ID 132 ; HEADERS " X", "Categoria" ; PICTURES NIL, NIL ; OF oFDl ; ARRAY aCateg AUTOCOLS ; ON DBLCLICK (aCateg[oBrow:nArrayAt,1] := IIF(aCateg[oBrow:nArrayAt,1],.F.,.T.), oBrow:Refresh()) oBrow:lColDividerComplete := .f. oBrow:bClrSelFocus := {|| { CLR_WHITE, CLR_HBLUE }} // Seleção com foco oBrow:bClrSel := {|| { CLR_BLACK, CLR_GRAY }} // Seleção sem foco WITH OBJECT oBrow:aCols[1] :SetCheck() :bLClickHeader := { |r,c,f,oCol| (lCheck:=!lCheck, AEval(aCateg, {|nC|nC[1] := lCheck}), oBrow:Refresh()) } // Marcar/Desmarcar todos se clicar no header END

Amigo, As datas gravadas em banco de dados relacional geralmente são no formato UTC. Se for este seu caso, a função abaixo resolve: FUNCTION UTCtoDh(cDate, lHora) LOCAL cDtHo := SUBSTR(cDate,9,2)+"/"+SUBSTR(cDate,6,2)+"/"+SUBSTR(cDate,1,4)+IIF(lHora,", "+SUBSTR(cDate,12,5),"") RETURN(cDtHo)

Amigo, só consegui isso com telas desenhadas no Resource Workshop. Fora isso, que eu saiba, só com Ctrl + Enter.

Amigo, eu faço assim: DEFINE FONT oFont NAME "Arial" SIZE 0, -12 OF oPrn DEFINE FONT oFon2 NAME "Verdana" SIZE 0, -12 OF oPrn nRow := 3 // Linha inicial nPag := 1 // Página inicial mLarg := oFon2:nHeight nTab := oPrn:nHorzRes()/20 nSpc := (oPrn:nHorzRes()-(2*nTab)) / 90 nCls := {nTab+(nSpc*00),; // Coluna 1 nTab+(nSpc*06),; // Coluna 2 nTab+(nSpc*50),; // Coluna 3 nTab+(nSpc*62),; // Coluna 4 nTab+(nSpc*73),; // Coluna 5 nTab+(nSpc*82),; // Coluna 6 nTab+(nSpc*90) } // Coluna 7 *... Imprime o cabeçalho *... Impressão dos dados nRow++ // Proxima linha PulaPag(oPrn,@nRow,mLarg,nTab,nCls,oFont,@nPag,nTp,nPp,nSpc,oPen,lLogo,.T.) // Verifica se chegou no final da área imprimível e imprime o cabeçalho e rodapé A função PulaPag imprime o rodapé e cria a nova página já com o cabeçalho. STATIC FUNCTION PulaPag(oPrn,nRow,mLarg,nTab,nCls,oFont,nPag,nTp,nPp,nSpc,oPen,lLogo,lCab) LOCAL nUltLin IF (nRow*mLarg) >= ( oPrn:nVertRes()-(nUltLin*mLarg) ) // Se chegou no final da área imprimível IF lFoot // Imprime o rodapé oPrn:Say(oPrn:nVertRes()-(5*mLarg), nCls[1], "TOTAL DESTA PAGINA: R$ "+ALLTRIM(TRANS(nPagTot,"@E 999,999.99"))+" ("+Vlr_Ext(nPagTot,80)+")", oFont ) oPrn:Say(oPrn:nVertRes()-(4*mLarg), nCls[1], "FORMA DE PAGAMENTO: "+oIt20, oFont ) oPrn:Say(oPrn:nVertRes()-(4*mLarg), nCls[7], "VALIDADE: "+ALLTRIM(oIt12), oFont,,,,1) oPrn:Say(oPrn:nVertRes()-(3*mLarg), nCls[1], "BANCO: "+ALLTRIM(oIt17)+"; AG: "+ALLTRIM(oIt18)+"; C/C: "+Alltrim(oIt19), oFont ) oPrn:Say(oPrn:nVertRes()-(3*mLarg), nCls[7], "LOCAL DE ENTREGA: "+ALLTRIM(oIt21), oFont,,,,1) ENDIF nRow := 3 // Reseta a linha inicial nPag ++ // Incrementa a página oPrn:EndPage() // Finaliza a página oPrn:StartPage() // Cria nova págida * Imprime o cabçalho ENDIF RETURN NIL Talvez já ajude um pouco.

Olá. Ainda uso u xDev 0.28 (idade da pedra lascada) mas consigo compilar sem problemas, usando SQLRDD. O segredo é usar um .bat customizado para gerar o executável, em vez de usar o MAKE interno, deixando por conta do XDEV apenas compilar (gerar os .c). Para isso, no XDEV, na aba "Enviroment", marquei essa opção: [_] Use this custom command to Build the target - don't use internal make: Veja um exemplo de projeto do XDEV: # # xBaseDev Project - xbasedev@kssoftware.com.br # Created @ 24/09/2013 15:41:59 # ### Standard xDev Config - Layout v1.0 Version 0.28 Root "C:\ARSOFT\estoqnet\integrador\" OutPutName "estoqmon.EXE" TargetType "Executable File (*.EXE)" CompilerWith Harbour CompilerPath "C:\xhb121" CustomBuild "C:\ARSOFT\estoqnet\integrador\cl.bat estoqmon" LinkerWith BCC LinkerPath "c:\bcc582" ### General Flags DosOEM False CreateBuildBatch False Compress True CompileAll False MT False Debug False InstallLIB False GuiLIB 1 GuiPATH c:\fwh1206 ### Search Paths OutPutPath "" Search_LIB "c:\bcc582\lib;c:\bcc582\Lib\PSDK\;c:\xhb121\lib;c:\fwh1206\lib;.\lib" Search_INC "c:\bcc582\include\;c:\xhb121\include;c:\fwh1206\include" RddList "NTX;CDX;" Defines "" ForceNonGUI False ### Compilers & Linker Settings LINKER "" COMPILER "" CCOMPILER "" COMPILERCMD " -a -n " ### Files in Project: BEGIN FILES "estoqmon.prg*" "fwdbg.prg" "image.prg" "secoes.prg" "funcoes.prg" "connect.prg" END Abaixo, o BAT relacionado ao projeto: @ECHO OFF CLS ECHO ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ ECHO ³ FiveWin for xHarbour 12.06 - Jun 2012 xHarbour development power ³Ü ECHO ³ (c) FiveTech, 1993-2012 for Microsoft Windows 9X/NT/200X/ME/XP/Vista/7 ³Û ECHO ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙÛ ECHO ÿ ßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßß if A%1 == A GOTO :SINTAX if NOT EXIST %1.prg GOTO :NOEXIST TASKKILL /IM %1.exe /F ECHO Compiling... if "%FWDIR%" == "" set FWDIR=c:\fwh1206 if "%XHDIR%" == "" set XHDIR=c:\xhb121 rem if "%2" == "/b" set GT=gtwin rem if not "%2" == "/b" set GT=gtgui set GT=gtgui set hdir=%XHDIR% set hdirl=%hdir%\lib set bcdir=c:\bcc582 set fwh=%FWDIR% echo -O2 -e%1.exe -I%hdir%\include -I%bcdir%\include %1.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc echo -O2 -I%hdir%\include -I%bcdir%\include connect.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc echo -O2 -I%hdir%\include -I%bcdir%\include secoes.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc echo -O2 -I%hdir%\include -I%bcdir%\include funcoes.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc echo -O2 -I%hdir%\include -I%bcdir%\include fwdbg.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc echo -O2 -I%hdir%\include -I%bcdir%\include image.c > b32.bc %bcdir%\bin\bcc32 -M -c -v @b32.bc :ENDCOMPILE IF EXIST %1.rc %bcdir%\bin\brc32 -r -I%bcdir%\include %1 echo %bcdir%\lib\c0w32.obj + > b32.bc echo %1.obj + >> b32.bc echo connect.obj + >> b32.bc echo secoes.obj + >> b32.bc echo funcoes.obj + >> b32.bc echo fwdbg.obj + >> b32.bc echo image.obj, + >> b32.bc echo %1.exe, + >> b32.bc echo %1.map, + >> b32.bc echo %fwh%\lib\Fivehx.lib %fwh%\lib\FiveHC.lib + >> b32.bc echo %hdirl%\rtl.lib + >> b32.bc echo %hdirl%\vm.lib + >> b32.bc echo %hdirl%\%GT%.lib + >> b32.bc echo %hdirl%\lang.lib + >> b32.bc echo %hdirl%\macro.lib + >> b32.bc echo %hdirl%\rdd.lib + >> b32.bc echo %hdirl%\dbfntx.lib + >> b32.bc echo %hdirl%\dbfcdx.lib + >> b32.bc echo %hdirl%\dbffpt.lib + >> b32.bc echo %hdirl%\hbsix.lib + >> b32.bc echo %hdirl%\debug.lib + >> b32.bc echo %hdirl%\common.lib + >> b32.bc echo %hdirl%\pp.lib + >> b32.bc echo %hdirl%\pcrepos.lib + >> b32.bc echo %hdirl%\ct.lib + >> b32.bc echo %hdirl%\zlib.lib + >> b32.bc echo %hdirl%\hbzip.lib + >> b32.bc echo %hdirl%\png.lib + >> b32.bc echo %hdir%\lib\sqlbcc58.lib + >> b32.bc echo %hdir%\lib\ct.lib + >> b32.bc echo %hdir%\lib\oci.lib + >> b32.bc echo %hdir%\lib\fbclient_bc.lib + >> b32.bc echo %hdir%\lib\libpq.lib + >> b32.bc echo %hdir%\lib\odbccp32.lib + >> b32.bc echo %hdir%\lib\libmysql.lib + >> b32.bc rem Uncomment these two lines to use Advantage RDD rem echo %hdir%\lib\rddads.lib + >> b32.bc rem echo %hdir%\lib\Ace32.lib + >> b32.bc echo %bcdir%\lib\cw32.lib + >> b32.bc echo %bcdir%\lib\import32.lib + >> b32.bc echo %bcdir%\lib\uuid.lib + >> b32.bc echo %bcdir%\lib\psdk\odbc32.lib + >> b32.bc echo %bcdir%\lib\psdk\rasapi32.lib + >> b32.bc echo %bcdir%\lib\psdk\nddeapi.lib + >> b32.bc echo %bcdir%\lib\psdk\msimg32.lib + >> b32.bc echo %bcdir%\lib\psdk\psapi.lib + >> b32.bc echo %bcdir%\lib\psdk\gdiplus.lib + >> b32.bc echo %bcdir%\lib\psdk\iphlpapi.lib, >> b32.bc IF EXIST %1.res echo %1.res >> b32.bc rem uncomment this line to use the debugger and comment the following one if %GT% == gtwin %bcdir%\bin\ilink32 -Gn -Tpe -s -v @b32.bc IF ERRORLEVEL 1 GOTO LINKERROR if %GT% == gtgui %bcdir%\bin\ilink32 -Gn -aa -Tpe -s -v @b32.bc IF ERRORLEVEL 1 GOTO LINKERROR ECHO * Application successfully built * rem %1 GOTO EXIT ECHO :COMPILEERRORS PAUSE GOTO EXIT :LINKERROR ECHO * Linking errors * GOTO EXIT :SINTAX ECHO SYNTAX: Build [Program] {-- No especifiques la extensi¢n PRG ECHO {-- Don't specify .PRG extension GOTO EXIT :NOEXIST ECHO The specified PRG %1 does not exist :EXIT rem delete temporary files del *.c > nul del *.obj > nul del *.ppo > nul

O código abaixo usa um Array em xBrowse com cálculo de rodapé. Dê uma olhada e vê se dá para aproveitar alguma coisa. REDEFINE XBROWSE oCxTur ID 109 ; COLUMNS 1,2,3,4,5,6,7,8,9,10,11,12,13; HEADERS "Data", "Manhã-Din", "Manhã-Crt", "Manhã-Tkts", "Manhã-Méd", "Manhã-Total", "Tarde-Din", "Tarde-Crt", "Tarde-Tkts", "Tarde-Méd", "Tarde-Total", "Só cartões", "Tot. Geral" ; PICTURES NIL, "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99", "@E 999,999,999.99" ; COLSIZES 80,80,80,80,80,80,80,80,80,80,80,80,80 ; OF oFldCx:aDialogs[3] ; ARRAY aCxTurno ; FOOTERS // Indico que quero que apareça a coluna de totais (rodapé). oCxTur:lColDividerComplete := .f. oCxTur:bClrSelFocus := {|| { CLR_WHITE, CLR_HBLUE }} // Cor da seleção com foco oCxTur:bClrSel := {|| { CLR_BLACK, CLR_GRAY }} // Cor da seleção sem foco oCxTur:lColDividerComplete := .f. oCxTur:nFreeze := 1 // Congela a coluna 1 oCxTur:aCols[1]:CFooter := "TOTAIS" // Título de rodapé da coluna 1 FOR n := 2 TO LEN(oCxTur:aCols) // Em cada coluna de 2 a LEN(oCxTur:aCols) IF n <> 5 .and. n <> 10 // Não totalizar as colunas 5 e 10 oCxTur:aCols[n]:nFooterType := AGGR_TOTAL // Aqui indico que as colunas n não ignoradas são do tipo TOTAL. O cálculo é feito pelo oCxTur:MakeTotals(), abaixo ENDIF NEXT // Achar a média geral por cliente DECLARE nT[13] AFILL(nT, 0) STORE 0 TO nGtk1, nGTt1, nGtk2, nGTt2 FOR nDt := 1 TO LEN(aCxTurno) FOR nTt := 2 TO 13 nT[nTt] += aCxTurno[nDt,nTt] NEXT NEXT oCxTur:aCols[5]:CFooter := ALLTRIM(TRANS(nT[6]/nT[4], "@E 999,999,999.99")) // Rodapé da coluna 5 é média. Preferi fazer meu próprio cálculo. O AGGR_AVERAGE não serviu. oCxTur:aCols[10]:CFooter := ALLTRIM(TRANS(nT[11]/nT[9], "@E 999,999,999.99")) // Rodapé da coluna 10 é média. Preferi fazer meu próprio cálculo. O AGGR_AVERAGE não serviu. FOR nTt := 2 TO 13 IF nTt <> 5 .AND. nTt <> 10 oCxTur:aCols[nTt]:CFooter := ALLTRIM(TRANS(nT[nTt], "@E 999,999,999.99")) // Atribuo o valor total inicial de cada coluna diferente de 5 e 10 ENDIF NEXT AEval( oCxTur:aCols, { |oCol|oCol:oFooterFont := oBold} ) // Defino uma fonte BOLD para rodapé (DEFINE FONT oBold...). oCxTur:MakeTotals() // Efetua o cálculo do rodapé.

Realmente é bem parecido com o método que uso para alterar estrutura de DBF, embora adaptada para SQLRDD e só funciona com bancos de dados relacionais (MySQL, Firebird, etc) Ainda não testei em um momento que outros usuários estivessem usando as tabelas. Carece testar e fazer as devidas correções em caso de erro. Qualquer modificação, favor postar aqui. Agradeço. Edu, favor entrar em contato por email para eu poder ajudar melhor: airston.ap@hotmail.com

Amigos, Encontrei uma solução que, para mim, pareceu bem simples. Usa a linguagem BASIC e tem IDE própria para codificação e compilação. Com ela desenvolvi o SISCOMDroid, que vocês podem baixar e testar: http://www.arsoft-ap.com.br/siscomdroid/apk/como_testar_siscomdroid.pdf, No entanto, por se tratar de uma ferramenta que não tem nada a ver com Fivedroid ou Fivewin, acho que NÃO dá para postar minha proposta aqui. Além disso, existe um forum próprio para essa ferramenta. Por isso, peço aos interessados para entrar em contato comigo por email mesmo: ariston.ap@hotmail.com ou por meio dessa página: http://www.arsoft-ap.com.br/suporte.php

Enquanto isso, quem tiver pressa e estiver interessado em aprender uma ferramenta alternativa, 100% funcional e muito fácil, manda um email para mim: ariston.ap@hotmail.com

Eu utilizo um método que, para mim, é infalível. Verifico se houve alguma alteração na estrutura. Se houve: • Renomeio a tabela atual para um nome temporário; • Crio a tabela com a nova estrutura; • Importo todos os dados da tabela renomeada para a tabela atual; • Excluo a tabela renomeada. As funções abaixo exemplificam isso: 1 - Exemplo de como crio as tabelas: // Criação da tabela de vendedores aEstr:={} AADD( aEstr ,{ "COD", "N", 10, 0 } ) // Codigo AADD( aEstr ,{ "NOM", "C", 40, 0 } ) // Apelido AADD( aEstr ,{ "END", "C", 40, 0 } ) // Endereço AADD( aEstr ,{ "TEL", "C", 40, 0 } ) // Telefones AADD( aEstr ,{ "FUN", "C", 40, 0 } ) // Cargo / Função AADD( aEstr ,{ "PSW", "C", 32, 0 } ) // Senha (MD5) IF ! SR_ExistTable( "pessoal" ) TRY dbCreate( "pessoal", aEstr, cRDD ) CATCH oErr ShowMsgTray("Erro ao tentar criar a tabela 'pessoal'. Favor verificar as configurações de banco de dados.","Erro") IF FileWrite(".\errorlog\erro.txt", oErr:Description) WAITRUN( GetEnv( "ComSpec" )+" /C NOTEPAD .\errorlog\erro.txt", 0) ENDIF END else lChg := ChkStruct("pessoal", aEstr, oSql, nErr, nPos) ENDIF 2 - Função que criei para modificar a estrutura: STATIC FUNCTION ChkStruct(cTable, aStruct, oSql, nErr, nPos) LOCAL lStrOk := .T., cComm, aNewStr, aOldStr, aChange, aImport, cImport aNewStr := aStruct AADD(aNewStr, {"SR_RECNO", "N", 20, 0}) // SQLRDD acrescenta este campo ao criar a tabela cSay := "Verificando a tabela '"+cTable+"'" oSay:SetText(cSay) oSay:Refresh() IF ! l_Check ; RETURN .T.; ENDIF // Obter a estrutura da tabela atual. nErr := 0 TRY cComm := "SELECT * FROM "+cTable+" LIMIT 1" nErr := oSql:execute( cComm ) oSql:iniFields(.f.) aOldStr := oSql:aFields // Para pegar a estrutura CATCH ShowMsgTray("Não foi possível testar a tabela '"+cTable+"'", "Aviso") SysWait(1) RETURN .T. END TRY // Comparar com a estrutura de aStruct lChangd := .F. aChange := {} aImport := {} cImport := "" TRY FOR nX := 1 TO LEN(aNewStr) // Verifica se foi acrescentado algum campo ou se mudou o tamanho de algum. cFild:=aNewStr[nX,1] cType:=aNewStr[nX,2] cSize:=STRZERO(aNewStr[nX,3], 4) cDeci:=STRZERO(aNewStr[nX,4], 3) nElem := ASCAN(aOldStr, {|aNro| aNro[1] == cFild}) IF nElem > 0 IF cType != aOldStr[nElem,2] .OR. ; cSize != STRZERO(aOldStr[nElem,3], 4) .OR. ; cDeci != STRZERO(aOldStr[nElem,4], 3) lChangd := .T. // Mudou o tamanho de um campo aadd(aChange, {cFild, "Modificou a estrutura"}) ENDIF ELSE lChangd := .T. // Foi removido algum campo aadd(aChange, {cFild, "Campo acrescentado"}) ENDIF NEXT FOR nX := 1 TO LEN(aOldStr) // Verifica se foi excluindo algum compo cFild := aOldStr[nX,1] nElem := ASCAN(aNewStr, {|aNro| aNro[1] == cFild}) IF nElem = 0 lChangd := .T. // Algum campo foi removido aadd(aChange, {cFild, "Campo removido"}) ELSE AADD(aImport, cFild) // Para pegar só os campos que existem nas duas tabelas. ENDIF NEXT IF lChangd // Determinar quais campos serão importados da tabela temporária FOR nX := 1 TO LEN(aImport) IF ! EMPTY(cImport) ; cImport += ", " ; ENDIF cImport += aImport[nX] NEXT ENDIF CATCH ShowMsgTray("Não foi possível testar a tabela '"+cTable+"'", "Aviso") SysWait(1) RETURN .T. END TRY // Excluir a tabela temporária, se existir TRY IF SR_ExistTable( cTable+"_old" ) SR_DropTable(cTable+"_old") ENDIF CATCH oErr ShowMsgTray("Não foi possível excluir a tabela '"+cTable+"_old"+"'", "Erro.") SysWait(1) RETURN .T. END TRY // Renomear a tabela atual para tabela temporária IF lChangd IF ! SR_RenameTable(cTable, cTable+"_old") lChangd := .F. ENDIF ENDIF // Criar tabela atual com a nova estrutura IF lChangd TRY SR_DropTable(cTable) // Já foi renomeada. CATCH oErr END TRY TRY dbCreate(cTable, aStruct, cRDD ) CATCH oErr SR_RenameTable(cTable+"_old", cTable) // Se não conseguir criar a tabela, recuperar a anterior. lChangd := .f. ShowMsgTray("Erro ao tentar modificar a tabela '"+cTable+"'.","Erro") END TRY ENDIF // Importar dados da tabela temporária nErr := 0 IF lChangd cComm := "INSERT INTO "+cTable+" ("+cImport+") "+; "SELECT "+cImport+" FROM "+cTable+"_old" nErr := oSql:execute( cComm ) IF nErr != 0 ShowMsgTray("Erro ao tentar recuperar os dados da tabela '"+cTable+"_old"+"'.","Erro") ENDIF ENDIF // Excluir a tabela temporária TRY SR_DropTable(cTable+"_old") CATCH oErr END TRY RETURN( lStrOk )

Uso assim há muito tempo e nunca tive problema com nenhuma versão do windows. // Verificar se existe uma versão mais recente do EXE no servidor cExeName := UPPER(CFILENOEXT( HB_ARGV( 0 ) ))+".EXE" cDirSrv := SUBSTR(ALLTRIM(cPasta), 1, RAT("\",cPasta)) IF RIGHT(cDirSrv,1) == "\"; cDirSrv := SUBSTR(cDirSrv, 1, LEN(cDirSrv)-1) ; ENDIF IF EMPTY(cDirSrv) ; cDirSrv := "." ; ENDIF aDire := DIRECTORY(cDirSrv+"\*.EXE") nFile := ASCAN(aDire, {|nPos|UPPER(nPos[1])==cExeName}) IF nFile > 0 wdata1=aDire[nFile,3] wtime1=aDire[nFile,4] ENDIF aDire := DIRECTORY("*.EXE") nFile := ASCAN(aDire, {|nPos|UPPER(nPos[1])==cExeName}) IF nFile > 0 wdata2=aDire[nFile,3] wtime2=aDire[nFile,4] ENDIF // Descomente as 3 linhas abaixo para checar por MD5 (Comente o teste por data e hora) * cMd5This := HB_MD5File( cExeName ) * cMd5That := HB_MD5File( cDirSrv+"\SISCOM.EXE" ) * IF cMd5This != cMd5That // Descomente a linha IF abaixo para testar por data e hora com tolerência de 15 minutos (Comente o teste por MD5) IF (WDATA1 > WDATA2) .OR. (WDATA1 = WDATA2) .AND. (SECS(wtime1) > (SECS(wtime2)+SECS("00:15:00"))) cDirAtu := CurDrive()+":\"+CurDir() if file(cDirAtu+"\ATUALIZA.BAT") ferase(cDirAtu+"\ATUALIZA.BAT") endif WritePProString("ACESSOS", "ChecarDbf", "T", ".\SISCOM.INI") cAtuInf := "TASKKILL /IM "+cExeName+" /F"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\bitmaps\*.* "+cDirAtu+"\bitmaps\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\modelos\*.* "+cDirAtu+"\modelos\"+CRLF+; "XCOPY /S /Y /D "+cDirSrv+"\manual\*.* "+cDirAtu+"\manual\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\DLL32\*.dll "+cDirAtu+"\DLL32\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\*.dll "+cDirAtu+"\"+CRLF+; "XCOPY /Y /D "+cDirSrv+"\"+cExeName+" "+cDirAtu+CRLF+; "START "+cExeName+CRLF+; "EXIT" arq2 := fcreate(cDirAtu+"\ATUALIZA.BAT") fwrite(arq2, cAtuInf) fclose(arq2) WAITRUN( GetEnv( "ComSpec" )+" /C START "+cDirAtu+"\ATUALIZA.BAT", 0 ) SYSWAIT(3) ELSE ferase(".\ATUALIZA.BAT") ENDIF Coloque antes do seu menu principal, na função inicial (Main). Adepte aí e veja se funciona. É claro que só vai funcionar após todos os computadores terem sidos atualizados pelo menos uma vez com a versão que contém este código.

No post que Rochinha defendeu o DBF ou também o fiz, por isso, aqui vai mais uma opinião. Em todos os casos de problemas com DBF que eu tive, a origem do problema foi: rede (1%), vírus (9%) ou BP/USB* (90%). Recentemente um cliente me ligou dizendo que as contas a receber estavam sumindo. Fui lá para entender como eles trabalhavam, dei uma desculpa de que o servidor poderia estar com vírus, no final do expediente mudei o servidor para outro computador e fui para casa testar o programa. (Já fez isso alguma vez?) Resultado da análise: descobri que ao converter movimentos em espera para venda eu estava excluindo as contas a pagar para salvar novamente, como se fosse uma alteração de uma venda a prazo. O detalhe é que o movimento em espera tinha um código e a venda (resultado da conversão) tinha outro, assim, eu estava excluindo contas de outra venda, resultando no dito desaparencimento. Corrigi o problema e, na manhã seguinte, atualizei no cliente e pedi para ele acompanhar a movimentação. Se parrasse de sumir contas, tava provado que o problema era vírus no servidor anterior. (kkk) Problemas parecidos tive com: Duplicação ou sumiço de cadastros, não baixar estoque, corrompimento de índices, e aí vai... Nesse ínterim, desgostoso com tantos problemas de DBF (a culpa nunca é do programador), comecei a estudar bancos de dados relacionais, o que de fato é muito fácil, diga-se de passagem. Hoje estou migrando, aos poucos, e em passo de tartaruga, para SQL puro, com SQLRDD. Até porque também já estou desenvolendo para Android que vem com SQLLite, e sites, que usam MySQL, MS-SQL e outros, dependendo do servidor de hospedagem. Para quem está começando sugiro partir logo para bancos de dados relacionais por ser esse o futuro dos bancos de dados. Mas ainda garanto que, DBF bem trabalhado, não dá dor de cabeça (ou dar, senão, não teria que ser bem trabalhado). --- * BP = Burrice de Programador / USB=Usuário Super Burro.

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

Gostei, Rochinha. Também já passei por isso. Faço minhas suas palavras. Acrescento que ja tive problema com MySQL (perda irrecuperável de dados, versão antiga) e Firebird (lentidão no acesso pela rede). Também ja aconteceu de eu ter que voltar para DBF porque a rede não permitia acesso ao Firebird mesmo desabilitando Firewalls, etc. Como era repartição publica e não podia mexer nas maquinas, tive que optar por usar o DBF mesmo. Portanto digo que, seguindo as dicas dos colegas e a lógica do Rochina, nossos sistemas ainda rodarão bem com DBF por mais 25 anos, e além, quem sabe.

Não estou uando o Pelles C, mas já vou logo adiantando: o WS é muito limitado. Atualmente, para suportar todos o recursos que tenho, precisei dividir em dois arquivos .RC. Na hora de compilar, junto os dois em um terceiro e compilo para .DLL 32 bits. Faço assim porque, se eu tentar usar apenas um arquivo, fica muito grande e o WS não consegui mais abrir nem salvar se todos os recursos estiverem só em um. No entanto, embora o WS talvez não rode em 64 bits (ainda não tentei), não tenho problema em usar os recusos compilados nessa plataforma. Tentei usar o Pelles C mas, como ja estava acostumado com WS, preferi não mudar ainda. Porém, para quem ainda vai escolher um dos dois, sugiro Pelles C.

Rochina, e demais amigos interessados. O SISCOMDroid ja está pronto para testes. Vocês podem baixar uma cópia a partir do meu site: www.arsoft-ap.com.br Lá tem também um tutorial sobre como configurar um ambiente de testes (Internet e FTP virtuais). Não pretendo mais criar criar um pacote de fontes para programadores Android. Além disso, o Pacote Fivewin foi descontinuado. Quem tiver interesse em usar o SISCOMDroid com sua aplicação, dá para integrar via TXT. Entre em contato para solicitar o layout de integração. Quem tiver interesse em aprender a linguagem que usei para desenvolver o SISCOMDroid, favor entrar em contato por e-mail para tratarmos do assunto. Meu e-mail é ariston.ap@hotmail.com ou ariston.ap@bol.com.br