FTPClient.pas 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125
  1. { $HDR$}
  2. {**********************************************************************}
  3. { Unit archived using Team Coherence }
  4. { Team Coherence is Copyright 2002 by Quality Software Components }
  5. { }
  6. { For further information / comments, visit our WEB site at }
  7. { http://www.TeamCoherence.com }
  8. {**********************************************************************}
  9. {}
  10. { $Log: 11247: FTPClient.pas
  11. {
  12. { Rev 1.0 11/12/2002 09:17:40 PM JPMugaas
  13. { Initial check in. Import from FTP VC.
  14. }
  15. unit FTPClient;
  16. interface
  17. uses
  18. IndyBox;
  19. type
  20. TFTPClient = class(TIndyBox)
  21. public
  22. procedure Test; override;
  23. procedure FTP(const APassive: Boolean);
  24. end;
  25. implementation
  26. uses
  27. Classes,
  28. IdGlobal, IdFTP,
  29. SysUtils;
  30. const
  31. ParamHost = 'ftp.nevrona.com';
  32. ParamUser = 'FTPTest';
  33. ParamPassword = 'FTPTest';
  34. { TFTPClient }
  35. procedure TFTPClient.Test;
  36. begin
  37. Status('Testing Passive.');
  38. FTP(True);
  39. Status('Testing Active.');
  40. FTP(False);
  41. end;
  42. procedure TFTPClient.FTP(const APassive: Boolean);
  43. var
  44. i: Integer;
  45. LDirList: TStringList;
  46. LRecvData: string;
  47. LRecvStream: TMemoryStream;
  48. LSrcData: string;
  49. LSrcStream: TMemoryStream;
  50. LUsername, LPassword, LHost : String;
  51. begin
  52. LSrcStream := TMemoryStream.Create; try
  53. // Fill Source Stream
  54. SetLength(LSrcData, 256);
  55. for i := 0 to 255 do begin
  56. LSrcData[i + 1] := Chr(i);
  57. end;
  58. LSrcStream.WriteBuffer(LSrcData[1], Length(LSrcData));
  59. LSrcStream.Position := 0;
  60. //
  61. with TIdFTP.Create(nil) do try
  62. Passive := APassive;
  63. LHost := Trim(GlobalParamValue('FTP Server'));
  64. LUsername := Trim(GlobalParamValue('FTP Username'));
  65. LPassword := Trim(GlobalParamValue('FTP Password'));
  66. if Length(LHost) = 0 then
  67. begin
  68. LHost := ParamHost;
  69. LUsername := ParamUser;
  70. LPassword := ParamPassword;
  71. end;
  72. Host := LHost;
  73. Username := LUsername;
  74. Password := LPassword;
  75. Connect; try
  76. // Check GET and PUT
  77. Self.Status('Testing PUT');
  78. Put(LSrcStream, 'IndyTest.dat');
  79. Self.Status('Testing GET');
  80. LRecvStream := TMemoryStream.Create; try
  81. Get('IndyTest.dat', LRecvStream);
  82. LRecvStream.Position := 0;
  83. SetLength(LRecvData, LRecvStream.Size);
  84. LRecvStream.ReadBuffer(LRecvData[1], Length(LRecvData));
  85. finally FreeAndNil(LRecvStream); end;
  86. Check(SameText(LSrcData, LRecvData), 'Files do not match');
  87. // Check Rename function
  88. Self.Status('Testing Rename');
  89. Rename('IndyTest.dat', 'IndyTestRenamed.dat');
  90. // Clean up file
  91. Self.Status('Testing Delete');
  92. Delete('IndyTestRenamed.dat');
  93. // Make sure that GET on a non-existant file does in fact fail
  94. try
  95. Self.Status('Testing GET of non existant file');
  96. Get('FakeFile.dat', LRecvStream);
  97. Check(False, 'Exception expected.');
  98. except end;
  99. // Dir Functions
  100. Self.Status('Testing Directory functions');
  101. MakeDir('EmptyTestDir');
  102. ChangeDir('EmptyTestDir');
  103. LDirList := TStringList.Create; try
  104. List(LDirList);
  105. finally FreeAndNil(LDirList); end;
  106. ChangeDir('..');
  107. RemoveDir('EmptyTestDir');
  108. finally Disconnect; end;
  109. finally Free; end;
  110. finally FreeAndNil(LSrcStream); end;
  111. end;
  112. initialization
  113. TIndyBox.RegisterBox(TFTPClient, 'FTP Client', 'Clients');
  114. end.