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 cSubDirFTP
65: 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 Classe
81: 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 While
88: 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 RPO
124: 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 nEL
133: 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 RPO
148: 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 := 21
190: 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 TFTPCLIENT
212: 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: EndIF
224: 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 nEL
244: 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 REIN
262: 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 nEL
274: 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 Root
355: 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 Root
417: 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 FTP
427: 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 CaseSensitive
454: 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 Root
478: 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 FTP
506: 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 CaseSensitive
521: 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 Root
547: IF ( FTPChangeDir(@oFTPClient,"/") )
548: //Apagando os arquivos Temporarios no Servidor FTP
549: 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 Quote
643: 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: Else
675: 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 Quote
740: 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 Quote
815: 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/2012
836: 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 := 0
915: 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: Else
955: 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: ENDIF
1019: Return( __aFTPCmd )
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?