idiohandler.pas

网络控件适用于Delphi6

  i: Integer;
  LBuf: TIdBytes;
  LBufSize: Integer;
  LWorkCount: Integer;

  procedure AdjustStreamSize(AStream: TIdStreamVCL; ASize: Integer);
  var
    LStreamPos: LongInt;
  begin
    LStreamPos := AStream.VCLStream.Position;
    AStream.VCLStream.Size := ASize;
    // Must reset to original size as in some cases size changes position
    if AStream.VCLStream.Position <> LStreamPos then begin
      AStream.VCLStream.Position := LStreamPos;
    end;
  end;

begin
  if (AByteCount = -1) and (AReadUntilDisconnect = False) then begin
    // Read size from connection
    AByteCount := ReadInteger;
  end;
  // Presize stream if we know the size - this reduces memory/disk allocations to one time
  if AByteCount > -1 then begin
    AdjustStreamSize(AStream, AStream.VCLStream.Position + AByteCount);
  end;

  if AReadUntilDisconnect then begin
    LWorkCount := High(LWorkCount);
    BeginWork(wmRead);
  end else begin
    LWorkCount := AByteCount;
    BeginWork(wmRead, LWorkCount);
  end;

  try
    // If data already exists in the buffer, write it out first.
    if FInputBuffer.Size > 0 then begin
      i := Min(FInputBuffer.Size, LWorkCount);
      FInputBuffer.ExtractToStream(AStream, i);
      Dec(LWorkCount, i);
    end;

    LBufSize := Min(LWorkCount, RecvBufferSize);
    while Connected and (LWorkCount > 0) do begin
      i := Min(LWorkCount, LBufSize);
      //TODO: Improve this - dont like the use of the exception handler
      //DONE -oAPR: Dont use a string, use a memory buffer or better yet the buffer itself.
      try
        try
          SetLength(LBuf, 0); // clear the buffer
          ReadBytes(LBuf, i, False);
        except
          on E: Exception do begin
            // RLebeau - ReadFromSource() inside of ReadBytes()
            // could have filled the InputBuffer with more bytes
            // than actually requested, so don't extract too
            // many bytes here...
            i := Min(i, FInputBuffer.Size);
            FInputBuffer.ExtractToBytes(LBuf, i);
            if (E is EIdConnClosedGracefully) and AReadUntilDisconnect then begin
              break;
            end else begin
              raise;
            end;
          end;
        end;
      finally
        if i > 0 then begin
          AStream.Write(LBuf, i);
          Dec(LWorkCount, i);
        end;
      end;
    end;
  finally
    EndWork(wmRead);
    if AStream.VCLStream.Size > AStream.VCLStream.Position then begin
      AStream.VCLStream.Size := AStream.VCLStream.Position;
    end;
    LBuf := NIL;
  end;
end;

