NetRFC.pas

   1 {
   2    Copyright (C) 2010 MegaBrutal
   3
   4    This unit is free software: you can redistribute it and/or modify
   5    it under the terms of the GNU Lesser General Public License as published by
   6    the Free Software Foundation, either version 3 of the License, or
   7    (at your option) any later version.
   8
   9    This unit is distributed in the hope that it will be useful,
  10    but WITHOUT ANY WARRANTY; without even the implied warranty of
  11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12    GNU Lesser General Public License for more details.
  13
  14    You should have received a copy of the GNU Lesser General Public License
  15    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  16 }
  17
  18
  19 unit NetRFC;
  20
  21 {$MODE DELPHI}
  22
  23 interface
  24 uses SysUtils, Classes, SocketUtils;
  25
  26 type
  27
  28    PRFCReply = ^TRFCReply;
  29    TRFCReply = class
  30    private
  31       FNumericCode: word;
  32       FReplyText: TStringList;
  33    public
  34       constructor Create;
  35       destructor Destroy; override;
  36       function Count: integer;
  37       function GetLine(n: integer): string;
  38       function GetNumericCode: word;
  39       procedure Add(Line: string);
  40       procedure Clear;
  41       procedure SetNumericCode(Code: word);
  42       procedure SetReply(NumericCode: word; Text: shortstring);
  43       property NumericCode: word read GetNumericCode;
  44       property ReplyText: TStringList read FReplyText;
  45    end;
  46
  47    function ReadCommand(Sock: socket; var Command: shortstring; var Prms: string): boolean;
  48    function ReadResponse(Sock: socket; Response: TRFCReply): boolean;
  49    function SendCommand(Sock: socket; Command: shortstring): boolean; overload;
  50    function SendCommand(Sock: socket; Command: shortstring; Prms: string): boolean; overload;
  51    function SendResponse(Sock: socket; Response: TRFCReply): boolean;
  52
  53
  54 implementation
  55
  56 constructor TRFCReply.Create;
  57 begin
  58    inherited Create;
  59    FNumericCode:= 0;
  60    FReplyText:= TStringList.Create;
  61    FReplyText.Clear;
  62 end;
  63
  64 destructor TRFCReply.Destroy;
  65 begin
  66    FReplyText.Free;
  67    inherited Destroy;
  68 end;
  69
  70 function TRFCReply.Count: integer;
  71 begin
  72    Count:= FReplyText.Count;
  73 end;
  74
  75 function TRFCReply.GetLine(n: integer): string;
  76 begin
  77    GetLine:= FReplyText.Strings[n];
  78 end;
  79
  80 function TRFCReply.GetNumericCode: word;
  81 begin
  82    GetNumericCode:= FNumericCode;
  83 end;
  84
  85 procedure TRFCReply.Add(Line: string);
  86 begin
  87    FReplyText.Add(Line);
  88 end;
  89
  90 procedure TRFCReply.Clear;
  91 begin
  92    SetNumericCode(0);
  93    FReplyText.Clear;
  94 end;
  95
  96 procedure TRFCReply.SetNumericCode(Code: word);
  97 begin
  98    FNumericCode:= Code;
  99 end;
 100
 101 procedure TRFCReply.SetReply(NumericCode: word; Text: shortstring);
 102 begin
 103    SetNumericCode(NumericCode);
 104    FReplyText.Clear;
 105    FReplyText.Add(Text);
 106 end;
 107
 108
 109 function ReadCommand(Sock: socket; var Command: shortstring; var Prms: string): boolean;
 110 var Line: string; i: integer;
 111 begin
 112    ReadCommand:= true;
 113    try
 114       if SockReadLn(Sock, Line) then begin
 115          i:= pos(#32, Line);
 116          if i > 0 then begin
 117             Command:= Copy(Line, 1, i - 1);
 118             Prms:= Copy(Line, i + 1, Length(Line) - i);
 119          end
 120          else begin
 121             Command:= Line;
 122             Prms:= '';
 123          end;
 124       end
 125       else ReadCommand:= false;
 126    except
 127       ReadCommand:= false;
 128    end;
 129 end;
 130
 131 function ReadResponse(Sock: socket; Response: TRFCReply): boolean;
 132 var Line: string; ReadOK: boolean;
 133 begin
 134    ReadResponse:= true;
 135    try
 136       Response.Clear;
 137       repeat
 138          ReadOK:= SockReadLn(Sock, Line);
 139          if ReadOK then Response.Add(Copy(Line, 5, Length(Line) - 4));
 140       until (Line[4] = #32) or (not ReadOK);
 141       if ReadOK then Response.SetNumericCode(StrToInt(Copy(Line, 1, 3)));
 142       ReadResponse:= ReadOK;
 143    except
 144       ReadResponse:= false;
 145    end;
 146 end;
 147
 148 function SendCommand(Sock: socket; Command: shortstring): boolean;
 149 begin
 150    try
 151       SendCommand:= SockWriteLn(Sock, Command);
 152    except
 153       SendCommand:= false;
 154    end;
 155 end;
 156
 157 function SendCommand(Sock: socket; Command: shortstring; Prms: string): boolean;
 158 begin
 159    try
 160       SendCommand:= SockWriteLn(Sock, Command + #32 + Prms);
 161    except
 162       SendCommand:= false;
 163    end;
 164 end;
 165
 166 function SendResponse(Sock: socket; Response: TRFCReply): boolean;
 167 var c, i: integer;
 168 begin
 169    try
 170       c:= Response.Count;
 171       if c > 0 then begin
 172          for i:= 0 to c - 2 do SockWriteLn(Sock, IntToStr(Response.GetNumericCode) + '-' + Response.GetLine(i));
 173          SendResponse:= SockWriteLn(Sock, IntToStr(Response.GetNumericCode) + #32 + Response.GetLine(c - 1));
 174       end;
 175    except
 176       SendResponse:= false;
 177    end;
 178 end;
 179
 180
 181 end.