IdTrivialFTPBase.pas 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154
  1. {
  2. $Project$
  3. $Workfile$
  4. $Revision$
  5. $DateUTC$
  6. $Id$
  7. This file is part of the Indy (Internet Direct) project, and is offered
  8. under the dual-licensing agreement described on the Indy website.
  9. (http://www.indyproject.org/)
  10. Copyright:
  11. (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
  12. }
  13. {
  14. $Log$
  15. }
  16. {
  17. Rev 1.4 2/7/2004 7:20:18 PM JPMugaas
  18. DotNET to go!! and YES - I want fries with that :-).
  19. Rev 1.3 2004.02.03 5:44:38 PM czhower
  20. Name changes
  21. Rev 1.2 10/25/2003 06:52:18 AM JPMugaas
  22. Updated for new API changes and tried to restore some functionality.
  23. Rev 1.1 2003.10.12 6:36:48 PM czhower
  24. Now compiles.
  25. Rev 1.0 11/13/2002 08:03:38 AM JPMugaas
  26. }
  27. unit IdTrivialFTPBase;
  28. interface
  29. {$i IdCompilerDefines.inc}
  30. uses
  31. IdGlobal,
  32. IdUDPBase, IdUDPClient, SysUtils;
  33. type
  34. TIdTFTPMode = (tfNetAscii, tfOctet);
  35. // Procs
  36. function MakeActPkt(const BlockNumber: Word): TIdBytes;
  37. procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: TIdPort; const ErrNumber: Word; const ErrString: string); overload;
  38. procedure SendError(UDPClient: TIdUDPClient; const ErrNumber: Word; const ErrString: string); overload;
  39. procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: TIdPort; E: Exception); overload;
  40. procedure SendError(UDPClient: TIdUDPClient; E: Exception); overload;
  41. const // TFTP opcodes
  42. TFTP_RRQ = 1;
  43. TFTP_WRQ = 2;
  44. TFTP_DATA = 3;
  45. TFTP_ACK = 4;
  46. TFTP_ERROR = 5;
  47. TFTP_OACK = 6; // see RFC 1782 and 1783
  48. const // TFTP error codes
  49. ErrUndefined = 0;
  50. ErrFileNotFound = 1;
  51. ErrAccessViolation = 2;
  52. ErrAllocationExceeded = 3;
  53. ErrIllegalOperation = 4;
  54. ErrUnknownTransferID = 5;
  55. ErrFileAlreadyExists = 6;
  56. ErrNoSuchUser = 7;
  57. ErrOptionNegotiationFailed = 8;
  58. const
  59. // TFTP options
  60. sBlockSize = 'blksize'; {do not localize}
  61. sTransferSize = 'tsize'; {do not localize}
  62. implementation
  63. uses
  64. IdGlobalProtocols, IdExceptionCore, IdStack;
  65. function MakeActPkt(const BlockNumber: Word): TIdBytes;
  66. begin
  67. SetLength(Result, 4);
  68. CopyTIdUInt16(GStack.HostToNetwork(Word(TFTP_ACK)), Result, 0);
  69. CopyTIdUInt16(GStack.HostToNetwork(BlockNumber), Result, 2);
  70. end;
  71. procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: TIdPort; const ErrNumber: Word; const ErrString: string);
  72. var
  73. Buffer, LErrStr: TIdBytes;
  74. begin
  75. LErrStr := ToBytes(ErrString);
  76. SetLength(Buffer, 4 + Length(LErrStr) + 1);
  77. CopyTIdUInt16(GStack.HostToNetwork(Word(TFTP_ERROR)), Buffer, 0);
  78. CopyTIdUInt16(GStack.HostToNetwork(ErrNumber), Buffer, 2);
  79. CopyTIdBytes(LErrStr, 0, Buffer, 4, Length(LErrStr));
  80. Buffer[4 + Length(LErrStr)] := 0;
  81. UDPBase.SendBuffer(APeerIP, APort, Buffer);
  82. end;
  83. procedure SendError(UDPClient: TIdUDPClient; const ErrNumber: Word; const ErrString: string);
  84. begin
  85. SendError(UDPClient, UDPClient.Host, UDPClient.Port, ErrNumber, ErrString);
  86. end;
  87. procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: TIdPort; E: Exception);
  88. var
  89. ErrNumber: Word;
  90. begin
  91. ErrNumber := ErrUndefined;
  92. if E is EIdTFTPFileNotFound then
  93. begin
  94. ErrNumber := ErrFileNotFound;
  95. end;
  96. if E is EIdTFTPAccessViolation then
  97. begin
  98. ErrNumber := ErrAccessViolation;
  99. end;
  100. if E is EIdTFTPAllocationExceeded then
  101. begin
  102. ErrNumber := ErrAllocationExceeded;
  103. end;
  104. if E is EIdTFTPIllegalOperation then
  105. begin
  106. ErrNumber := ErrIllegalOperation;
  107. end;
  108. if E is EIdTFTPUnknownTransferID then
  109. begin
  110. ErrNumber := ErrUnknownTransferID;
  111. end;
  112. if E is EIdTFTPFileAlreadyExists then
  113. begin
  114. ErrNumber := ErrFileAlreadyExists;
  115. end;
  116. if E is EIdTFTPNoSuchUser then
  117. begin
  118. ErrNumber := ErrNoSuchUser;
  119. end;
  120. if E is EIdTFTPOptionNegotiationFailed then
  121. begin
  122. ErrNumber := ErrOptionNegotiationFailed;
  123. end;
  124. SendError(UDPBase, APeerIP, APort, ErrNumber, E.Message);
  125. end;
  126. procedure SendError(UDPClient: TIdUDPClient; E: Exception);
  127. begin
  128. SendError(UDPClient, UDPClient.Host, UDPClient.Port, E);
  129. end;
  130. end.