units/indy/IdTCPConnection.pas

   1 // 27-nov-2002
   2 unit IdTCPConnection;
   3
   4 interface
   5
   6 uses KOL { ,
   7   Classes } {, IdException},
   8   IdComponent, IdGlobal, IdSocketHandle, IdIntercept;
   9
  10 const
  11   GRecvBufferSizeDefault = 32768;
  12   GSendBufferSizeDefault = 32768;
  13
  14 type
  15   TIdBuffer = object({TMemoryStream}TStream)
  16   public
  17     procedure RemoveXBytes(const AByteCount: integer);
  18     procedure Clear;
  19   end;
  20   PIdBuffer=^TIdBuffer;
  21
  22 type
  23
  24   TIdTCPConnection = object(TIdComponent)
  25   protected
  26     FASCIIFilter: boolean;
  27     FBinding: PIdSocketHandle;//TIdSocketHandle;
  28     FBuffer: PIdBuffer;//TIdBuffer;
  29     FClosedGracefully: boolean;
  30     FCmdResultDetails: PStrList;
  31     FIntercept: PIdConnectionIntercept;//TIdConnectionIntercept;
  32     FInterceptEnabled: Boolean;
  33     FOnDisconnected: TOnEvent;//TNotifyEvent;
  34     FReadLnTimedOut: Boolean;
  35     FRecvBuffer: PIdBuffer;//TIdBuffer;
  36     FResultNo: SmallInt;
  37     FSendBufferSize: Integer;
  38     FWriteBuffer: PIdBuffer;//TIdBuffer;
  39     FWriteBufferThreshhold: Integer;
  40     //
  41     procedure DoOnDisconnected; virtual;
  42     function GetCmdResult: string;
  43     function GetRecvBufferSize: Integer;
  44 //    procedure Notification(AComponent: PObj{TComponent}; Operation: TOperation);
  45 //      override;
  46     procedure ResetConnection; virtual;
  47     procedure SetIntercept(AValue: PIdConnectionIntercept{TIdConnectionIntercept});
  48     procedure SetInterceptEnabled(AValue: Boolean);
  49     procedure SetRecvBufferSize(const Value: Integer);
  50   public
  51     procedure Init; virtual;
  52     function AllData: string; virtual;
  53     procedure CancelWriteBuffer;
  54     procedure Capture(ADest: TObject; const ADelim: string = '.'; const
  55       AIsRFCMessage: Boolean = False);
  56     procedure CheckForDisconnect(const ARaiseExceptionIfDisconnected: boolean =
  57       true;
  58       const AIgnoreBuffer: boolean = false); virtual;
  59     procedure CheckForGracefulDisconnect(const ARaiseExceptionIfDisconnected:
  60       boolean = true);
  61       virtual;
  62     function CheckResponse(const AResponse: SmallInt; const AAllowedResponses:
  63       array of SmallInt)
  64       : SmallInt; virtual;
  65     procedure ClearWriteBuffer;
  66     procedure CloseWriteBuffer;
  67     function Connected: boolean; virtual;
  68      { constructor Create(AOwner: TComponent); override;
  69      } function CurrentReadBuffer: string;
  70     function CurrentReadBufferSize: integer;
  71     destructor Destroy;
  72      virtual; procedure Disconnect; virtual;
  73     procedure DisconnectSocket; virtual;
  74     function ExtractXBytesFromBuffer(const AByteCount: Integer): string;
  75       virtual;
  76     procedure FlushWriteBuffer(const AByteCount: Integer = -1);
  77     function GetResponse(const AAllowedResponses: array of SmallInt): SmallInt;
  78       virtual;
  79     function InputLn(const AMask: string = ''): string;
  80     procedure OpenWriteBuffer(const AThreshhold: Integer = -1);
  81     procedure RaiseExceptionForCmdResult; overload; virtual;
  82 //    procedure RaiseExceptionForCmdResult(axException: TClassIdException);
  83 //      overload; virtual;
  84     procedure ReadBuffer(var ABuffer; const AByteCount: Longint);
  85     function ReadCardinal(const AConvert: boolean = true): Cardinal;
  86         function ReadFromStack(const ARaiseExceptionIfDisconnected: boolean = true;
  87       const ATimeout: integer = IdTimeoutInfinite; const AUseBuffer: boolean =
  88         true;
  89       ADestStream: {T}PIdBuffer = nil): integer;
  90       virtual;
  91     function ReadInteger(const AConvert: boolean = true): Integer;
  92     function ReadLn(const ATerminator: string = '';
  93       const ATimeout: integer = IdTimeoutInfinite): string; virtual;
  94     function ReadLnWait: string;
  95     function ReadSmallInt(const AConvert: boolean = true): SmallInt;
  96     procedure ReadStream(AStream: PStream{TStream}; AByteCount: LongInt = -1;
  97       const AReadUntilDisconnect: boolean = false);
  98     function ReadString(const ABytes: integer): string;
  99     procedure RemoveXBytesFromBuffer(const AByteCount: Integer); virtual;
 100     function SendCmd(const AOut: string; const AResponse: SmallInt = -1):
 101       SmallInt; overload;
 102     function SendCmd(const AOut: string; const AResponse: array of SmallInt):
 103       SmallInt; overload;
 104       virtual;
 105     function WaitFor(const AString: string): string;
 106     procedure Write(AOut: string); virtual;
 107     procedure WriteBuffer(var{const} ABuffer; AByteCount: Longint; const AWriteNow:
 108       boolean = false);
 109     procedure WriteCardinal(AValue: Cardinal; const AConvert: boolean = true);
 110     procedure WriteHeader(axHeader: PStrList);
 111     procedure WriteInteger(AValue: Integer; const AConvert: boolean = true);
 112     procedure WriteLn(const AOut: string = ''); virtual;
 113     procedure WriteSmallInt(AValue: SmallInt; const AConvert: boolean = true);
 114     procedure WriteStream(AStream: PStream{TStream}; const AAll: boolean = true;
 115       const AWriteByteCount: Boolean = false); virtual;
 116     procedure WriteStrings(AValue: PStrList);
 117     function WriteFile(AFile: string; const AEnableTransferFile: boolean =
 118       false): cardinal;
 119       virtual;
 120
 121     property Binding: PIdSocketHandle{TIdSocketHandle} read FBinding;
 122     property ClosedGracefully: boolean read FClosedGracefully;
 123     property CmdResult: string read GetCmdResult;
 124     property CmdResultDetails: PStrList read FCmdResultDetails;
 125     property ReadLnTimedOut: Boolean read FReadLnTimedOut;
 126     property ResultNo: SmallInt read FResultNo;
 127    { published }
 128     property ASCIIFilter: boolean read FASCIIFilter write FASCIIFilter default
 129       False;
 130     property Intercept: PIdConnectionIntercept{TIdConnectionIntercept} read FIntercept write
 131       SetIntercept;
 132     property InterceptEnabled: Boolean read FInterceptEnabled write
 133       SetInterceptEnabled default False;
 134 //    property OnDisconnected: TNotifyEvent read FOnDisconnected write
 135 //      FOnDisconnected;
 136 //    property OnWork;
 137 //    property OnWorkBegin;
 138 //    property OnWorkEnd;
 139     property RecvBufferSize: Integer read GetRecvBufferSize write
 140       SetRecvBufferSize default GRecvBufferSizeDefault;
 141     property SendBufferSize: Integer read FSendBufferSize write FSendBufferSize
 142       default GSendBufferSizeDefault;
 143   end;
 144 PIdTCPConnection=^TIdTCPConnection;
 145 function NewIdBuffer:PIdBuffer;
 146 function NewIdTCPConnection(AOwner: {TComponent}PControl):PIdTCPConnection;
 147  {
 148   EIdTCPConnectionError = object(EIdException);
 149 PBuffer=^dBuffer; type  MyStupid86104=DWord;
 150   EIdObjectTypeNotSupported = object(EIdTCPConnectionError);
 151 Puffer=^Buffer; type  MyStupid20258=DWord;
 152   EIdNotEnoughDataInBuffer = object(EIdTCPConnectionError);
 153 Pffer=^uffer; type  MyStupid27292=DWord;
 154   EIdInterceptPropIsNil = object(EIdTCPConnectionError);
 155 Pfer=^ffer; type  MyStupid67165=DWord;
 156   EIdInterceptPropInvalid = object(EIdTCPConnectionError);
 157 Per=^fer; type  MyStupid31869=DWord;
 158   EIdNoDataToRead = object(EIdTCPConnectionError);
 159 Pr=^er; type  MyStupid16179=DWord;     }
 160
 161 implementation
 162
 163 uses
 164   IdAntiFreezeBase,
 165   IdStack, IdStackConsts, IdResourceStrings,
 166   SysUtils;
 167
 168 function NewIdBuffer:PIdBuffer;
 169 begin
 170 //  New( Result, Create );
 171   Result:=PIdBuffer(NewMemoryStream);//_NewStream(MemoryMethods);
 172 end;
 173
 174 function TIdTCPConnection.AllData: string;
 175 begin
 176   BeginWork(wmRead);
 177   try
 178     result := '';
 179     while Connected do
 180     begin
 181       Result := Result + CurrentReadBuffer;
 182     end;
 183   finally EndWork(wmRead);
 184   end;
 185 end;
 186
 187 procedure TIdTCPConnection.Capture(ADest: TObject; const ADelim: string = '.';
 188   const AIsRFCMessage: Boolean = False);
 189 var
 190   s: string;
 191 begin
 192   BeginWork(wmRead);
 193   try
 194     repeat
 195       s := ReadLn;
 196       if s = ADelim then
 197       begin
 198         exit;
 199       end;
 200
 201       if AIsRFCMessage and (Copy(s, 1, 2) = '..') then
 202       begin
 203         Delete(s, 1, 1);
 204       end;
 205
 206 {      if ADest is PStrList then
 207       begin
 208         PStrList(ADest).Add(s);
 209       end
 210       else
 211         if ADest is TStream then
 212       begin
 213         TStream(ADest).WriteBuffer(s[1], Length(s));
 214         s := EOL;
 215         TStream(ADest).WriteBuffer(s[1], Length(s));
 216       end
 217       else
 218         if ADest <> nil then
 219       begin
 220         raise EIdObjectTypeNotSupported.Create(RSObjectTypeNotSupported);
 221       end;}
 222     until false;
 223   finally EndWork(wmRead);
 224   end;
 225 end;
 226
 227 procedure TIdTCPConnection.CheckForDisconnect(const
 228   ARaiseExceptionIfDisconnected: boolean = true;
 229   const AIgnoreBuffer: boolean = false);
 230 begin
 231   if ClosedGracefully or (Binding.HandleAllocated = false) then
 232   begin
 233     if Binding.HandleAllocated then
 234     begin
 235       DisconnectSocket;
 236     end;
 237     if ((CurrentReadBufferSize = 0) or AIgnoreBuffer) and
 238       ARaiseExceptionIfDisconnected then
 239     begin
 240       (* ************************************************************* //
 241       ------ If you receive an exception here, please read. ----------
 242
 243       If this is a SERVER
 244       -------------------
 245       The client has disconnected the socket normally and this exception is used to notify the
 246       server handling code. This exception is normal and will only happen from within the IDE, not
 247       while your program is running as an EXE. If you do not want to see this, add this exception
 248       or EIdSilentException to the IDE options as exceptions not to break on.
 249
 250       From the IDE just hit F9 again and Indy will catch and handle the exception.
 251
 252       Please see the FAQ and help file for possible further information.
 253       The FAQ is at http://www.nevrona.com/Indy/FAQ.html
 254
 255       If this is a CLIENT
 256       -------------------
 257       The server side of this connection has disconnected normaly but your client has attempted
 258       to read or write to the connection. You should trap this error using a try..except.
 259       Please see the help file for possible further information.
 260
 261       // ************************************************************* *)
 262 //      raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
 263     end;
 264   end;
 265 end;
 266
 267 function TIdTCPConnection.Connected: boolean;
 268 begin
 269   CheckForDisconnect(False);
 270   result := Binding.HandleAllocated;
 271 end;
 272
 273 //constructor TIdTCPConnection.Create(AOwner: TComponent);
 274 function NewIdTCPConnection(AOwner: {TComponent}PControl):PIdTCPConnection;
 275 begin
 276 //  inherited;
 277   New( Result, Create );
 278   Result.Init;
 279 with Result^ do
 280 begin
 281 //  FBinding := TIdSocketHandle.Create(nil);
 282 //  FCmdResultDetails := PStrList.Create;
 283 //  FRecvBuffer := TIdBuffer.Create;
 284
 285 //  RecvBufferSize := GRecvBufferSizeDefault;
 286 //  FSendBufferSize := GSendBufferSizeDefault;
 287 //  FBuffer := TIdBuffer.Create;
 288 end;
 289 end;
 290
 291 procedure TIdTCPConnection.Init;
 292 begin
 293     inherited;
 294 //with Result^ do
 295 begin
 296   FBinding := NewIdSocketHandle(nil);//TIdSocketHandle.Create(nil);
 297   FCmdResultDetails := NewStrList;//PStrList.Create;
 298   FRecvBuffer := NewIdBuffer;//TIdBuffer.Create;
 299
 300   RecvBufferSize := GRecvBufferSizeDefault;
 301   FSendBufferSize := GSendBufferSizeDefault;
 302   FBuffer := NewIdBuffer;//TIdBuffer.Create;
 303 end;
 304 end;
 305
 306 function TIdTCPConnection.CurrentReadBuffer: string;
 307 begin
 308   result := '';
 309   if Connected then
 310   begin
 311     ReadFromStack(False);
 312     result := ExtractXBytesFromBuffer(FBuffer.Size);
 313   end;
 314 end;
 315
 316 function TIdTCPConnection.CurrentReadBufferSize: integer;
 317 begin
 318   result := FBuffer.Size;
 319 end;
 320
 321 destructor TIdTCPConnection.Destroy;
 322 begin
 323   FreeAndNil(FBuffer);
 324   FreeAndNil(FRecvBuffer);
 325   FreeAndNil(FCmdResultDetails);
 326   FreeAndNil(FBinding);
 327   inherited;
 328 end;
 329
 330 procedure TIdTCPConnection.Disconnect;
 331 begin
 332   DisconnectSocket;
 333 end;
 334
 335 procedure TIdTCPConnection.DoOnDisconnected;
 336 begin
 337 //  if assigned(OnDisconnected) then
 338   begin
 339 //    OnDisconnected(Self);
 340   end;
 341
 342 end;
 343
 344 function TIdTCPConnection.ExtractXBytesFromBuffer(const AByteCount: Integer):
 345   string;
 346 begin
 347   if AByteCount > FBuffer.Size then
 348   begin
 349 //    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
 350   end;
 351   SetString(result, PChar(FBuffer.Memory), AByteCount);
 352   RemoveXBytesFromBuffer(AByteCount);
 353 end;
 354
 355 function TIdTCPConnection.GetCmdResult: string;
 356 begin
 357   result := '';
 358   if CmdResultDetails.Count > 0 then
 359   begin
 360     result := CmdResultDetails.Items[CmdResultDetails.Count - 1];
 361   end;
 362 end;
 363
 364 function TIdTCPConnection.GetRecvBufferSize: Integer;
 365 begin
 366   result := FRecvBuffer.Size;
 367 end;
 368
 369 function TIdTCPConnection.GetResponse(const AAllowedResponses: array of
 370   SmallInt): SmallInt;
 371 var
 372   sLine, sTerm: string;
 373 begin
 374   CmdResultDetails.Clear;
 375   sLine := ReadLnWait;
 376   CmdResultDetails.Add(sLine);
 377   if length(sLine) > 3 then
 378   begin
 379     if sLine[4] = '-' then
 380     begin
 381       sTerm := Copy(sLine, 1, 3) + ' ';
 382       repeat
 383         sLine := ReadLnWait;
 384         CmdResultDetails.Add(sLine);
 385       until (Length(sLine) < 4) or (AnsiSameText(Copy(sLine, 1, 4), sTerm));
 386     end;
 387   end;
 388
 389   if AnsiSameText(Copy(CmdResult, 1, 3), '+OK') then
 390   begin
 391     FResultNo := wsOK;
 392   end
 393   else
 394     if AnsiSameText(Copy(CmdResult, 1, 4), '-ERR') then
 395   begin
 396     FResultNo := wsErr;
 397   end
 398   else
 399   begin
 400     FResultNo := StrToIntDef(Copy(CmdResult, 1, 3), 0);
 401   end;
 402
 403   Result := CheckResponse(ResultNo, AAllowedResponses);
 404 end;
 405
 406 {procedure TIdTCPConnection.RaiseExceptionForCmdResult(axException:
 407   TClassIdException);
 408 begin
 409 //  raise axException.Create(CmdResult);
 410 end;
 411 }
 412
 413 procedure TIdTCPConnection.RaiseExceptionForCmdResult;
 414 begin
 415 //  raise EIdProtocolReplyError.CreateError(ResultNo, CmdResult);
 416 end;
 417
 418 procedure TIdTCPConnection.ReadBuffer(var ABuffer; const AByteCount: Integer);
 419 begin
 420   if (AByteCount > 0) and (@ABuffer <> nil) then
 421   begin
 422     while CurrentReadBufferSize < AByteCount do
 423     begin
 424       ReadFromStack;
 425     end;
 426     Move(PChar(FBuffer.Memory)[0], ABuffer, AByteCount);
 427     RemoveXBytesFromBuffer(AByteCount);
 428   end;
 429 end;
 430
 431 function TIdTCPConnection.ReadFromStack(const ARaiseExceptionIfDisconnected:
 432   boolean = true;
 433   const ATimeout: integer = IdTimeoutInfinite; const AUseBuffer: boolean = true;
 434   ADestStream: {T}PIdBuffer = nil): integer;
 435 var
 436   nByteCount, j: Integer;
 437
 438   procedure DefaultRecv;
 439   begin
 440     nByteCount := Binding.Recv(ADestStream.Memory^, ADestStream.Size, 0);
 441   end;
 442
 443 begin
 444   result := 0;
 445   CheckForDisconnect(ARaiseExceptionIfDisconnected);
 446   if Connected then
 447   begin
 448     if ADestStream = nil then
 449     begin
 450       ADestStream := FRecvBuffer;
 451     end;
 452     if Binding.Readable(ATimeout) then
 453     begin
 454       if InterceptEnabled then
 455       begin
 456         if Intercept.RecvHandling then
 457         begin
 458           nByteCount := Intercept.Recv(ADestStream.Memory^, ADestStream.Size);
 459         end
 460         else
 461         begin
 462           DefaultRecv;
 463         end;
 464       end
 465       else
 466       begin
 467         DefaultRecv;
 468       end;
 469
 470       FClosedGracefully := nByteCount = 0;
 471       if not ClosedGracefully then
 472       begin
 473         if GStack.CheckForSocketError(nByteCount, [Id_WSAESHUTDOWN]) then
 474         begin
 475           nByteCount := 0;
 476           if Binding.HandleAllocated then
 477           begin
 478             DisconnectSocket;
 479           end;
 480           if CurrentReadBufferSize = 0 then
 481           begin
 482             GStack.RaiseSocketError(Id_WSAESHUTDOWN);
 483           end;
 484         end;
 485         if ASCIIFilter then
 486         begin
 487           for j := 1 to nByteCount do
 488           begin
 489             PChar(ADestStream.Memory)[j] := Chr(Ord(PChar(ADestStream.Memory)[j])
 490               and $7F);
 491           end;
 492         end;
 493       end;
 494       if AUseBuffer then
 495       begin
 496         FBuffer.Position := FBuffer.Size;
 497         FBuffer.Write{Buffer}(ADestStream.Memory^, nByteCount);
 498       end
 499       else
 500       begin
 501         DoWork(wmRead, nByteCount);
 502       end;
 503       if InterceptEnabled then
 504       begin
 505         Intercept.DataReceived(ADestStream.Memory^, nByteCount);
 506       end;
 507       CheckForDisconnect(ARaiseExceptionIfDisconnected);
 508       result := nByteCount;
 509     end;
 510   end;
 511 end;
 512
 513 function TIdTCPConnection.ReadInteger(const AConvert: boolean = true): Integer;
 514 begin
 515   ReadBuffer(Result, SizeOf(Result));
 516   if AConvert then
 517   begin
 518     Result := Integer(GStack.WSNToHL(LongWord(Result)));
 519   end;
 520 end;
 521
 522 function TIdTCPConnection.ReadLn(const ATerminator: string = '';
 523   const ATimeout: integer = IdTimeoutInfinite): string;
 524 var
 525   i: Integer;
 526   s: string;
 527   LTerminator: string;
 528 begin
 529   if Length(ATerminator) = 0 then
 530   begin
 531     LTerminator := LF;
 532   end
 533   else
 534   begin
 535     LTerminator := ATerminator;
 536   end;
 537   FReadLnTimedOut := False;
 538   i := 0;
 539   repeat
 540     if CurrentReadBufferSize > 0 then
 541     begin
 542       SetString(s, PChar(FBuffer.Memory), FBuffer.Size);
 543       i := Pos(LTerminator, s);
 544     end;
 545     if i = 0 then
 546     begin
 547       CheckForDisconnect(True, True);
 548       FReadLnTimedOut := ReadFromStack(True, ATimeout) = 0;
 549       if ReadLnTimedout then
 550       begin
 551         result := '';
 552         exit;
 553       end;
 554     end;
 555   until i > 0;
 556   Result := ExtractXBytesFromBuffer(i + Length(LTerminator) - 1);
 557   SetLength(Result, i - 1);
 558   if (Length(ATerminator) = 0) and (Copy(Result, Length(Result), 1) = CR) then
 559   begin
 560     SetLength(Result, Length(Result) - 1);
 561   end;
 562 end;
 563
 564 function TIdTCPConnection.ReadLnWait: string;
 565 begin
 566   Result := '';
 567   while length(Result) = 0 do
 568   begin
 569     Result := Trim(ReadLn);
 570   end;
 571 end;
 572
 573 procedure TIdTCPConnection.ReadStream(AStream: PStream{TStream}; AByteCount: Integer =
 574   -1;
 575   const AReadUntilDisconnect: boolean = false);
 576 var
 577   i: integer;
 578   LBuffer:PIdBuffer;// TIdBuffer;
 579   LBufferCount: integer;
 580   LWorkCount: integer;
 581
 582   procedure AdjustStreamSize(AStream: PStream{TStream}; const ASize: integer);
 583   var
 584     LStreamPos: LongInt;
 585   begin
 586     LStreamPos := AStream.Position;
 587     AStream.Size := ASize;
 588     if AStream.Position <> LStreamPos then
 589     begin
 590       AStream.Position := LStreamPos;
 591     end;
 592   end;
 593
 594 begin
 595   if (AByteCount = -1) and (AReadUntilDisconnect = False) then
 596   begin
 597     AByteCount := ReadInteger;
 598   end;
 599   if AByteCount > -1 then
 600   begin
 601     AdjustStreamSize(AStream, AStream.Position + AByteCount);
 602   end;
 603
 604   if AReadUntilDisconnect then
 605   begin
 606     LWorkCount := High(LWorkCount);
 607     BeginWork(wmRead);
 608   end
 609   else
 610   begin
 611     LWorkCount := AByteCount;
 612     BeginWork(wmRead, LWorkCount);
 613   end;
 614   try
 615     LBufferCount := Min(CurrentReadBufferSize, LWorkCount);
 616     Dec(LWorkCount, LBufferCount);
 617     AStream.Write{Buffer}(FBuffer.Memory^, LBufferCount);
 618     FBuffer.RemoveXBytes(LBufferCount);
 619
 620     LBuffer := NewIdBuffer();//TIdBuffer.Create;
 621     try
 622       while Connected and (LWorkCount > 0) do
 623       begin
 624         i := Min(LWorkCount, RecvBufferSize);
 625         if LBuffer.Size <> i then
 626         begin
 627           LBuffer.Size := i;
 628         end;
 629         i := ReadFromStack(not AReadUntilDisconnect, IdTimeoutInfinite, False,
 630           LBuffer);
 631         if AStream.Position + i > AStream.Size then
 632         begin
 633           AdjustStreamSize(AStream, AStream.Size + 4 * CurrentReadBufferSize);
 634         end;
 635         AStream.Write{Buffer}(LBuffer.Memory^, i);
 636         Dec(LWorkCount, i);
 637       end;
 638     finally LBuffer.Free;
 639     end;
 640   finally EndWork(wmRead);
 641   end;
 642   if AStream.Size > AStream.Position then
 643   begin
 644     AStream.Size := AStream.Position;
 645   end;
 646 end;
 647
 648 procedure TIdTCPConnection.RemoveXBytesFromBuffer(const AByteCount: Integer);
 649 begin
 650   FBuffer.RemoveXBytes(AByteCount);
 651   DoWork(wmRead, AByteCount);
 652 end;
 653
 654 procedure TIdTCPConnection.ResetConnection;
 655 begin
 656   Binding.Reset;
 657   FBuffer.Clear;
 658   FClosedGracefully := False;
 659 end;
 660
 661 function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: array of
 662   SmallInt): SmallInt;
 663 begin
 664   if AOut <> #0 then
 665   begin
 666     WriteLn(AOut);
 667   end;
 668   Result := GetResponse(AResponse);
 669 end;
 670
 671 {procedure TIdTCPConnection.Notification(AComponent: TComponent; Operation:
 672   TOperation);
 673 begin
 674   inherited;
 675   if (Operation = opRemove) then
 676   begin
 677     if (AComponent = FIntercept) then
 678     begin
 679       Intercept := nil;
 680     end;
 681   end;
 682 end;}
 683
 684 procedure TIdTCPConnection.SetIntercept(AValue: PIdConnectionIntercept{TIdConnectionIntercept});
 685 begin
 686   FIntercept := AValue;
 687   if FIntercept = nil then
 688   begin
 689     FInterceptEnabled := false;
 690   end
 691   else
 692   begin
 693     if assigned(FIntercept) then
 694     begin
 695 //      FIntercept.FreeNotification(self);
 696     end;
 697   end;
 698 end;
 699
 700 procedure TIdTCPConnection.SetInterceptEnabled(AValue: Boolean);
 701 begin
 702 {  if (Intercept = nil) and (not (csLoading in ComponentState)) and AValue then
 703   begin
 704     raise EIdInterceptPropIsNil.Create(RSInterceptPropIsNil);
 705   end;}
 706   FInterceptEnabled := AValue;
 707 end;
 708
 709 procedure TIdTCPConnection.SetRecvBufferSize(const Value: Integer);
 710 begin
 711   FRecvBuffer.Size := Value;
 712 end;
 713
 714 procedure TIdTCPConnection.Write(AOut: string);
 715 begin
 716   if Length(AOut) > 0 then
 717   begin
 718     WriteBuffer(AOut[1], length(AOut));
 719   end;
 720 end;
 721
 722 procedure TIdTCPConnection.WriteBuffer(var{const} ABuffer; AByteCount: Integer;
 723   const AWriteNow: boolean = false);
 724 var
 725   nPos, nByteCount: Integer;
 726
 727   procedure DefaultSend;
 728   begin
 729     nByteCount := Binding.Send(PChar(@ABuffer)[nPos - 1], AByteCount - nPos + 1,
 730       0);
 731 //    TIdAntiFreezeBase.DoProcess(False);
 732   end;
 733
 734 begin
 735   if (AByteCount > 0) and (@ABuffer <> nil) then
 736   begin
 737     CheckForDisconnect(True, True);
 738
 739     if (FWriteBuffer = nil) or AWriteNow then
 740     begin
 741       nPos := 1;
 742       repeat
 743         if InterceptEnabled then
 744         begin
 745           if Intercept.SendHandling then
 746           begin
 747             nByteCount := Intercept.Send(PChar(@ABuffer)[nPos - 1], AByteCount -
 748               nPos + 1);
 749           end
 750           else
 751           begin
 752             DefaultSend;
 753           end;
 754         end
 755         else
 756         begin
 757           DefaultSend;
 758         end;
 759         FClosedGracefully := nByteCount = 0;
 760         CheckForDisconnect;
 761         if GStack.CheckForSocketError(nByteCount, [ID_WSAESHUTDOWN]) then
 762         begin
 763           DisconnectSocket;
 764           GStack.RaiseSocketError(ID_WSAESHUTDOWN);
 765         end;
 766         DoWork(wmWrite, nByteCount);
 767         if InterceptEnabled then
 768         begin
 769           Intercept.DataSent(PChar(@ABuffer)[nPos - 1], AByteCount - nPos + 1);
 770         end;
 771         nPos := nPos + nByteCount
 772       until nPos > AByteCount;
 773     end
 774     else
 775     begin
 776       FWriteBuffer.Write{Buffer}(ABuffer, AByteCount);
 777       if (FWriteBuffer.Size >= FWriteBufferThreshhold) and
 778         (FWriteBufferThreshhold > 0) then
 779       begin
 780         FlushWriteBuffer(FWriteBufferThreshhold);
 781       end;
 782     end;
 783   end;
 784 end;
 785
 786 function TIdTCPConnection.WriteFile(AFile: string; const AEnableTransferFile:
 787   boolean = false)
 788   : cardinal;
 789 var
 790   LFileStream: PStream;//TFileStream;
 791 begin
 792   if assigned(GServeFileProc) and (InterceptEnabled = false) and
 793     AEnableTransferFile then
 794   begin
 795     result := GServeFileProc(Binding.Handle, AFile);
 796   end
 797   else
 798   begin
 799     LFileStream := NewFileStream(AFile, fmOpenRead or fmShareDenyNone {???} or ofOpenAlways {???});//TFileStream.Create(AFile, fmOpenRead or fmShareDenyNone);
 800     try
 801       WriteStream(LFileStream);
 802       result := LFileStream.Size;
 803     finally LFileStream.free;
 804     end;
 805   end;
 806 end;
 807
 808 procedure TIdTCPConnection.WriteHeader(axHeader: PStrList);
 809 var
 810   i: Integer;
 811 begin
 812   for i := 0 to axHeader.Count - 1 do
 813   begin
 814     WriteLn(StringReplace(axHeader.Items[i], '=', ': ', []));
 815   end;
 816   WriteLn('');
 817 end;
 818
 819 procedure TIdTCPConnection.WriteInteger(AValue: Integer; const AConvert: boolean
 820   = true);
 821 begin
 822   if AConvert then
 823   begin
 824     AValue := Integer(GStack.WSHToNl(LongWord(AValue)));
 825   end;
 826   WriteBuffer(AValue, SizeOf(AValue));
 827 end;
 828
 829 procedure TIdTCPConnection.WriteLn(const AOut: string = '');
 830 begin
 831   Write(AOut + EOL);
 832 end;
 833
 834 procedure TIdTCPConnection.WriteStream(AStream: PStream{TStream}; const AAll: boolean =
 835   true;
 836   const AWriteByteCount: Boolean = false);
 837 var
 838   LSize: integer;
 839   LBuffer: PStream;//TMemoryStream;
 840 begin
 841   if AAll then
 842   begin
 843     AStream.Position := 0;
 844   end;
 845   LSize := AStream.Size - AStream.Position;
 846   if AWriteByteCount then
 847   begin
 848     WriteInteger(LSize);
 849   end;
 850   BeginWork(wmWrite, LSize);
 851   try
 852     LBuffer := NewMemoryStream;//TMemoryStream.Create;
 853     try
 854       LBuffer.Size:=FSendBufferSize;//SetSize(FSendBufferSize);
 855       while true do
 856       begin
 857         LSize := Min(AStream.Size - AStream.Position, FSendBufferSize);
 858         if LSize = 0 then
 859         begin
 860           Break;
 861         end;
 862         LSize := AStream.Read(LBuffer.Memory^, LSize);
 863         if LSize = 0 then
 864         begin
 865 //          raise EIdNoDataToRead.Create(RSIdNoDataToRead);
 866         end;
 867         WriteBuffer(LBuffer.Memory^, LSize);
 868       end;
 869     finally FreeAndNil(LBuffer);
 870     end;
 871   finally EndWork(wmWrite);
 872   end;
 873 end;
 874
 875 procedure TIdTCPConnection.WriteStrings(AValue: PStrList);
 876 var
 877   i: Integer;
 878 begin
 879   for i := 0 to AValue.Count - 1 do
 880   begin
 881     WriteLn(AValue.{Strings}Items[i]);
 882   end;
 883 end;
 884
 885 function TIdTCPConnection.SendCmd(const AOut: string; const AResponse:
 886   SmallInt): SmallInt;
 887 begin
 888   if AResponse = -1 then
 889   begin
 890     result := SendCmd(AOut, []);
 891   end
 892   else
 893   begin
 894     result := SendCmd(AOut, [AResponse]);
 895   end;
 896 end;
 897
 898 procedure TIdTCPConnection.DisconnectSocket;
 899 begin
 900   if Binding.HandleAllocated then
 901   begin
 902     DoStatus(hsDisconnecting, [Binding.PeerIP]);
 903     Binding.CloseSocket;
 904     FClosedGracefully := True;
 905     DoStatus(hsDisconnected, [Binding.PeerIP]);
 906     DoOnDisconnected;
 907   end;
 908   if InterceptEnabled then
 909   begin
 910     Intercept.Disconnect;
 911   end;
 912 end;
 913
 914 procedure TIdTCPConnection.OpenWriteBuffer(const AThreshhold: Integer = -1);
 915 begin
 916   FWriteBuffer := NewIdBuffer;//TIdBuffer.Create;
 917   FWriteBufferThreshhold := AThreshhold;
 918 end;
 919
 920 procedure TIdTCPConnection.CloseWriteBuffer;
 921 begin
 922   FlushWriteBuffer;
 923   FreeAndNil(FWriteBuffer);
 924 end;
 925
 926 procedure TIdTCPConnection.FlushWriteBuffer(const AByteCount: Integer = -1);
 927 begin
 928   if FWriteBuffer.Size > 0 then
 929   begin
 930     if (AByteCount = -1) or (FWriteBuffer.Size < AByteCount) then
 931     begin
 932       WriteBuffer(PChar(FWriteBuffer.Memory)[0], FWriteBuffer.Size, True);
 933       ClearWriteBuffer;
 934     end
 935     else
 936     begin
 937       WriteBuffer(PChar(FWriteBuffer.Memory)[0], AByteCount, True);
 938       FWriteBuffer.RemoveXBytes(AByteCount);
 939     end;
 940   end;
 941 end;
 942
 943 procedure TIdTCPConnection.ClearWriteBuffer;
 944 begin
 945   FWriteBuffer.Clear;
 946 end;
 947
 948 function TIdTCPConnection.InputLn(const AMask: string = ''): string;
 949 var
 950   s: string;
 951 begin
 952   result := '';
 953   while true do
 954   begin
 955     s := ReadString(1);
 956     if s = BACKSPACE then
 957     begin
 958       if length(result) > 0 then
 959       begin
 960         SetLength(result, Length(result) - 1);
 961         Write(BACKSPACE);
 962       end;
 963     end
 964     else
 965       if s = CR then
 966     begin
 967       ReadString(1);
 968       WriteLn;
 969       exit;
 970     end
 971     else
 972     begin
 973       result := result + s;
 974       if Length(AMask) = 0 then
 975       begin
 976         Write(s);
 977       end
 978       else
 979       begin
 980         Write(AMask);
 981       end;
 982     end;
 983   end;
 984 end;
 985
 986 function TIdTCPConnection.ReadString(const ABytes: integer): string;
 987 begin
 988   SetLength(result, ABytes);
 989   if ABytes > 0 then
 990   begin
 991     ReadBuffer(Result[1], Length(Result));
 992   end;
 993 end;
 994
 995 procedure TIdTCPConnection.CancelWriteBuffer;
 996 begin
 997   ClearWriteBuffer;
 998   CloseWriteBuffer;
 999 end;
