units/indy/IdTrivialFTPBase.pas

   1 // 27-nov-2002
   2 unit IdTrivialFTPBase;
   3
   4 interface
   5
   6 uses
   7   IdGlobal,
   8   IdUDPBase, IdUDPClient,
   9   SysUtils;
  10
  11 type
  12   TIdTFTPMode = (tfNetAscii, tfOctet);
  13
  14 type
  15   WordStr = string[2];
  16
  17 function MakeAckPkt(const BlockNumber: Word): string;
  18 procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: Integer;
  19   const ErrNumber: Word; ErrorString: string); overload;
  20 procedure SendError(UDPClient: TIdUDPClient; const ErrNumber: Word; ErrorString:
  21   string); overload;
  22 procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: Integer;
  23   E: Exception); overload;
  24 procedure SendError(UDPClient: TIdUDPClient; E: Exception); overload;
  25 function StrToWord(const Value: string): Word;
  26 function WordToStr(const Value: Word): WordStr;
  27
  28 const
  29   TFTP_RRQ = 1;
  30   TFTP_WRQ = 2;
  31   TFTP_DATA = 3;
  32   TFTP_ACK = 4;
  33   TFTP_ERROR = 5;
  34   TFTP_OACK = 6;
  35
  36 const
  37   MaxWord = High(Word);
  38   hdrsize = 4;
  39   sBlockSize = 'blksize'#0;
  40
  41 const
  42   ErrUndefined = 0;
  43   ErrFileNotFound = 1;
  44   ErrAccessViolation = 2;
  45   ErrAllocationExceeded = 3;
  46   ErrIllegalOperation = 4;
  47   ErrUnknownTransferID = 5;
  48   ErrFileAlreadyExists = 6;
  49   ErrNoSuchUser = 7;
  50   ErrOptionNegotiationFailed = 8;
  51
  52 implementation
  53
  54 uses
  55   {IdException,}
  56   IdStack;
  57
  58 function StrToWord(const Value: string): Word;
  59 begin
  60   Result := Word(pointer(@Value[1])^);
  61 end;
  62
  63 function WordToStr(const Value: Word): WordStr;
  64 begin
  65   SetLength(Result, SizeOf(Value));
  66   Move(Value, Result[1], SizeOf(Value));
  67 end;
  68
  69 function MakeAckPkt(const BlockNumber: Word): string;
  70 begin
  71   Result := WordToStr(GStack.WSHToNs(TFTP_ACK)) +
  72     WordToStr(GStack.WSHToNs(BlockNumber));
  73 end;
  74
  75 procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: Integer;
  76   const ErrNumber: Word; ErrorString: string);
  77 begin
  78   UDPBase.Send(APeerIP, APort, WordToStr(GStack.WSHToNs(TFTP_ERROR)) +
  79     WordToStr(ErrNumber) + ErrorString + #0);
  80 end;
  81
  82 procedure SendError(UDPClient: TIdUDPClient; const ErrNumber: Word; ErrorString:
  83   string);
  84 begin
  85   SendError(UDPClient, UDPClient.Host, UDPClient.Port, ErrNumber, ErrorString);
  86 end;
  87
  88 procedure SendError(UDPBase: TIdUDPBase; APeerIP: string; const APort: Integer;
  89   E: Exception);
  90 var
  91   ErrNumber: Word;
  92 begin
  93   ErrNumber := ErrUndefined;
  94 {  if E is EIdTFTPFileNotFound then ErrNumber := ErrFileNotFound;
  95   if E is EIdTFTPAccessViolation then ErrNumber := ErrAccessViolation;
  96   if E is EIdTFTPAllocationExceeded then ErrNumber := ErrAllocationExceeded;
  97   if E is EIdTFTPIllegalOperation then ErrNumber := ErrIllegalOperation;
  98   if E is EIdTFTPUnknownTransferID then ErrNumber := ErrUnknownTransferID;
  99   if E is EIdTFTPFileAlreadyExists then ErrNumber := ErrFileAlreadyExists;
 100   if E is EIdTFTPNoSuchUser then ErrNumber := ErrNoSuchUser;
 101   if E is EIdTFTPOptionNegotiationFailed then
 102     ErrNumber := ErrOptionNegotiationFailed;}
 103   SendError(UDPBase, APeerIP, APort, ErrNumber, E.Message);
 104 end;
 105
 106 procedure SendError(UDPClient: TIdUDPClient; E: Exception);
 107 begin
 108   SendError(UDPClient, UDPClient.Host, UDPClient.Port, E);
 109 end;
 110
 111 end.