BlackTDN :: ADVPL ~ Class TFTPClient : Combo I
Esse post inicia uma série sobre como transferir arquivos via FTP usando a Classe não documentada TFTPClient.
Muitos já devem ter usado as funções padrões para transferência de arquivos via FTP documentadas no TDN (Pasta: FTP).
O grande problema das funções é que nem todas elas estão documentadas: à exemplo da Função FTPQuote( cCommand ) que envia um subcomando FTP a ser executado no servidor. Além disso, as funções padrões, baseadas na classe TFTPClient não nos fornecem recursos para “depuração”.
Considerando que as funções padrões FTP* “encapsulam” o objeto instanciado pela classe TFTPClient vou usar essa última no código de exemplo para tornarná-lo mais rico em informações e, de certa forma, mais didático (assim espero). O original e suas dependências poderão ser obtidos ao clicar aqui. Um detalhe importante sobre o código de exemplo é que todas as saídas se darão no console do appserver. Então execute em modo “debug” e acompanhe passo a passo a execução e observe as mensagens: elas são muito importantes para o bom entendimento do exemplo proposto.
Vale lembrar que, para o exemplo, usei um ambiente “controlado”; baseado no SO Windows XP SP3 (ambiente no qual montei e testei os exemplos). Sendo assim, e, dependendo do ambiente, o código necessitará de ajustes.
Para testar e demonstrar o exemplo utilizarei o SO Microsoft Windows XP SP3 (outra versão, que suporte FTP, poderá ser utilizada) e o totvs/protheus 10 (TOTVS - Build 7.00.111010P - Jan 20 2012 - 11:13:58).
Segue o código que será utilizado como base para a série sobre TFTPClient. Nos Próximos “combos” ele será destrinchado em suas partes mais importantes e fundamentais.
1: #include "protheus.ch"
2: #include "directry.ch"
3: 4: #xtranslate USER PROCEDURE <p> => PROCEDURE U_<p> 5: 6: #define CLSARR_CLASS_NAME 1
7: 8: #define FTP_FILES_SAMPLES 10
9: #define FTP_DIRECTORY_SAMPLES 10
10: 11: //Define Path com arquivo de configuracao FTP. Redefina conforme necessidade
12: #define FTP_PATH_INI_FILE "C:\u_FTPSample\ini\u_FTPSample.ini"
13: 14: Static __cCRLF := CRLF 15: 16: /*
17: Procedure : FtpSample()
18: Autor : Marinaldo de jesus [ www.blacktdn.com.br ]
19: Data : 05/05/2012
20: Uso : Demonstrar o Uso da Classe FTPClient em ADVPL
21: Obs : Testado em servidor FTP local baseado no Windows XP SP3
22: */
23: User Procedure FtpSample() 24: 25: Local baEval 26: 27: Local nBL 28: Local nEL 29: 30: Local nFile 31: Local nFiles 32: 33: Local cVar 34: Local cSource 35: Local cTarget 36: 37: Local aDirs 38: Local aFiles 39: Local aFTPCData 40: Local aDirectory 41: Local aFTPDirectory 42: 43: Local cFTPServer 44: Local nFTPPort 45: Local cFTPUser 46: Local cFTPPassword 47: Local lFTPFireWallMode 48: Local nFTPUsesIPConnection 49: Local nConnectTimeOut 50: 51: Local lTFINI := FindFunction( "U_TFINI" )
52: Local lUTVarInfo := FindFunction( "U_TVARINFONEW" )
53: Local nClsFTPClient := aScan(__ClsArr(),{|x|x[CLSARR_CLASS_NAME]=="TFTPCLIENT"})
54: 55: //para que retorne exatamente como em disco em Directory()
56: //.NOT. lCaseSensitive em oFTPClient:Directory() estranho como misturam os conceitos (confuso isso)
57: Local lCaseSensitive := .F. 58: 59: Local oFTPIni 60: Local oFTPClient := tFtpClient():New() 61: Local oFTPClassInfo 62: 63: Local cTempFile 64: Local cSubDirFTP65: Local cDirFTPSample := "\u_FtpSample\"
66: 67: Local cFTPCurDir := ""
68: 69: Local cFTPCommand 70: Local nFTPCommand 71: Local cLastResponse 72: 73: Local nfHandle 74: Local nAttempts 75: 76: ConOut( "" , "[FTPClient][TEST][BEGIN]" )
77: 78: IF ( lUTVarInfo ) 79: //Devido a ma formacao da Classe TFTPClient nao posso passar oFTPClient diretamente 80: //para TVarInfo entao utilizo __ClsArr() para Obter as Propriedades e Metodos da Classe81: oFTPClassInfo := U_TVARINFONEW( __ClsArr()[nClsFTPClient] , "ClassFTPClient" )
82: ConOut( "" , "[FTPClient][TEST][oFTPClassInfo][BEGIN]" )
83: oFTPClassInfo:cCRLF := ""
84: ConOut( oFTPClassInfo:Echo() ) 85: While oFTPClassInfo:GoNext() 86: ConOut( oFTPClassInfo:Echo() ) 87: End While88: ConOut( "" , "[FTPClient][TEST][oFTPClassInfo][END]" )
89: EndIF 90: 91: BEGIN SEQUENCE 92: 93: //Criando Diretorio "Local" Base
94: nAttempts := 0 95: While ( .NOT. lIsDir( cDirFTPSample ) ) 96: MakeDir( cDirFTPSample ) 97: IF lIsDir( cDirFTPSample ) 98: EXIT 99: EndIF 100: IF ( ++nAttempts > 10 ) 101: BREAK 102: EndIF 103: FTPSleep(NIL,500) 104: End While 105: 106: nFiles := FTP_FILES_SAMPLES 107: 108: //Criando os arquivos no diretorio Principal 109: For nFile := 1 To nFiles 110: //Criando os arquivos nos subDiretorios 111: For nFile := 1 To nFiles 112: cTempFile := CriaTrab( NIL , .F. )113: cTempFile += ".txt"
114: nfHandle := fCreate( cDirFTPSample + cTempFile ) 115: IF ( .NOT. ( nfHandle == -1 ) ) 116: //Crio um arquivo baseado nos Commandos Quote FTP 117: aEval( FTPQCommands() , { |cCommand| fWrite( nfHandle , cCommand + __cCRLF ) } ) 118: ENDIF 119: fClose( nfHandle ) 120: Next nFile 121: Next nFile 122: 123: //Extraio um arquivo do RPO124: Resource2File( "U_FTPSample.prg" , cDirFTPSample + "U_FTPSample.prg" )
125: //Extraio varias Imagens do RPO 126: cTarget := cDirFTPSample 127: baEval := { |cResource,nI| IF(nI<=FTP_FILES_SAMPLES,Resource2File(cResource,cTarget+cResource),NIL) }128: aEval(GetResArray("*.jpg"),baEval)
129: 130: //Criando subDiretorios e arquivos "Locais"
131: nEL := FTP_DIRECTORY_SAMPLES 132: For nBL := 1 To nEL133: cSubDirFTP := ( StrZero( nBL , 2 ) + "\" )
134: MakeDir( cDirFTPSample + cSubDirFTP ) 135: IF lIsDir( cDirFTPSample + cSubDirFTP ) 136: //Criando os arquivos nos subDiretorios 137: For nFile := 1 To nFiles 138: cTempFile := CriaTrab( NIL , .F. )139: cTempFile += ".txt"
140: nfHandle := fCreate( cDirFTPSample + cSubDirFTP + cTempFile ) 141: IF ( .NOT. ( nfHandle == -1 ) ) 142: //Crio um arquivo baseado nos Commandos Quote FTP 143: aEval( FTPQCommands() , { |cCommand| fWrite( nfHandle , cCommand + __cCRLF ) } ) 144: ENDIF 145: fClose( nfHandle ) 146: Next nFile 147: //Extraio um arquivo do RPO148: Resource2File( "U_FTPSample.prg" , cDirFTPSample + cSubDirFTP + "U_FTPSample.prg" )
149: //Extraio varias Imagens do RPO 150: cTarget := cDirFTPSample+cSubDirFTP 151: baEval := { |cResource,nI| IF(nI<=FTP_FILES_SAMPLES,Resource2File(cResource,cTarget+cResource),NIL) }152: aEval(GetResArray("*.jpg"),baEval)
153: EndIF 154: Next nBL 155: 156: IF ( lTFINI ) 157: 158: //Atente para o Path do arquivo .ini de exemplo 159: oFTPIni := tFIni():New(FTP_PATH_INI_FILE) 160: 161: /* 162: u_FTPSample.ini DEFINITIONS BEGIN 163: 164: [FTP] 165: Server=<name_server> 166: Port=<port> 167: User=<user> 168: Password=<pwd> 169: FireWallMode=<0|1> 170: UsesIPConnection=<0|1> 171: ConnectTimeOut=<nTimeOutValue> 172: 173: u_FTPSample.ini DEFINITIONS END 174: 175: */ 176: 177: cFTPServer := oFTPIni:GetPropertyValue("FTP","Server")
178: nFTPPort := Val( oFTPIni:GetPropertyValue("FTP","Port") )
179: cFTPUser := oFTPIni:GetPropertyValue("FTP","User")
180: cFTPPassword := oFTPIni:GetPropertyValue("FTP","Password")
181: 182: lFTPFireWallMode := ( Val( oFTPIni:GetPropertyValue("FTP","FireWallMode") ) == 1 )
183: nFTPUsesIPConnection := Val( oFTPIni:GetPropertyValue("FTP","UsesIPConnection") )
184: nConnectTimeOut := Val( oFTPIni:GetPropertyValue("FTP","ConnectTimeOut") )
185: 186: Else 187: 188: cFTPServer := "localhost"
189: nFTPPort := 21190: cFTPUser := "anonymous"
191: cFTPPassword := NIL 192: 193: lFTPFireWallMode := 0 194: nFTPUsesIPConnection := 0 195: nConnectTimeOut := 900 196: 197: EndIF 198: 199: oFTPClient:bFireWallMode := lFTPFireWallMode 200: 201: //Deveria ser Logico mas eh numerico 202: oFTPClient:bUsesIPConnection := nFTPUsesIPConnection 203: 204: oFTPClient:nConnectTimeOut := nConnectTimeOut 205: 206: //Tenta efetuar conexao FTP 207: IF ( .NOT. FTPConnect(@oFTPClient,@cFTPServer,@nFTPPort,@cFTPUser,@cFTPPassword) ) 208: BREAK 209: EndIF 210: 211: //Obtemos os valores das Propriedades da Classe TFTPCLIENT212: ConOut( "" , "[FTPClient][TEST][Properties]" , "" )
213: aFTPCData := __ClsArr()[nClsFTPClient][3] 214: Private oFTPVar := oFTPClient 215: nEL := Len( aFTPCData ) 216: For nBL := 1 To nEL 217: cVar := aFTPCData[nBL][1]218: IF ( cVar $ "[ CERRORSTRING ]" )
219: //"Undefined GetValueType value in file c:\advtec9\advpl\classinst.hpp at line 146"
220: cLastResponse := "Undefined GetValueType value in file"
221: ConOut( "[FTPClient][TEST][Properties][Property]["+cVar+"]["+cLastResponse+"]" )
222: Loop 223: EndIF224: ConOut( "[FTPClient][TEST][Properties][Property]["+cVar+"]["+cValToChar(oFTPVar&(":"+cVar))+"]" )
225: Next nBL 226: 227: oFTPVar := NIL 228: 229: ConOut( "" , "[FTPClient][TEST][FTPHelp]" )
230: //Verificamos quais comandos estao disponiveis 0 Ok, .not. 0 Error 231: nEL := Len( FTPQCommands() ) 232: For nBL := 1 To nEL 233: cFTPCommand := FTPQCommands()[nBL] 234: nFTPCommand := oFTPClient:GetHelp(@cFTPCommand)235: ConOut("[FTPClient][TEST][FTPHelp][FTPCommand]["+cFTPCommand+"]["+cValToChar(nFTPCommand)+"]")
236: cLastResponse := oFTPClient:GetLastResponse()237: ConOut("[FTPClient][TEST][FTPHelp][FTPLastMsg]["+cLastResponse+"]")
238: Next nBL 239: 240: ConOut( "" , "[FTPClient][TEST][FTPHelp]" )
241: //Verificamos quais comandos nao estao disponiveis. 0 Ok, .not. 0 Error (Forcando o Erro) 242: nEL := Len( FTPQCommands() ) 243: For nBL := 1 To nEL244: cFTPCommand := "_*@"+FTPQCommands()[nBL]+"@*_"
245: nFTPCommand := oFTPClient:GetHelp(@cFTPCommand)246: ConOut("[FTPClient][TEST][FTPHelp][FTPCommand]["+cFTPCommand+"]["+cValToChar(nFTPCommand)+"]")
247: cLastResponse := oFTPClient:GetLastResponse()248: ConOut("[FTPClient][TEST][FTPHelp][FTPLastMsg]["+cLastResponse+"]")
249: Next nBL 250: 251: ConOut( "" , "[FTPClient][TEST][Quote]" )
252: //Verificamos Os Erros de FTPQuote. 0 Ok, .not. 0 Error 253: nEL := Len( FTPQCommands() ) 254: For nBL := 1 To nEL 255: cFTPCommand := FTPQCommands()[nBL] 256: //Quote espera CRLF ao Final do Comando 257: nFTPCommand := FTPQuote(@oFTPClient,@cFTPCommand)258: ConOut("[FTPClient][TEST][FTPQuote]["+cFTPCommand+"]["+cValToChar(nFTPCommand)+"]")
259: cLastResponse := oFTPClient:GetLastResponse()260: ConOut("[FTPClient][TEST][FTPQuote][FTPLastMsg]["+cLastResponse+"]")
261: //Reconecto se QUIT ou REIN262: IF ( ( nFTPCommand == 0 ) .and. ( cFTPCommand $ "[ QUIT ][ REIN ]" ) )
263: //Tenta efetuar conexao FTP 264: IF ( .NOT. FTPConnect(oFTPClient,cFTPServer,nFTPPort,cFTPUser,cFTPPassword) ) 265: BREAK 266: EndIF 267: EndIF 268: Next nBL 269: 270: ConOut( "" , "[FTPClient][TEST][Quote]" )
271: //Verificamos Os Erros de FTPQuote. 0 Ok, .not. 0 Error (Forcando o Erro) 272: nEL := Len( FTPQCommands() ) 273: For nBL := 1 To nEL274: cFTPCommand := "_*@"+FTPQCommands()[nBL]+"@*_"
275: //Quote espera CRLF ao Final do Comando.276: //Tem outro "Gato" aqui. Quote sempre retorna Zero mesmo o comando nao existindo
277: nFTPCommand := FTPQuote(@oFTPClient,@cFTPCommand)278: ConOut("[FTPClient][TEST][FTPQuote]["+cFTPCommand+"]["+cValToChar(nFTPCommand)+"]")
279: cLastResponse := oFTPClient:GetLastResponse()280: ConOut( "[FTPClient][TEST][FTPQuote][FTPLastMsg]["+cLastResponse+"]")
281: Next nBL 282: 283: //Redefino a Conexao 284: IF ( .NOT. FTPConnect(@oFTPClient,@cFTPServer,@nFTPPort,@cFTPUser,@cFTPPassword) ) 285: BREAK 286: EndIF 287: 288: //Obtenho o diretorio FTP Corrente 289: cFTPCurDir := FTPGetCurDir(@oFTPClient) 290: IF ( Empty( cFTPCurDir ) ) 291: BREAK 292: EndIF 293: 294: //Obtenho os diretorios e arquivos "Locais"
295: aDirectory := Directory(cDirFTPSample+"*","D",NIL,@lCaseSensitive)
296: 297: aDirs := Array(0) 298: aFiles := Array(0) 299: 300: //Separo Diretorios de Arquivos 301: SplitFDir(@aDirectory,@aDirs,@aFiles,.F.) 302: 303: ConOut( "" , "[FTPClient][TEST][UpLoad][BEGIN]" , "" )
304: 305: //Demonstrar a Criacao do Diretorio via Quote e/ou MKDir 306: IF ( cFTPCurDir == "/" )
307: 308: //Verifico se o Diretorio Existe 309: IF !( FTPChangeDir(@oFTPClient,@cDirFTPSample) ) 310: //Senao Tento Cria-lo 311: IF !( FTPMakeDir(@oFTPClient,@cDirFTPSample) ) 312: BREAK 313: EndIF 314: IF !( FTPChangeDir(@oFTPClient,@cDirFTPSample) ) 315: BREAK 316: EndIF 317: EndIF 318: 319: //UpLoad dos arquvios da pasta principal 320: nFiles := Len(aFiles) 321: For nFile := 1 To nFiles 322: 323: cSource := cDirFTPSample+aFiles[nFile][F_NAME] 324: cTarget := aFiles[nFile][F_NAME] 325: //Envia o arquivo via SendFile 326: nFTPCommand := FTPSendFile(@oFTPClient,@cSource,@cTarget,@lFTPFireWallMode) 327: 328: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 329: aFTPDirectory := FTPDirectory(@oFTPClient,@cTarget,@lCaseSensitive,@lFTPFireWallMode) 330: 331: //Verifico se o arquivo foi transferido "corretamente". Melhor seria via MD5.
332: IF ( Len(aFTPDirectory) == 1 ) 333: IF ( Len(aFiles[nFile]) == Len(aFTPDirectory[1]) ) 334: IF (; 335: ( aFiles[nFile][F_NAME] == aFTPDirectory[1][F_NAME] ); 336: .and.; 337: ( aFiles[nFile][F_SIZE] == aFTPDirectory[1][F_SIZE] ); 338: )339: ConOut("[FTPClient][TEST][SendFile]["+cSource+"][OK]")
340: //Apago o arquivo "Local"
341: IF File( cSource ) 342: fErase( cSource ) 343: EndIF 344: EndIF 345: EndIF 346: EndIF 347: 348: Next nFile 349: 350: //Criacao dos SubDiretorios e UpLoad dos arquivos 351: nEL := Len(aDirs) 352: For nBL := 1 To nEL 353: 354: //Tenta ir para o Root355: IF !( FTPChangeDir(@oFTPClient,"/") )
356: Loop 357: EndIF 358: 359: //Tenta ir para o diretorio base 360: IF !( FTPChangeDir(@oFTPClient,cDirFTPSample) ) 361: Loop 362: EndIF 363: 364: //Verifico se o Diretorio Existe 365: IF !( FTPChangeDir(@oFTPClient,aDirs[nBL]) ) 366: //Senao Tento Cria-lo 367: IF !( FTPMakeDir(@oFTPClient,aDirs[nBL]) ) 368: Loop 369: EndIF 370: IF !( FTPChangeDir(@oFTPClient,aDirs[nBL]) ) 371: Loop 372: EndIF 373: EndIF 374: 375: //Obtenho os arquivos "Locais"
376: aFiles := Directory(cDirFTPSample+aDirs[nBL]+"\"+"*","A",NIL,@lCaseSensitive)
377: //Envio o arquivo para o Servidor FTP 378: nFiles := Len(aFiles) 379: For nFile := 1 To nFiles 380: 381: cSource := (cDirFTPSample+aDirs[nBL]+"\"+aFiles[nFile][F_NAME])
382: cTarget := aFiles[nFile][F_NAME] 383: //Envia o arquivo via SendFile 384: nFTPCommand := FTPSendFile(@oFTPClient,@cSource,@cTarget,@lFTPFireWallMode) 385: 386: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 387: aFTPDirectory := FTPDirectory(@oFTPClient,@cTarget,@lCaseSensitive,@lFTPFireWallMode) 388: 389: //Verifico se o arquivo foi transferido "corretamente". Melhor seria via MD5.
390: IF ( Len(aFTPDirectory) == 1 ) 391: IF ( Len(aFiles[nFile]) == Len(aFTPDirectory[1]) ) 392: IF (; 393: ( aFiles[nFile][F_NAME] == aFTPDirectory[1][F_NAME] ); 394: .and.; 395: ( aFiles[nFile][F_SIZE] == aFTPDirectory[1][F_SIZE] ); 396: )397: ConOut("[FTPClient][TEST][SendFile]["+cSource+"][OK]")
398: //Apago o arquivo "Local"
399: IF File( cSource ) 400: fErase( cSource ) 401: EndIF 402: EndIF 403: EndIF 404: EndIF 405: 406: Next nFile 407: 408: Next nBL 409: 410: EndIF 411: 412: ConOut( "" , "[FTPClient][TEST][UpLoad][END]" , "" )
413: 414: ConOut( "" , "[FTPClient][TEST][DownLoad][BEGIN]")
415: 416: //Tenta ir para o Root417: IF !( FTPChangeDir(@oFTPClient,"/") )
418: BREAK 419: EndIF 420: 421: //Tenta ir para o diretorio base 422: IF !( FTPChangeDir(@oFTPClient,@cDirFTPSample) ) 423: BREAK 424: EndIF 425: 426: //Obtenho os diretorios e arquivos do Servidor FTP427: aFTPDirectory := FTPDirectory(@oFTPClient,"*",@lCaseSensitive,@lFTPFireWallMode)
428: //Separo Diretorios de Arquivos 429: SplitFDir(@aFTPDirectory,@aDirs,@aFiles,.T.) 430: 431: //Testo a Existencia do Diretorio "Local" Base
432: nAttempts := 0 433: While ( .NOT. lIsDir( cDirFTPSample ) ) 434: MakeDir( cDirFTPSample ) 435: IF lIsDir( cDirFTPSample ) 436: EXIT 437: EndIF 438: IF ( ++nAttempts > 10 ) 439: BREAK 440: EndIF 441: FTPSleep(@oFTPClient,500) 442: End While 443: 444: //DownLoad dos arquvios da pasta principal 445: nFiles := Len(aFiles) 446: For nFile := 1 To nFiles 447: 448: cSource := aFiles[nFile][F_NAME] 449: cTarget := ( cDirFTPSample+aFiles[nFile][F_NAME] ) 450: //Recebe o arquivo via ReceiveFile 451: nFTPCommand := FTPReceiveFile(@oFTPClient,@cSource,@cTarget,@lFTPFireWallMode) 452: 453: //Tento Obter informacoes do arquivo Recebido em modo CaseSensitive454: aDirectory := Directory(@cTarget,"A",NIL,@lCaseSensitive)
455: 456: //Verifico se o arquivo foi transferido "corretamente". Melhor seria via MD5.
457: IF ( Len(aDirectory) == 1 ) 458: IF ( Len(aFiles[nFile]) == Len(aDirectory[1]) ) 459: IF (; 460: ( aFiles[nFile][F_NAME] == aDirectory[1][F_NAME] ); 461: .and.; 462: ( aFiles[nFile][F_SIZE] == aDirectory[1][F_SIZE] ); 463: )464: ConOut("[FTPClient][TEST][ReceiveFile]["+cTarget+"][OK]")
465: //Apago o arquivo do Servidor FTP 466: FTPfErase(@oFTPClient,@cSource,@lCaseSensitive,@lFTPFireWallMode) 467: EndIF 468: EndIF 469: EndIF 470: 471: Next nFile 472: 473: //Criacao dos SubDiretorios e DownLoad dos arquivos 474: nEL := Len(aDirs) 475: For nBL := 1 To nEL 476: 477: //Tenta ir para o Root478: IF !( FTPChangeDir(@oFTPClient,"/") )
479: Loop 480: EndIF 481: 482: //Tenta ir para o diretorio base 483: IF !( FTPChangeDir(@oFTPClient,cDirFTPSample) ) 484: Loop 485: EndIF 486: 487: //Verifico se o Diretorio Existe 488: IF !( FTPChangeDir(@oFTPClient,aDirs[nBL]) ) 489: Loop 490: EndIF 491: 492: //Testo a Existencia do Diretorio "Local"
493: nAttempts := 0 494: While ( .NOT. lIsDir( cDirFTPSample + aDirs[nBL] ) ) 495: MakeDir( cDirFTPSample + aDirs[nBL] ) 496: IF lIsDir( cDirFTPSample + aDirs[nBL] ) 497: EXIT 498: EndIF 499: IF ( ++nAttempts > 10 ) 500: BREAK 501: EndIF 502: FTPSleep(@oFTPClient,500) 503: End While 504: 505: //Obtenho os arquivos a Partir do Servidor FTP506: aFTPDirectory := FTPDirectory(@oFTPClient,"*",@lCaseSensitive,@lFTPFireWallMode)
507: 508: //Separo Diretorios de Arquivos 509: SplitFDir(@aFTPDirectory,NIL,@aFiles,.T.) 510: 511: //Recebendo os arquivos a partir do Servidor FTP 512: nFiles := Len(aFiles) 513: For nFile := 1 To nFiles 514: 515: cSource := aFiles[nFile][F_NAME]516: cTarget := (cDirFTPSample+aDirs[nBL]+"\"+aFiles[nFile][F_NAME])
517: //Recebe o arquivo via ReceiveFile 518: nFTPCommand := FTPReceiveFile(@oFTPClient,@cSource,@cTarget,@lFTPFireWallMode) 519: 520: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive521: aDirectory := Directory(@cTarget,"A",NIL,@lCaseSensitive)
522: 523: //Verifico se o arquivo foi Recebido Corretamente "corretamente". Melhor seria via MD5.
524: IF ( Len(aDirectory) == 1 ) 525: IF ( Len(aFiles[nFile]) == Len(aDirectory[1]) ) 526: IF (; 527: ( aFiles[nFile][F_NAME] == aDirectory[1][F_NAME] ); 528: .and.; 529: ( aFiles[nFile][F_SIZE] == aDirectory[1][F_SIZE] ); 530: )531: ConOut("[FTPClient][TEST][ReceiveFile]["+cTarget+"][OK]")
532: //Apago o arquivo do Servidor FTP 533: FTPfErase(@oFTPClient,@cSource,@lCaseSensitive,@lFTPFireWallMode) 534: EndIF 535: EndIF 536: EndIF 537: 538: Next nFile 539: 540: Next nBL 541: 542: ConOut( "" , "[FTPClient][TEST][DownLoad][END]")
543: 544: END SEQUENCE 545: 546: //Tenta ir para o Root547: IF ( FTPChangeDir(@oFTPClient,"/") )
548: //Apagando os arquivos Temporarios no Servidor FTP549: aFTPDirectory := FTPDirectory(@oFTPClient,"*.tmp",@lCaseSensitive,@lFTPFireWallMode)
550: //Separo Diretorios de Arquivos (Redundante aqui) 551: SplitFDir(@aFTPDirectory,NIL,@aFiles,.T.) 552: nFiles := Len( aFiles ) 553: For nFile := 1 To nFiles 554: cSource := aFiles[nFile][F_NAME] 555: FTPfErase(@oFTPClient,@cSource,@lCaseSensitive,@lFTPFireWallMode) 556: Next nFile 557: EndIF 558: 559: ConOut( "" , "[FTPClient][TEST][FTPClose]" )
560: cFTPCommand := "QUIT"
561: FTPQuote(@oFTPClient,@cFTPCommand) 562: oFTPClient:Close() 563: 564: ConOut( "" , "[FTPClient][TEST][FreeObj]" )
565: oFTPClient := FreeObj( oFTPClient ) 566: 567: IF ( lUTVarInfo ) 568: oFTPClassInfo:Close() 569: oFTPClassInfo := FreeObj( oFTPClassInfo ) 570: EndIF 571: 572: IF ( lTFINI ) 573: oFTPIni := FreeObj( oFTPIni ) 574: EndIF 575: 576: ConOut( "[FTPClient][TEST][END]" , "" )
577: 578: Return 579: 580: /* 581: Funcao : FTPConnect 582: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 583: Data : 05/05/2012 584: Uso : Tentar efetar uma conexao FTP 585: */ 586: Static Function FTPConnect(oFTPClient,cFTPServer,nFTPPort,cFTPUser,cFTPPassword) 587: 588: Local cLastResponse 589: 590: Local nFTpCommand 591: Local lFTPConnect 592: 593: oFTPClient:Close() 594: 595: ConOut( "" , "[FTPClient][TEST][FTPConnect]" )
596: 597: nFTpCommand := oFTPClient:FTPConnect(@cFTPServer,@nFTPPort,@cFTPUser,@cFTPPassword) 598: lFTPConnect := ( nFTPCommand == 0 ) 599: 600: IF ( lFTPConnect )601: ConOut( "[FTPClient][TEST][FTPConnect][OK]["+cValToChar(nFTPCommand)+"]" , "" )
602: cLastResponse := oFTPClient:GetLastResponse()603: ConOut( "[FTPClient][TEST][FTPConnect][OK]["+Ltrim(Str(nFTPCommand))+"]["+cLastResponse+"]")
604: Else 605: /* 606: Tem um Gato aqui. cErrorString deveria ser String mas esta definida como Number 607: Undefined GetValueType value in file c:\advtec9\advpl\classinst.hpp at line 146 608: 609: Win NT/2000 610: 611: [INFO ][SERVER] [SMARTHEAP] Registering Tasks... 612: *** TOTVS S.A. *** 613: *** www.totvs.com.br *** 614: TOTVS - Build 7.00.111010P - Jan 20 2012 - 11:13:58 615: */ 616: * ConOut( "[FTPClient][TEST][FTPConnect][Error]["+oFTPClient:cErrorString+"]")
617: cLastResponse := oFTPClient:GetLastResponse()618: ConOut( "[FTPClient][TEST][FTPConnect][Error]["+Ltrim(Str(nFTPCommand))+"]["+cLastResponse+"]")
619: EndIF 620: 621: Return( lFTPConnect ) 622: 623: /* 624: Function : FTPGetCurDir() 625: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 626: Data : 05/05/2012 627: Uso : Retorna o Diretorio FTP Corrente 628: */ 629: Static Function FTPGetCurDir(oFTPClient) 630: 631: Local cLastResponse 632: Local cFTPCurDir 633: Local cFTPCommand 634: Local nFTPCommand 635: 636: Static __lGetDirQuote := .F. 637: 638: ConOut( "" , "[FTPClient][TEST][GetCurDir]" )
639: 640: IF ( __lGetDirQuote ) 641: __lGetDirQuote := .F. 642: //Obtenho o diretorio corrente via XPWD em Quote643: cFTPCommand := "XPWD"
644: nFTPCommand := FTPQuote(@oFTPClient,@cFTPCommand) 645: cLastResponse := oFTPClient:GetLastResponse()646: IF ( SubStr( cLastResponse , 1 , 3 ) == "257" )
647: cFTPCurDir := StrToKArr( cLastResponse , '"' )[2] 648: EndIF 649: Else 650: __lGetDirQuote := .T.651: //Obtenho o diretorio corrente via GetCurDir
652: nFTPCommand := oFTPClient:GetCurDir(@cFTPCurDir) 653: EndIF 654: 655: DEFAULT cFTPCurDir := ""
656: 657: IF ( .NOT. ( nFTPCommand == 0 ) .or. .NOT. ( "/" $ cFTPCurDir ) )
658: /*
659: Tem um Gato aqui. cErrorString deveria ser String mas esta definida como Number
660: Undefined GetValueType value in file c:\advtec9\advpl\classinst.hpp at line 146
661: 662: Win NT/2000
663: 664: [INFO ][SERVER] [SMARTHEAP] Registering Tasks...
665: *** TOTVS S.A. ***
666: *** www.totvs.com.br ***
667: TOTVS - Build 7.00.111010P - Jan 20 2012 - 11:13:58
668: */
669: * ConOut( "[FTPClient][TEST][GetCurDir][Error]["+oFTPClient:cErrorString+"]")
670: ConOut( "[FTPClient][TEST][GetCurDir][Error]["+Ltrim(Str(nFTPCommand))+"]")
671: cLastResponse := oFTPClient:GetLastResponse()672: ConOut( "[FTPClient][TEST][FTPLastMsg][Error]["+Ltrim(Str(nFTPCommand))+"]["+cLastResponse+"]")
673: cFTPCurDir := ""
674: Else675: ConOut( "[FTPClient][TEST][GetCurDir]["+cFTPCurDir+"]")
676: EndIF 677: 678: Return( cFTPCurDir ) 679: 680: /*
681: Function : FTPChangeDir()
682: Autor : Marinaldo de jesus [ www.blacktdn.com.br ]
683: Data : 05/05/2012
684: Uso : Tenta Modificar o Diretorio Corrente
685: */
686: Static Function FTPChangeDir(oFTPClient,cDir) 687: 688: Local cTmp 689: Local cFTPCommand 690: Local nFTPCommand 691: 692: Local lOk := .F. 693: 694: Static __lChgDirQuote := .F. 695: 696: IF ( __lChgDirQuote ) 697: __lChgDirQuote := .F.698: //Tenta Modificar o Diretorio Corrente usando CWD em Quote
699: cFTPCommand := ( "CWD " + cDir )
700: nFTPCommand := FTPQuote(@oFTPClient,@cFTPCommand) 701: Else 702: __lChgDirQuote := .T.703: //Tenta Modificar o Diretorio Corrente usando ChDir
704: nFTPCommand := oFTPClient:ChDir(cDir) 705: EndIF 706: 707: lOk := ( FTPGetCurDir(@oFTPClient) == cDir ) 708: IF !( lOk )709: cTmp := StrTran(cDir,"\","/")
710: IF ( SubStr(cTmp,-1) == "/" )
711: cTmp := SubStr(cTmp,1,(Len(cTmp)-1)) 712: EndIF 713: lOk := ( FTPGetCurDir(@oFTPClient) == cTmp ) 714: IF !( lOk ) 715: cTmp := FTPGetCurDir(@oFTPClient) 716: lOk := ( SubStr( cTmp , -Len( cDir ) ) == cDir ) 717: EndIF 718: EndIF 719: 720: Return( lOk ) 721: 722: /* 723: Function : FTPMakeDir() 724: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 725: Data : 05/05/2012 726: Uso : Tenta Criar um Diretorio 727: */ 728: Static Function FTPMakeDir(oFTPClient,cDir) 729: 730: Local cLastDir := FTPGetCurDir(oFTPClient) 731: Local cFTPCommand 732: 733: Local lOK := .F. 734: 735: Static __lMkDirQuote := .F. 736: 737: IF ( __lMkDirQuote ) 738: __lMkDirQuote := .F. 739: //Tenta Criar Diretorio usando o comando MDK em Quote740: cFTPCommand := ( "MKD " + cDir )
741: FTPQuote(@oFTPClient,@cFTPCommand) 742: Else 743: __lMkDirQuote := .T. 744: //Tenta Criar Diretorio usando MKDir 745: oFTPClient:MKDir(cDir) 746: EndIF 747: 748: lOK := FTPChangeDir(oFTPClient,@cDir) 749: 750: FTPChangeDir(oFTPClient,"/")
751: FTPChangeDir(oFTPClient,@cLastDir) 752: 753: Return( lOK ) 754: 755: /* 756: Function : FTPQuote() 757: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 758: Data : 05/05/2012 759: Uso : Envia um comando via Quote 760: */ 761: Static Function FTPQuote(oFTPClient,cFTPCommand) 762: Return(oFTPClient:Quote(cFTPCommand+__cCRLF)) 763: 764: /* 765: Function : FTPDirectory() 766: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 767: Data : 05/05/2012 768: Uso : Retorna informacao de Diretorio FTP 769: */ 770: Static Function FTPDirectory(oFTPClient,cMask,lCaseSensitive,lFTPFireWallMode) 771: 772: Local aFTPDirectory 773: 774: Local cLastResponse 775: 776: DEFAULT lCaseSensitive := .F. 777: 778: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 779: aFTPDirectory := oFTPClient:Directory( @cMask , ( .NOT. lCaseSensitive ) ) 780: IF ( Len(aFTPDirectory) == 0 ) 781: cLastResponse := oFTPClient:GetLastResponse()782: IF ( "500" $ cLastResponse )
783: //Altero para Modo Passivo 784: oFTPClient:bFireWallMode := .T. 785: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 786: aFTPDirectory := oFTPClient:Directory( @cMask , ( .NOT. lCaseSensitive ) ) 787: //Restaura Modo Anterior 788: oFTPClient:bFireWallMode := lFTPFireWallMode 789: EndIF 790: EndIF 791: 792: cLastResponse := oFTPClient:GetLastResponse()793: ConOut("[FTPClient][TEST][FTPDirectory]["+cLastResponse+"]")
794: 795: Return( aFTPDirectory ) 796: 797: /* 798: Function : FTPErase() 799: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 800: Data : 05/05/2012 801: Uso : Tenta apagar arquivo no Servidor FTP 802: */ 803: Static Function FTPfErase(oFTPClient,cFile,lCaseSensitive,lFTPFireWallMode) 804: 805: Local cFTPCommand 806: Local nFTPCommand 807: 808: Local lOK := .F. 809: 810: Static __lFTPDelQuote := .F. 811: 812: IF ( __lFTPDelQuote ) 813: __lFTPDelQuote := .F. 814: //Tenta Excluir Diretorio usando o comando DELE em Quote815: cFTPCommand := ( "DELE " + cFile )
816: nFTPCommand := FTPQuote(@oFTPClient,@cFTPCommand) 817: Else 818: __lFTPDelQuote := .T. 819: //Tenta Excluir Diretorio usando DeleteFile 820: nFTPCommand := oFTPClient:DeleteFile( cFile ) 821: EndIF 822: 823: FTPSleep(@oFTPClient,200) 824: 825: cLastResponse := oFTPClient:GetLastResponse()826: ConOut("[FTPClient][TEST][FTPfErase]["+cValToChar(nFTPCommand)+"]["+cLastResponse+"]")
827: 828: lOK := ( Len( FTPDirectory(@oFTPClient,@cFile,@lCaseSensitive,@lFTPFireWallMode) ) == 0 ) 829: 830: Return( lOK ) 831: 832: /* 833: Function : FTPSendFile() 834: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 835: Data : 05/05/2012836: Uso : Tenta efetuar Upload de informacao "Local" para Diretorio FTP
837: */ 838: Static Function FTPSendFile(oFTPClient,cLocalFile,cFTPFile,lFTPFireWallMode) 839: 840: Local cLastResponse 841: 842: Local lOk := .F. 843: 844: Local nFTPCommand := -1 845: 846: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 847: nFTPCommand := oFTPClient:SendFile(@cLocalFile,@cFTPFile) 848: IF ( .NOT. ( nFTPCommand == 0 ) ) 849: cLastResponse := oFTPClient:GetLastResponse()850: IF ( "500" $ cLastResponse )
851: //Altero para Modo Passivo 852: oFTPClient:bFireWallMode := .T. 853: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 854: nFTPCommand := oFTPClient:SendFile(@cLocalFile,@cFTPFile) 855: //Restaura Modo Anterior 856: oFTPClient:bFireWallMode := lFTPFireWallMode 857: EndIF 858: EndIF 859: 860: FTPSleep(@oFTPClient,200) 861: 862: cLastResponse := oFTPClient:GetLastResponse()863: ConOut("[FTPClient][TEST][FTPSendFile]["+cValToChar(nFTPCommand)+"]["+cLastResponse+"]")
864: 865: lOk := ( nFTPCommand == 0 ) 866: 867: Return( lOk ) 868: 869: /* 870: Function : FTPReceiveFile() 871: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 872: Data : 05/05/2012 873: Uso : Tenta efetuar Download de informacao de Diretorio FTP 874: */ 875: Static Function FTPReceiveFile(oFTPClient,cFTPFile,cLocalFile,lFTPFireWallMode) 876: 877: Local cLastResponse 878: 879: Local lOk := .F. 880: 881: Local nFTPCommand := -1 882: 883: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 884: nFTPCommand := oFTPClient:ReceiveFile(@cFTPFile,@cLocalFile) 885: IF ( .NOT. ( nFTPCommand == 0 ) ) 886: cLastResponse := oFTPClient:GetLastResponse()887: IF ( "500" $ cLastResponse )
888: //Altero para Modo Passivo 889: oFTPClient:bFireWallMode := .T. 890: //Tento Obter informacoes do arquivo enviado em modo CaseSensitive 891: nFTPCommand := oFTPClient:ReceiveFile(@cFTPFile,@cLocalFile) 892: //Restaura Modo Anterior 893: oFTPClient:bFireWallMode := lFTPFireWallMode 894: EndIF 895: EndIF 896: 897: FTPSleep(@oFTPClient,200) 898: 899: cLastResponse := oFTPClient:GetLastResponse()900: ConOut("[FTPClient][TEST][FTPReceiveFile]["+cValToChar(nFTPCommand)+"]["+cLastResponse+"]")
901: 902: lOk := ( nFTPCommand == 0 ) 903: 904: Return( lOk ) 905: 906: /* 907: Function : FTPSleep() 908: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 909: Data : 05/05/2012 910: Uso : Sleep com Controle de TimeOut do FTP 911: */ 912: Static Function FTPSleep(oFTPClient,nSleep) 913: Local nFTPSleep 914: DEFAULT nSleep := 0915: IF ( ValType(oFTPClient) == "O" )
916: DEFAULT oFTPClient:nConnectTimeOut := 120 917: nFTPSleep := ( oFTPClient:nConnectTimeOut / 2 ) 918: Else 919: nFTPSleep := nSleep 920: EndIF 921: nSleep := Min( nSleep , nFTPSleep ) 922: Return(Sleep(nSleep)) 923: 924: /* 925: Function : SplitFDir 926: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 927: Data : 05/05/2012 928: Uso : Separa a Estrutura de aDirectory em aDirs e a Files 929: */ 930: Static Procedure SplitFDir(aDirectory,aDirs,aFiles,lFTP) 931: 932: Local nAT 933: 934: DEFAULT aDirs := Array(0) 935: DEFAULT aFiles := Array(0) 936: DEFAULT lFTP := .F. 937: 938: //Obtenho a Estrutura de Diretorios 939: nAT := 0 940: aSize( aDirs , 0 )941: While ( ( nAT := aScan( aDirectory , { |aDir| ( aDir[F_ATTR] == "D" ) } , ++nAT ) ) > 0 )
942: IF ( .NOT.( ( aDirectory[nAT][F_NAME] == "." ) .or. ( aDirectory[nAT][F_NAME] == ".." ) ) )
943: aAdd( aDirs , aDirectory[nAT][F_NAME] ) 944: EndIF 945: End While 946: 947: //Obtenho os arquivos 948: nAT := 0 949: aSize( aFiles , 0 ) 950: IF ( lFTP )951: While ( ( nAT := aScan( aDirectory , { |aDir| Empty( aDir[F_ATTR] ) .or. ( aDir[F_ATTR] == "A" ) } , ++nAT ) ) > 0 )
952: aAdd( aFiles , aDirectory[nAT] ) 953: End While 954: Else955: While ( ( nAT := aScan( aDirectory , { |aDir| ( aDir[F_ATTR] == "A" ) } , ++nAT ) ) > 0 )
956: aAdd( aFiles , aDirectory[nAT] ) 957: End While 958: EndIF 959: 960: aSize( aDirectory , 0 ) 961: 962: Return 963: 964: /* 965: Funcao : FTPQCommands() 966: Autor : Marinaldo de jesus [ www.blacktdn.com.br ] 967: Data : 05/05/2012 968: Uso : Retornar os Quote Commands Validos Base Windows XP SP3 969: 970: Obs.: 971: Alguns Detalhes e explicacoes sobre os comandos poderao ser obitidos na url abaixo 972: http://www.ipswitch.com/support/ws_ftp-server/guide/v5/a_ftpref3.html 973: */ 974: Static Function FTPQCommands() 975: Static __aFTPCmd 976: IF ( __aFTPCmd == NIL ) 977: __aFTPCmd := Array(0)978: aAdd( __aFTPCmd , "ABOR" )
979: aAdd( __aFTPCmd , "ACCT" )
980: aAdd( __aFTPCmd , "ALLO" )
981: aAdd( __aFTPCmd , "APPE" )
982: aAdd( __aFTPCmd , "CDUP" )
983: aAdd( __aFTPCmd , "CWD" )
984: aAdd( __aFTPCmd , "DELE" )
985: aAdd( __aFTPCmd , "HELP" )
986: aAdd( __aFTPCmd , "LIST" )
987: aAdd( __aFTPCmd , "MDTM" )
988: aAdd( __aFTPCmd , "MKD" )
989: aAdd( __aFTPCmd , "MODE" )
990: aAdd( __aFTPCmd , "NLST" )
991: aAdd( __aFTPCmd , "NOOP" )
992: aAdd( __aFTPCmd , "PASS" )
993: aAdd( __aFTPCmd , "PASV" )
994: aAdd( __aFTPCmd , "PORT" )
995: aAdd( __aFTPCmd , "PWD" )
996: aAdd( __aFTPCmd , "QUIT" )
997: aAdd( __aFTPCmd , "REIN" )
998: aAdd( __aFTPCmd , "REST" )
999: aAdd( __aFTPCmd , "RETR" )
1000: aAdd( __aFTPCmd , "RMD" )
1001: aAdd( __aFTPCmd , "RNFR" )
1002: aAdd( __aFTPCmd , "RNTO" )
1003: aAdd( __aFTPCmd , "SITE" )
1004: aAdd( __aFTPCmd , "SIZE" )
1005: aAdd( __aFTPCmd , "SMNT" )
1006: aAdd( __aFTPCmd , "STAT" )
1007: aAdd( __aFTPCmd , "STOR" )
1008: aAdd( __aFTPCmd , "STOU" )
1009: aAdd( __aFTPCmd , "STRU" )
1010: aAdd( __aFTPCmd , "SYST" )
1011: aAdd( __aFTPCmd , "TYPE" )
1012: aAdd( __aFTPCmd , "USER" )
1013: aAdd( __aFTPCmd , "XCUP" )
1014: aAdd( __aFTPCmd , "XCWD" )
1015: aAdd( __aFTPCmd , "XMKD" )
1016: aAdd( __aFTPCmd , "XPWD" )
1017: aAdd( __aFTPCmd , "XRMD" )1018: ENDIF1019: Return( __aFTPCmd )… continua
[]s
иαldσ dj
muito bom!
ResponderExcluirMuito bom mesmo... agora
ResponderExcluirsó nao encontrei como que eu sei as permissoes que eu tenho dentro do servidor ftp, como recortar ou copiar
sabe se tem Naldo?