1000
1001 function TIdTCPConnection.ReadSmallInt(const AConvert: boolean = true):
1002   SmallInt;
1003 begin
1004   ReadBuffer(Result, SizeOf(Result));
1005   if AConvert then
1006   begin
1007     Result := SmallInt(GStack.WSNToHs(Word(Result)));
1008   end;
1009 end;
1010
1011 procedure TIdTCPConnection.WriteSmallInt(AValue: SmallInt; const AConvert:
1012   boolean = true);
1013 begin
1014   if AConvert then
1015   begin
1016     AValue := SmallInt(GStack.WSHToNs(Word(AValue)));
1017   end;
1018   WriteBuffer(AValue, SizeOf(AValue));
1019 end;
1020
1021 procedure TIdTCPConnection.CheckForGracefulDisconnect(
1022   const ARaiseExceptionIfDisconnected: boolean);
1023 begin
1024   ReadFromStack(ARaiseExceptionIfDisconnected, 1);
1025 end;
1026
1027 procedure TIdBuffer.Clear;
1028 begin
1029   Size:=0;
1030   Position:=0;
1031 end;
1032
1033 procedure TIdBuffer.RemoveXBytes(const AByteCount: integer);
1034 begin
1035   if AByteCount > Size then
1036   begin
1037 //    raise EIdNotEnoughDataInBuffer.Create(RSNotEnoughDataInBuffer);
1038   end;
1039   if AByteCount = Size then
1040   begin
1041     Clear;
1042   end
1043   else
1044   begin
1045     Move(PChar(Memory)[AByteCount], PChar(Memory)[0], Size - AByteCount);
1046     SetSize(Size - AByteCount);
1047   end;
1048 end;
1049
1050 function TIdTCPConnection.WaitFor(const AString: string): string;
1051 begin
1052   result := '';
1053   while Pos(AString, result) = 0 do
1054   begin
1055     Result := Result + CurrentReadBuffer;
1056     CheckForDisconnect;
1057   end;
1058 end;
1059
1060 function TIdTCPConnection.ReadCardinal(const AConvert: boolean): Cardinal;
1061 begin
1062   ReadBuffer(Result, SizeOf(Result));
1063   if AConvert then
1064   begin
1065     Result := GStack.WSNToHL(Result);
1066   end;
1067 end;
1068
1069 procedure TIdTCPConnection.WriteCardinal(AValue: Cardinal; const AConvert:
1070   boolean);
1071 begin
1072   if AConvert then
1073   begin
1074     AValue := GStack.WSHToNl(AValue);
1075   end;
1076   WriteBuffer(AValue, SizeOf(AValue));
1077 end;
1078
1079 function TIdTCPConnection.CheckResponse(const AResponse: SmallInt;
1080   const AAllowedResponses: array of SmallInt): SmallInt;
1081 var
1082   i: integer;
1083   LResponseFound: boolean;
1084 begin
1085   if High(AAllowedResponses) > -1 then
1086   begin
1087     LResponseFound := False;
1088     for i := Low(AAllowedResponses) to High(AAllowedResponses) do
1089     begin
1090       if AResponse = AAllowedResponses[i] then
1091       begin
1092         LResponseFound := True;
1093         Break;
1094       end;
1095     end;
1096     if not LResponseFound then
1097     begin
1098       RaiseExceptionForCmdResult;
1099     end;
1100   end;
1101   Result := AResponse;
1102 end;
1103
1104 end.