procedure TIdIOHandler.RaiseConnClosedGracefully;
begin
  (* ************************************************************* //
  ------ If you receive an exception here, please read. ----------

  If this is a SERVER
  -------------------
  The client has disconnected the socket normally and this exception is used to notify the
  server handling code. This exception is normal and will only happen from within the IDE, not
  while your program is running as an EXE. If you do not want to see this, add this exception
  or EIdSilentException to the IDE options as exceptions not to break on.

  From the IDE just hit F9 again and Indy will catch and handle the exception.

  Please see the FAQ and help file for possible further information.
  The FAQ is at http://www.nevrona.com/Indy/FAQ.html

  If this is a CLIENT
  -------------------
  The server side of this connection has disconnected normaly but your client has attempted
  to read or write to the connection. You should trap this error using a try..except.
  Please see the help file for possible further information.

  // ************************************************************* *)
  raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
end;

function TIdIOHandler.InputBufferAsString: string;
begin
  Result := FInputBuffer.Extract(FInputBuffer.Size);
end;

function TIdIOHandler.AllData: string;
begin
  BeginWork(wmRead); try
    Result := '';
    while Connected do begin
      CheckForDataOnSource(250);
      if not InputBufferIsEmpty then begin
        Result := Result + InputBufferAsString;
      end;
    end;
  finally EndWork(wmRead); end;
end;

procedure TIdIOHandler.PerformCapture(ADest: TObject;
 out VLineCount: Integer; const ADelim: string;
AIsRFCMessage: Boolean);
var
  s: string;
  LStream: TIdStreamVCL;
  LStrings: TIdStrings;
begin
  VLineCount := 0;

  LStream := nil;
  LStrings := nil;
  try
    if ADest is TIdStrings then begin
      LStrings := TIdStrings(ADest);
    end else if ADest is TStream then begin
      LStream := TIdStreamVCL.Create(TStream(ADest));
    end else begin
      EIdObjectTypeNotSupported.Toss(RSObjectTypeNotSupported);
    end;

    BeginWork(wmRead); try
      repeat
        s := ReadLn;
        if s = ADelim then begin
          Exit;
        end;
        // S.G. 6/4/2004: All the consumers to protect themselves against memory allocation attacks
        if FMaxCapturedLines > 0 then  begin
          if VLineCount > FMaxCapturedLines then begin
            raise EIdMaxCaptureLineExceeded.Create(RSMaximumNumberOfCaptureLineExceeded);
          end;
        end;
        // For RFC 822 retrieves
        // No length check necessary, if only one byte it will be byte x + #0.
        if AIsRFCMessage and (Copy(s, 1, 2) = '..') then begin
          Delete(s, 1, 1);
        end;
        // Write to output
        Inc(VLineCount);
        if LStrings <> nil then begin
          LStrings.Add(s);
        end else if LStream <> nil then begin
          LStream.WriteLn(s);
        end;
      until False;
    finally EndWork(wmRead); end;
  finally
    if LStream <> nil then begin
      FreeAndNil(LStream);
    end;
  end;
end;

function TIdIOHandler.InputLn(const AMask: String; AEcho: Boolean;
  ATabWidth, AMaxLineLength: Integer): String;
var
  i: Integer;
  LChar: Char;
  LTmp: string;
begin
  if AMaxLineLength = -1 then begin
    AMaxLineLength := MaxLineLength;
  end;
  Result := '';
  repeat
    LChar := ReadChar;
    i := Length(Result);
    if i <= AMaxLineLength then begin
      case LChar of
        BACKSPACE:
          begin
            if i > 0 then begin
              SetLength(Result, i - 1);
              if AEcho then begin
                Write(BACKSPACE + ' ' + BACKSPACE);
              end;
            end;
          end;
        TAB:
          begin
            if ATabWidth > 0 then begin
              i := ATabWidth - (i mod ATabWidth);
              LTmp := StringOfChar(' ', i);
              Result := Result + LTmp;
              if AEcho then begin
                Write(LTmp);
              end;
            end else begin
              Result := Result + LChar;
              if AEcho then begin
                Write(LChar);
              end;
            end;
          end;
        LF: ;
        CR: ;
        #27: ; //ESC - currently not supported
      else
        Result := Result + LChar;
        if AEcho then begin
          if Length(AMask) = 0 then begin
            Write(LChar);
          end else begin
            Write(AMask);
          end;
        end;
      end;
    end;
  until LChar = LF;
  // Remove CR trail
  i := Length(Result);
  while (i > 0) and ((Result[i] = CR) or (Result[1] = LF)) do begin
    Dec(i);
  end;
  SetLength(Result, i);
  if AEcho then begin
    WriteLn;
  end;
end;

function TIdIOHandler.WaitFor(const AString: string): string;
//TODO: Add a time out (default to infinite) and event to pass data
//TODO: Add a max size argument as well.
//TODO: Add a case insensitive option
//TODO: Bug - returns too much data. Should only return up to search string adn not including
//      and leave the rest in the buffer.
begin
  Result := '';
  // NOTE: AnsiPos should be used here, but AnsiPos has problems if result has
  // any #0 in it, which is often the case. So currently this function is not
  // MBCS compliant and should not be used in MBCS environments. However this
  // function should only be used on incoming TCP text data as it is 7 bit
  // anyways.
  while Pos(AString, Result) = 0 do begin
    CheckForDataOnSource;
    Result := Result + InputBufferAsString;
    CheckForDisconnect;
  end;
end;

procedure TIdIOHandler.Capture(ADest: TStream; out VLineCount: Integer;
  const ADelim: string; AIsRFCMessage: Boolean);
begin
  PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdIOHandler.Capture(ADest: TStream; ADelim: string;
  AIsRFCMessage: Boolean);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdIOHandler.Capture(ADest: TIdStrings; out VLineCount: Integer;
  const ADelim: string; AIsRFCMessage: Boolean);
begin
  PerformCapture(ADest, VLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdIOHandler.Capture(ADest: TIdStrings; const ADelim: string;
  AIsRFCMessage: Boolean);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, ADelim, AIsRFCMessage);
end;

procedure TIdIOHandler.InputBufferToStream(AStream: TIdStreamVCL; AByteCount: Integer = -1);
begin
  FInputBuffer.ExtractToStream(AStream, AByteCount);
end;

function TIdIOHandler.InputBufferIsEmpty: Boolean;
begin
  if FInputBuffer = nil then begin
    Result := True;
  end else begin
    Result := FInputBuffer.Size = 0;
  end;
end;

procedure TIdIOHandler.Write(
  ABuffer: TIdBytes
  );
begin
  if Length(ABuffer) > 0 then begin
    if FWriteBuffer = nil then begin
      WriteDirect(ABuffer);
    // Write Buffering is enabled
    end else begin
      FWriteBuffer.Write(ABuffer);
      if (FWriteBuffer.Size >= WriteBufferThreshhold)
       and (WriteBufferThreshhold > 0) then begin
        // TODO: Maybe? instead of flushing - Write until buffer is smaller than
        // Threshold.
        // That is do at least one physical send.
        WriteBufferFlush(WriteBufferThreshhold);
      end;
    end;
  end;
end;

function TIdIOHandler.WriteFile(const AFile: String; AEnableTransferFile: Boolean): Cardinal;
var
//TODO: There is a way in linux to dump a file to a socket as well. use it.
  LStream: TStream;
  LIdStream: TIdStreamVCL;
begin
  EIdFileNotFound.IfFalse(FileExists(AFile), Format(RSFileNotFound, [AFile]));
  LStream := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite); try
    LIdStream := TIdStreamVCL.Create(LStream); try
      Write(LIdStream);
      Result := LIdStream.VCLStream.Size;
    finally FreeAndNil(LIdStream); end;
  finally FreeAndNil(LStream); end;
