Na Hora Lucimauro,
Segue rotina em modo console mesmo, que verifica numa tabela quais os BKPs precisam ser enviados para minha pasta de BKP no Servidor online.
Local ms1:='123', ..., ms5:='xxx'
LOCAL cUrl := "ftp://backup:"+ms1+ms2+ms3+ms4+ms5+"@seusite.net" //ms1 ... ms5 é a minha senha q está quebrada em várias partes, para evitar q numa descompilação ela venha a ser descoberta.
Private mRetorno:=''
Begin Sequence
? '-30 Montando Caminhos para os Backups'
mPath:='c:\simplesinfo\scp15h\'
If 'SCP' $ Upper(cPath)
mPath := Left(cPath, 22)
ElseIf 'SFP' $ Upper(cPath)
mPath := Left(cPath, 10)
Endif
mDbf := mPath + 'tbk.dbf'
If File( mDbf )
Try
? '-31 Conectando … base de dados local do Backup'
Use (mDbf) Alias TBK SHARED
Catch
? '-32 [ERRO] Opera‡Æo falhou.'
End
Else
? '-33 [ERRO] Opera‡Æo falhou.'
Break
Endif
? '-34 Contando registros'
Count To nCount For Empty( flag )
If nCount > 0
Set Filter To Empty( flag )
Try
? '-35 Conectando ao servidor FTP.'
oURL := TUrl():New( cURL )
oFtp := TIpClientFtp():new( oUrl, .f. )
oFTP:nConnTimeout := 20000
oFTP:bUsePasv := .T.
Catch
? '-36 [ERRO] ConexÆo ao Servidor falou.'
End
? '-37 Abrindo pasta de Backup no Servidor.'
// Testa usuario e senha
/*IF At( "@", cUser ) > 0
oFTP:oUrl:cServer := cServer
oFTP:oUrl:cUserID := cUser
oFTP:oUrl:cPassword := cPassword
ENDIF
*/
Go Top
cc:=0
Do While !Eof()
mOrigem := StrTran( tbk_arquiv, Alltrim(tbk_path), '')
If Subs(mOrigem, 2, 2) <> ':\'
mOrigem := Alltrim(tbk_path) + AllTrim(mOrigem)
Endif
//mDestino := Alltrim(tbk_rota)+;
// '/' + Alltrim(tbk_app)+;
// '/A' + Alltrim(tbk_ano)+;
// '/' + Alltrim(tbk_arquiv)
mDestino := Alltrim(tbk_arquiv)
mPos := At('BKP\', mDestino)
If mPos > 0
mDestino := SubStr(mDestino, mPos+4, 100)
Endif
If File( mOrigem )
IF .NOT. oFtp:open( cUrl )
mRetorno := oFtp:lastErrorMessage() + CRLF
Go Top
If RLOCK()
Replace tbk_ntenta With tbk_ntenta+1
Replace tbk_retorn With mRetorno+tbk_retorn
Endif
DbUnlock()
? '-38 [ERRO] A abertura da pasta backup falhou.'
? ' Servidor FTP.....: '+oURL:cServer
IF oFTP:SocketCon == NIL
? " Connection not initialized"
ELSEIF inetErrorCode( oFTP:SocketCon ) == 0
? " Server response:", oFTP:cReply
ELSE
? " Error in connection:", inetErrorDesc( oFTP:SocketCon )
ENDIF
Break
Else
? '-39 Vamos copiar o arquivo: '+mDestino
? ' Contador: ' + str(++cc)
//aFiles := oFtp:listFiles()
cRoot := '/'
? ' Raiz: '+cRoot
oFtp:cwd( cRoot )
mRetorno += oFtp:cReply + CRLF
? ' Raiz: '+oFtp:cReply
oFtp:cwd( Alltrim(tbk_rota) )
If Left(oFtp:cReply, 1) ='5'
oFtp:mkd( Alltrim(tbk_rota) )
mRetorno += oFtp:cReply + CRLF
oFtp:cwd( Alltrim(tbk_rota) )
mRetorno += oFtp:cReply + CRLF
Else
mRetorno += oFtp:cReply + CRLF
Endif
oFtp:cwd( Alltrim(tbk_app) )
If Left(oFtp:cReply, 1) ='5'
oFtp:mkd( Alltrim(tbk_app) )
mRetorno += oFtp:cReply + CRLF
oFtp:cwd( Alltrim(tbk_app) )
mRetorno += oFtp:cReply + CRLF
Else
mRetorno += oFtp:cReply + CRLF
Endif
oFtp:cwd( 'A'+Alltrim(tbk_ano) )
If Left(oFtp:cReply, 1) ='5'
oFtp:mkd( 'A'+Alltrim(tbk_ano) )
mRetorno += oFtp:cReply + CRLF
oFtp:cwd( 'A'+Alltrim(tbk_ano) )
mRetorno += oFtp:cReply + CRLF
Else
mRetorno += oFtp:cReply + CRLF
Endif
If Left(oFtp:cReply, 1) = '2'
oFtp:uploadFile( mOrigem, mDestino )
mRetorno += oFtp:cReply + CRLF
? ' Arquivo copiado: ' + oFtp:cReply
Else
? ' NÆo consegui acessar a pasta: ' + oFtp:cReply
? mOrigem
? mDestino
? oFtp:cReply
Endif
If RLOCK()
Replace tbk_ntenta With tbk_ntenta+1
Replace tbk_retorn With mRetorno+tbk_retorn
If Left(oFtp:cReply, 1) = '2'
Replace flag With oFtp:cReply
Endif
Endif
DbUnlock()
oFTP:Close()
Endif
Endif
//? mOrigem
//? mDestino
//wait
Skip
Enddo
/*oFtp:cwd( ".." )
Dirlist( oFtp, aFiles, "" )
oFtp:cwd( cRoot + "/newdir" )
? oFtp:downloadFile( "testftp.prg" ), oFtp:cReply
? oFtp:dele( "testftp.exe" ), oFtp:cReply
? oFtp:dele( "testftp.prg" ), oFtp:cReply
? oFtp:cwd( ".." ), oFtp:cReply
? oFtp:rmd( "newdir" ), oFtp:cReply
*/
Else
? '-40 Sem registos a copiar.'
Endif
End Sequence
RETURN
Tem alguns comentários, pois as vezes tinha q depurar o código.