rmarra Posted June 29, 2011 Report Share Posted June 29, 2011 Olá pessoal, alguém poderia postar um exemplo prático e que funcione de Envio e Recebimento de arquivos via FTP em Harbour? Abaixo a classe que utilize e o programa de envio e recebimento. Estranho que conecto no servidor, porém não consigo enviar e nem receber arquivos. Desde já agradeço! ==> Classe que utilizo. // FiveWin Class TFTP for Internet FTP management. Based on Windows WinINet.dll #include "FiveWin.ch" #include "Struct.ch" #define INTERNET_SERVICE_FTP 1 #define FTP_PORT 21 //----------------------------------------------------------------------------// CLASS TFTP DATA oInternet // TInternet container object DATA cSite // URL address DATA hFTP // handle of the FTP connection DATA cUserName // user name to login DATA cPassword // password to login METHOD New( cFTPSite, oInternet, cUserName, cPassword ) CONSTRUCTOR // generic constructor METHOD End() // generic destructor METHOD DeleteFile( cFileName ) // deletes a remote FTP file METHOD Directory( cMask ) // as Clipper Directory() but on a FTP site! ENDCLASS //----------------------------------------------------------------------------// METHOD New( cFTPSite, oInternet, cUserName, cPassword ) CLASS TFTP ::oInternet = oInternet ::cSite = cFTPSite ::cUserName = cUserName ::cPassword = cPassword if oInternet:hSession != nil ::hFTP = InternetConnect( oInternet:hSession, cFTPSite, FTP_PORT,; ::cUserName, ::cPassword,; INTERNET_SERVICE_FTP, 0, 0 ) AAdd( oInternet:aFTPs, Self ) endif return Self //----------------------------------------------------------------------------// METHOD End() CLASS TFTP if ::hFTP != nil InternetCloseHandle( ::hFTP ) ::hFTP = nil endif return nil //----------------------------------------------------------------------------// METHOD DeleteFile( cFileName ) CLASS TFTP return If( ::hFTP != nil, FtpDeleteFile( ::hFTP, cFileName ), .f. ) //----------------------------------------------------------------------------// METHOD Directory( cMask ) CLASS TFTP local hFTPDir, aFiles := {} local oWin32FindData, cBuffer DEFAULT cMask := "*.*" STRUCT oWin32FindData MEMBER nFileAttributes AS DWORD MEMBER nCreationTime AS STRING LEN 8 MEMBER nLastReadAccess AS STRING LEN 8 MEMBER nLastWriteAccess AS STRING LEN 8 MEMBER nSizeHight AS DWORD MEMBER nSizeLow AS DWORD MEMBER nReserved0 AS DWORD MEMBER nReserved1 AS DWORD MEMBER cFileName AS STRING LEN 260 MEMBER cAltName AS STRING LEN 28 ENDSTRUCT if ::hFTP != nil cBuffer = oWin32FindData:cBuffer hFTPDir = FtpFindFirstFile( ::hFTP, cMask, @cBuffer, 0, 0 ) oWin32FindData:cBuffer = cBuffer if ! Empty( oWin32FindData:cFileName ) AAdd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) while InternetFindNextFile( hFTPDir, @cBuffer ) oWin32FindData:cBuffer = cBuffer AAdd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) end endif InternetCloseHandle( hFTPDir ) endif return aFiles ==> Meu programa de Envio e Recebimento. **************************************************************************** procedure Ftp() **************************************************************************** /* // Enviar e receber arquivos via FTP da Pharmalink. // Rondinelli - 02/07/2009 */ if DeCriptWord( Get4Ini("PHL","LHPEP" ,"C:\RCACFG.INI")) # "SIM" msg("PE Pharmalink não habilitado.") return Nil endif VerFTP() **************************************************************************** static function VerFTP() **************************************************************************** private cServidor, cUsuario, cSenha if !net_use("CONFIG") return endif cServidor := alltrim(PHL_SERV) cUsuario := alltrim(PHL_USU) cSenha := alltrim(PHL_SENHA) oInternet := TInternet():New() oFTP := TFTP():New( cServidor, oInternet, cUsuario, cSenha ) if oInternet:hSession # Nil if !Empty( oFTP:hFTP ) //Abriu o Ftp MandaArq(oFtp,oInternet) RecebArq(oFtp,oInternet) else msg("Sem Acesso ao FTP.") endif else msg("Sem Acesso a Internet.") endif oInternet:End() oFtp:End() close CONFIG return Nil **************************************************************************** static function MandaArq(oFtp,oInternet) **************************************************************************** local nTotal, hSource, cBuffer := Space( 6400 ), nBufSize := 6400,; oFile cEnvOrig := "\pharmali\envio\phl.txt" cEnvDest := "/" + cUsuario + "/envio/phl99_" + str(year(date()),4) + ; substr(dtoc(date()),4,2) + left(dtoc(date()),2) + ; left(strtran(time(),":"), 2) + ; substr(strtran(time(),":"),3,2) + ; substr(strtran(time(),":"),5,2) + ".txt" hSource := FOpen( cEnvOrig ) if !file(cEnvOrig) msg("Arquivo para envio não existe.") return Nil endif barra("Enviando arquivo " + cEnvOrig + " para " + cEnvDest + "...") cBuffer := Space( 6400 ) nBufSize := 6400 SysRefresh() msg(cEnvDest) oFile := TFtpFile():New( cEnvDest, oFTP ) if Empty(oFile) msg("Erro na criação do arquivo no FTP.") return Nil endif oFile:OpenWrite() FSeek( hSource, 0, 0 ) nTotal := 0 while ( nBytes := FRead( hSource, @cBuffer, nBufSize ) ) > 0 nFeito := oFile:Write( SubStr( cBuffer, 1, nBytes ) ) barra("Enviando arquivo " + cEnvOrig + " para " + cEnvDest + " -> " + alltrim(str(nBufSize)) + "...") SysRefresh() nTotal += nBufSize end oFile:End() FClose( hSource ) msg("Arquivo com " + transform(nTotal,"9,999,999,999") + " Bites enviado com sucesso...") barra("") ferase(cEnvOrig) return Nil **************************************************************************** static function RecebArq(oFtp,oInternet) **************************************************************************** local nX, hTarget, cBuffer := Space( 6400 ), nBufSize := 6400 ,; aVerFiles, nSeconds, nFeito := 0, cArqRec, cArqEnv, lErro, nTot,; nArq := 1 aVerFiles := oFTP:Directory("/" + cUsuario + "/Retorno/*.RET" ) aVerFiles := ASort(aVerFiles,,,{|x,y| x[1] < y[1]}) barra("Recebendo arquivo de retorno...") For nX := 1 To Len(aVerFiles) cArqEnv := "/" + cUsuario + "/Retorno/" + aVerFiles[nX][1] do while .t. cArqRec := "\PHARMALI\RETORNO\PHL" + strzero(nArq,5) + ".RET" if file(cArqRec) nArq++ loop endif exit enddo cBuffer := Space( 6400 ) nBufSize := 6400 //---- Recebe o arquivo do FTP ----// hTarget := FCreate( cArqRec ) oFile := TFtpFile():New( cArqEnv, oFTP ) If oFile # Nil oFile:OpenRead() nSeconds := Seconds()+600 nTot := 0 lErro := .F. while ( nBytes := Len( cBuffer := oFile:Read( nBufSize ) ) ) > 0 FWrite( hTarget, cBuffer, nBytes ) SysRefresh() nTot += nBytes If Seconds() > nSeconds lErro := .T. Endif end FClose( hTarget ) oFile:End() if !lErro if nTot = 0 loop endif msg("Recebidos " + transform(nTot,"9,999,999,999") + " Bytes.") FClose( hTarget ) //---- Elimina do Diretório do FTP ----// oFtp:DeleteFile( cArqEnv ) ++nFeito else msg("Erro lendo arquivo " + cArqEnv + ".") return Nil endif else msg("Não foi possÃvel abrir o arquivo " + cArqEnv + ".") return Nil endif Next if nFeito == 0 msg("Não houve arquivo para receber.") endif barra() Return Nil Rondinelli - Itaocara-RJ Clipper 5.3b, Fivewin 2.6, Blinker 7, WorkShop Editado por - rmarra on 29/06/2011 10:18:04 Quote Link to comment Share on other sites More sharing options...
rmarra Posted June 29, 2011 Author Report Share Posted June 29, 2011 Olá pessoal, alguém poderia postar um exemplo prático e que funcione de Envio e Recebimento de arquivos via FTP em Harbour? Abaixo a classe que utilize e o programa de envio e recebimento. Estranho que conecto no servidor, porém não consigo enviar e nem receber arquivos. Desde já agradeço! ==> Classe que utilizo. // FiveWin Class TFTP for Internet FTP management. Based on Windows WinINet.dll #include "FiveWin.ch" #include "Struct.ch" #define INTERNET_SERVICE_FTP 1 #define FTP_PORT 21 //----------------------------------------------------------------------------// CLASS TFTP DATA oInternet // TInternet container object DATA cSite // URL address DATA hFTP // handle of the FTP connection DATA cUserName // user name to login DATA cPassword // password to login METHOD New( cFTPSite, oInternet, cUserName, cPassword ) CONSTRUCTOR // generic constructor METHOD End() // generic destructor METHOD DeleteFile( cFileName ) // deletes a remote FTP file METHOD Directory( cMask ) // as Clipper Directory() but on a FTP site! ENDCLASS //----------------------------------------------------------------------------// METHOD New( cFTPSite, oInternet, cUserName, cPassword ) CLASS TFTP ::oInternet = oInternet ::cSite = cFTPSite ::cUserName = cUserName ::cPassword = cPassword if oInternet:hSession != nil ::hFTP = InternetConnect( oInternet:hSession, cFTPSite, FTP_PORT,; ::cUserName, ::cPassword,; INTERNET_SERVICE_FTP, 0, 0 ) AAdd( oInternet:aFTPs, Self ) endif return Self //----------------------------------------------------------------------------// METHOD End() CLASS TFTP if ::hFTP != nil InternetCloseHandle( ::hFTP ) ::hFTP = nil endif return nil //----------------------------------------------------------------------------// METHOD DeleteFile( cFileName ) CLASS TFTP return If( ::hFTP != nil, FtpDeleteFile( ::hFTP, cFileName ), .f. ) //----------------------------------------------------------------------------// METHOD Directory( cMask ) CLASS TFTP local hFTPDir, aFiles := {} local oWin32FindData, cBuffer DEFAULT cMask := "*.*" STRUCT oWin32FindData MEMBER nFileAttributes AS DWORD MEMBER nCreationTime AS STRING LEN 8 MEMBER nLastReadAccess AS STRING LEN 8 MEMBER nLastWriteAccess AS STRING LEN 8 MEMBER nSizeHight AS DWORD MEMBER nSizeLow AS DWORD MEMBER nReserved0 AS DWORD MEMBER nReserved1 AS DWORD MEMBER cFileName AS STRING LEN 260 MEMBER cAltName AS STRING LEN 28 ENDSTRUCT if ::hFTP != nil cBuffer = oWin32FindData:cBuffer hFTPDir = FtpFindFirstFile( ::hFTP, cMask, @cBuffer, 0, 0 ) oWin32FindData:cBuffer = cBuffer if ! Empty( oWin32FindData:cFileName ) AAdd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) while InternetFindNextFile( hFTPDir, @cBuffer ) oWin32FindData:cBuffer = cBuffer AAdd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) end endif InternetCloseHandle( hFTPDir ) endif return aFiles ==> Meu programa de Envio e Recebimento. **************************************************************************** procedure Ftp() **************************************************************************** /* // Enviar e receber arquivos via FTP da Pharmalink. // Rondinelli - 02/07/2009 */ if DeCriptWord( Get4Ini("PHL","LHPEP" ,"C:\RCACFG.INI")) # "SIM" msg("PE Pharmalink não habilitado.") return Nil endif VerFTP() **************************************************************************** static function VerFTP() **************************************************************************** private cServidor, cUsuario, cSenha if !net_use("CONFIG") return endif cServidor := alltrim(PHL_SERV) cUsuario := alltrim(PHL_USU) cSenha := alltrim(PHL_SENHA) oInternet := TInternet():New() oFTP := TFTP():New( cServidor, oInternet, cUsuario, cSenha ) if oInternet:hSession # Nil if !Empty( oFTP:hFTP ) //Abriu o Ftp MandaArq(oFtp,oInternet) RecebArq(oFtp,oInternet) else msg("Sem Acesso ao FTP.") endif else msg("Sem Acesso a Internet.") endif oInternet:End() oFtp:End() close CONFIG return Nil **************************************************************************** static function MandaArq(oFtp,oInternet) **************************************************************************** local nTotal, hSource, cBuffer := Space( 6400 ), nBufSize := 6400,; oFile cEnvOrig := "\pharmali\envio\phl.txt" cEnvDest := "/" + cUsuario + "/envio/phl99_" + str(year(date()),4) + ; substr(dtoc(date()),4,2) + left(dtoc(date()),2) + ; left(strtran(time(),":"), 2) + ; substr(strtran(time(),":"),3,2) + ; substr(strtran(time(),":"),5,2) + ".txt" hSource := FOpen( cEnvOrig ) if !file(cEnvOrig) msg("Arquivo para envio não existe.") return Nil endif barra("Enviando arquivo " + cEnvOrig + " para " + cEnvDest + "...") cBuffer := Space( 6400 ) nBufSize := 6400 SysRefresh() msg(cEnvDest) oFile := TFtpFile():New( cEnvDest, oFTP ) if Empty(oFile) msg("Erro na criação do arquivo no FTP.") return Nil endif oFile:OpenWrite() FSeek( hSource, 0, 0 ) nTotal := 0 while ( nBytes := FRead( hSource, @cBuffer, nBufSize ) ) > 0 nFeito := oFile:Write( SubStr( cBuffer, 1, nBytes ) ) barra("Enviando arquivo " + cEnvOrig + " para " + cEnvDest + " -> " + alltrim(str(nBufSize)) + "...") SysRefresh() nTotal += nBufSize end oFile:End() FClose( hSource ) msg("Arquivo com " + transform(nTotal,"9,999,999,999") + " Bites enviado com sucesso...") barra("") ferase(cEnvOrig) return Nil **************************************************************************** static function RecebArq(oFtp,oInternet) **************************************************************************** local nX, hTarget, cBuffer := Space( 6400 ), nBufSize := 6400 ,; aVerFiles, nSeconds, nFeito := 0, cArqRec, cArqEnv, lErro, nTot,; nArq := 1 aVerFiles := oFTP:Directory("/" + cUsuario + "/Retorno/*.RET" ) aVerFiles := ASort(aVerFiles,,,{|x,y| x[1] < y[1]}) barra("Recebendo arquivo de retorno...") For nX := 1 To Len(aVerFiles) cArqEnv := "/" + cUsuario + "/Retorno/" + aVerFiles[nX][1] do while .t. cArqRec := "\PHARMALI\RETORNO\PHL" + strzero(nArq,5) + ".RET" if file(cArqRec) nArq++ loop endif exit enddo cBuffer := Space( 6400 ) nBufSize := 6400 //---- Recebe o arquivo do FTP ----// hTarget := FCreate( cArqRec ) oFile := TFtpFile():New( cArqEnv, oFTP ) If oFile # Nil oFile:OpenRead() nSeconds := Seconds()+600 nTot := 0 lErro := .F. while ( nBytes := Len( cBuffer := oFile:Read( nBufSize ) ) ) > 0 FWrite( hTarget, cBuffer, nBytes ) SysRefresh() nTot += nBytes If Seconds() > nSeconds lErro := .T. Endif end FClose( hTarget ) oFile:End() if !lErro if nTot = 0 loop endif msg("Recebidos " + transform(nTot,"9,999,999,999") + " Bytes.") FClose( hTarget ) //---- Elimina do Diretório do FTP ----// oFtp:DeleteFile( cArqEnv ) ++nFeito else msg("Erro lendo arquivo " + cArqEnv + ".") return Nil endif else msg("Não foi possÃvel abrir o arquivo " + cArqEnv + ".") return Nil endif Next if nFeito == 0 msg("Não houve arquivo para receber.") endif barra() Return Nil Rondinelli - Itaocara-RJ Clipper 5.3b, Fivewin 2.6, Blinker 7, WorkShop Editado por - rmarra on 29/06/2011 10:18:04 Quote Link to comment Share on other sites More sharing options...
kapiaba Posted June 29, 2011 Report Share Posted June 29, 2011 http://www.fivewin.com.br/exibedicas.asp?id=823 João Santos - São Paulo. kmt_karinha@pop.com.br joao@pleno.com.br Fone: (11) 3106-2832 / 8243-5632 - TIM FWH 2.7 - xHARBOUR WorkShop.Exe Quote Link to comment Share on other sites More sharing options...
kapiaba Posted June 29, 2011 Report Share Posted June 29, 2011 http://www.fivewin.com.br/exibedicas.asp?id=364 João Santos - São Paulo. kmt_karinha@pop.com.br joao@pleno.com.br Fone: (11) 3106-2832 / 8243-5632 - TIM FWH 2.7 - xHARBOUR WorkShop.Exe Quote Link to comment Share on other sites More sharing options...
rmarra Posted June 29, 2011 Author Report Share Posted June 29, 2011 Podem desconsiderar. Resolvido conforme abaixo: Grato! ******************************************************************************** static procedure Enviaftp() ******************************************************************************** LOCAL n LOCAL cUrl LOCAL cStr LOCAL lRetorno := .T. LOCAL oUrl LOCAL oFTP LOCAL cUser LOCAL cServer LOCAL cPassword LOCAL cFile := "" LOCAL lElim DEFAULT lElim TO .F. if !net_use("CONFIG") return endif cServer := alltrim(PHL_SERV) cUser := alltrim(PHL_USU) cPassword := alltrim(PHL_SENHA) cUrl := "ftp://" + cUser + ":" + cPassword + "@" + cServer cEnvOrig := "\pharmali\envio\phl.txt" cEnvDest := "/envio/phl99_" + str(year(date()),4) + ; substr(dtoc(date()),4,2) + left(dtoc(date()),2) + ; left(strtran(time(),":"), 2) + ; substr(strtran(time(),":"),3,2) + ; substr(strtran(time(),":"),5,2) + ".txt" if file(cEnvOrig) oUrl := tUrl():New( cUrl ) oFTP := tIPClientFtp():New( oUrl, .T. ) oFTP:nConnTimeout := 20000 oFTP:bUsePasv := .T. // Comprobamos si el usuario contiene una @ para forzar el userid if At( "@", cUser ) > 0 oFTP:oUrl:cServer := cServer oFTP:oUrl:cUserID := cUser oFTP:oUrl:cPassword := cPassword endif // function for displaying progress bar oFtp:exGauge := ( @FtpProgress() ) if oFTP:Open( cUrl ) if !oFtp:UploadFile( cEnvOrig, cEnvDest ) lRetorno := .F. else lRetorno := .t. endif oFTP:Close() if lRetorno msg( "Enviado com sucesso !" ) else msg( "Falha no Envio !" ) endif else cStr := "Não consegui conectar com o servidor FTP" + " " + oURL:cServer + ";;" if oFTP:SocketCon == NIL cStr += "Conexão não inicializada" elseif InetErrorCode( oFTP:SocketCon ) == 0 cStr += "Resposta do servidor:" + " "+ oFTP:cReply else cStr += "Erro na conexão:" + " " +InetErrorDesc( oFTP:SocketCon ) endif msg(cStr) endif else msg("Não existe arquivo para ser enviado.") endif close CONFIG return Nil Rondinelli - Itaocara-RJ Clipper 5.3b, Fivewin 2.6, Blinker 7, WorkShop Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.