end;

function TIdIOHandler.WriteBufferingActive: Boolean;
begin
  Result := FWriteBuffer <> nil;
end;

procedure TIdIOHandler.CloseGracefully;
begin
  FClosedGracefully := True
end;

procedure TIdIOHandler.InterceptReceive(var VBuffer: TIdBytes);
begin
  if Intercept <> nil then begin
    Intercept.Receive(VBuffer);
  end;
end;

procedure TIdIOHandler.InitComponent;
begin
  inherited;
  FRecvBufferSize := GRecvBufferSizeDefault;
  FSendBufferSize := GSendBufferSizeDefault;
  FMaxLineLength := IdMaxLineLengthDefault;
  FMaxCapturedLines := Id_IOHandler_MaxCapturedLines;
end;

procedure TIdIOHandler.Capture(ADest: TStream);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, '.', True);
end;

procedure TIdIOHandler.Capture(ADest: TIdStrings);
var
  LLineCount: Integer;
begin
  PerformCapture(ADest, LLineCount, '.', True);
end;

procedure TIdIOHandler.WriteBufferFlush;
begin
  WriteBufferFlush(-1);
end;

procedure TIdIOHandler.WriteBufferOpen;
begin
  WriteBufferOpen(-1);
end;

procedure TIdIOHandler.WriteDirect(ABuffer: TIdBytes);
begin
  // Check if disconnected
  CheckForDisconnect(True, True);
  if Intercept <> nil then begin
    Intercept.Send(ABuffer);
  end;
end;

initialization
finalization
  FreeAndNil(GIOHandlerClassList)
end.