idtcpconnection.pas

Indy控件的使用源代码

function TIdTCPConnection.ReadFromStack(const ARaiseExceptionIfDisconnected: Boolean = True;
 ATimeout: Integer = IdTimeoutDefault; const ARaiseExceptionOnTimeout: Boolean = True): Integer;
// Reads any data in tcp/ip buffer and puts it into Indy buffer
// This must be the ONLY raw read from Winsock routine
// This must be the ONLY call to RECV - all data goes thru this method
var
  i: Integer;
  LByteCount: Integer;
begin
  if ATimeout = IdTimeoutDefault then begin
    if ReadTimeOut = 0 then begin
      ATimeout := IdTimeoutInfinite;
    end else begin
      ATimeout := FReadTimeout;
    end;
  end;
  Result := 0;
  // Check here as this side may have closed the socket
  CheckForDisconnect(ARaiseExceptionIfDisconnected);
  if Connected then begin
    LByteCount := 0;
    repeat
      if IOHandler.Readable(ATimeout) then begin
        if Assigned(FRecvBuffer) and Assigned(IOHandler) then begin //APR: disconnect from other thread
          FRecvBuffer.Size := RecvBufferSize;
        // No need to call AntiFreeze, the Readable does that.
          LByteCount := IOHandler.Recv(FRecvBuffer.Memory^, FRecvBuffer.Size);
        end else begin
          LByteCount := 0;
          if ARaiseExceptionIfDisconnected then
            raise EIdNotConnected.Create(RSNotConnected);
        end;
        FClosedGracefully := LByteCount = 0;
        if not ClosedGracefully then begin
          if GStack.CheckForSocketError(LByteCount, [Id_WSAESHUTDOWN, Id_WSAECONNABORTED]) then begin
            LByteCount := 0;
            if IOHandler <> nil then begin
              DisconnectSocket;
            end;
            // Do not raise unless all data has been read by the user
            if InputBuffer.Size = 0 then begin
              GStack.RaiseSocketError(GStack.LastError);
            end;
          end;
          // InputBuffer.Size is modified above
          if LByteCount > 0 then begin
            FRecvBuffer.Size := LByteCount;
            if Assigned(Intercept) then begin
              FRecvBuffer.Position := 0;
              Intercept.Receive(FRecvBuffer);
              LByteCount := FRecvBuffer.Size;
            end;
            if ASCIIFilter then begin
              for i := 1 to FRecvBuffer.Size do begin
                PChar(FRecvBuffer.Memory)[i] := Chr(Ord(PChar(FRecvBuffer.Memory)[i]) and $7F);
              end;
            end;
            FInputBuffer.Seek(0, soFromEnd);
            FInputBuffer.WriteBuffer(FRecvBuffer.Memory^, FRecvBuffer.Size);
          end;
        end;
        // Check here as other side may have closed connection
        CheckForDisconnect(ARaiseExceptionIfDisconnected);
        Result := LByteCount;
      end else begin
        // Timeout
        if ARaiseExceptionOnTimeout then begin
          raise EIdReadTimeout.Create(RSReadTimeout);
        end;
        Result := -1;
        Break;
      end;
    until (LByteCount <> 0) or (Connected = False);
  end else begin
    if ARaiseExceptionIfDisconnected then begin
      raise EIdNotConnected.Create(RSNotConnected);
    end;
  end;
end;

function TIdTCPConnection.ReadInteger(const AConvert: boolean = true): Integer;
begin
  ReadBuffer(Result, SizeOf(Result));
  if AConvert then begin
    Result := Integer(GStack.WSNToHL(LongWord(Result)));
  end;
end;

function TIdTCPConnection.ReadLn(ATerminator: string = LF;
 const ATimeout: Integer = IdTimeoutDefault; AMaxLineLength: Integer = -1): string;
var
  LInputBufferSize: Integer;
  LSize: Integer;
  LTermPos: Integer;
begin
  if AMaxLineLength = -1 then begin
    AMaxLineLength := MaxLineLength;
  end;
  // User may pass '' if they need to pass arguments beyond the first.
  if Length(ATerminator) = 0 then begin
    ATerminator := LF;
  end;
  FReadLnSplit := False;
  FReadLnTimedOut := False;
  LTermPos := 0;
  LSize := 0;
  repeat
    LInputBufferSize := InputBuffer.Size;
    if LInputBufferSize > 0 then begin
      LTermPos :=
        MemoryPos(ATerminator, PChar(InputBuffer.Memory) + LSize, LInputBufferSize - LSize);
      if LTermPos > 0 then begin
        LTermPos := LTermPos + LSize;
      end;
      LSize := LInputBufferSize;
    end;//if
    if (LTermPos - 1 > AMaxLineLength) and (AMaxLineLength <> 0) then begin
      if MaxLineAction = maException then begin
        raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
      end else begin
        FReadLnSplit := True;
        Result := InputBuffer.Extract(AMaxLineLength);
        Exit;
      end;
    // ReadFromStack blocks - do not call unless we need to
    end else if LTermPos = 0 then begin
      if (LSize > AMaxLineLength) and (AMaxLineLength <> 0) then begin
        if MaxLineAction = maException then begin
          raise EIdReadLnMaxLineLengthExceeded.Create(RSReadLnMaxLineLengthExceeded);
        end else begin
          FReadLnSplit := True;
          Result := InputBuffer.Extract(AMaxLineLength);
          Exit;
        end;
      end;
      // ReadLn needs to call this as data may exist in the buffer, but no EOL yet disconnected
      CheckForDisconnect(True, True);
      // Can only return -1 if timeout
      FReadLnTimedOut := ReadFromStack(True, ATimeout, ATimeout = IdTimeoutDefault) = -1;
      if ReadLnTimedout then begin
        Result := '';
        Exit;
      end;
    end;
  until LTermPos > 0;
  dec(LTermPos);// Strip terminators (string len w/o first terminator char)
  Result := InputBuffer.Extract(LTermPos + Length(ATerminator));// Extract actual data
  if (ATerminator = LF) and (LTermPos > 0) and (Result[LTermPos] = CR) then begin
    SetLength(Result, LTermPos - 1);
  end else begin
    SetLength(Result, LTermPos);
  end;
end;//ReadLn

function TIdTCPConnection.ReadLnWait(AFailCount: Integer = MaxInt): string;
var
  LAttempts: Integer;
begin
  Result := '';
  LAttempts := 0;
  while (Length(Result) = 0) and (LAttempts < AFailCount) do begin
    Inc(LAttempts);
    Result := Trim(ReadLn);
  end;
end; //ReadLnWait

procedure TIdTCPConnection.ReadStream(AStream: TStream; AByteCount: Integer = -1;
 const AReadUntilDisconnect: Boolean = False);
var
  i: Integer;
  LBuf: packed array of Byte;
  LBufSize: Integer;
  LWorkCount: Integer;

  procedure AdjustStreamSize(AStream: TStream; const ASize: integer);
  var
    LStreamPos: LongInt;
  begin
    LStreamPos := AStream.Position;
    AStream.Size := ASize;
    // Must reset to original size as in some cases size changes position
    if AStream.Position <> LStreamPos then begin
      AStream.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.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 InputBuffer.Size > 0 then begin
      i := Min(InputBuffer.Size, LWorkCount);
      InputBuffer.Position := 0;
      AStream.CopyFrom(InputBuffer, i);
      InputBuffer.Remove(i);
      Dec(LWorkCount, i);
    end;

    LBufSize := Min(LWorkCount, RecvBufferSize);
    SetLength(LBuf, LBufSize);

    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
          ReadBuffer(LBuf[0], i);
        except
          on E: EIdConnClosedGracefully do begin
            if AReadUntilDisconnect then begin
              i := InputBuffer.Size;
              Move(InputBuffer.Memory^, LBuf[0], i);
              InputBuffer.Clear; //InputBuffer.Remove(InputBuffer.Size);
            end else begin
              i := 0;
              raise;
            end;
          end;
        end;
      finally
        if i > 0 then begin
          AStream.WriteBuffer(LBuf[0], i);
          Dec(LWorkCount, i);
        end;
      end;
    end;
  finally
    EndWork(wmRead);
    if AStream.Size > AStream.Position then begin
      AStream.Size := AStream.Position;
    end;
    LBuf := NIL;
  end;
end;

procedure TIdTCPConnection.ResetConnection;
begin
  InputBuffer.Clear;
  FClosedGracefully := False;
end;

function TIdTCPConnection.SendCmd(const AOut: string; const AResponse: Array of SmallInt): SmallInt;
begin
  WriteLn(AOut);
  Result := GetResponse(AResponse);
end;

procedure TIdTCPConnection.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, OPeration);

  if (Operation = opRemove) then begin
    if (AComponent = FIntercept) then begin
      FIntercept := nil;
    end;

    if (AComponent = FIOHandler) then begin
      FIOHandler := nil;
    end;
  end;
end;

procedure TIdTCPConnection.SetIntercept(AValue: TIdConnectionIntercept);
begin
  FIntercept := AValue;
  // add self to the Intercept's free notification list
  if Assigned(FIntercept) then begin
    FIntercept.FreeNotification(Self);
  end;
end;

procedure TIdTCPConnection.SetIOHandler(AValue: TIdIOHandler);
begin
  if Assigned(FIOHandler) and FFreeIOHandlerOnDisconnect then begin
    FreeAndNil(FIOHandler); // Clear the existing IOHandler
    FFreeIOHandlerOnDisconnect := false;
  end;
  if AValue = nil then begin
    FSocket := nil;
  end else if AValue is TIdIOHandlerSocket then begin
    FSocket := TIdIOHandlerSocket(AValue);
  end;
  FIOHandler := AValue;
  // add self to the IOHandler's free notification list
  if Assigned(FIOHandler) then begin
    FIOHandler.FreeNotification(Self);
  end;
end;

procedure TIdTCPConnection.Write(const AOut: string);
var
  LOutLen: Integer;
Begin
  LOutLen := Length(AOut);
  if LOutLen > 0 then begin
    WriteBuffer(Pointer(AOut)^, LOutLen);    
  end;
End;//Write

procedure TIdTCPConnection.WriteBuffer(const ABuffer; AByteCount: Integer;
 const AWriteNow: boolean = false);
var
  LBuffer: TIdSimpleBuffer;
  nPos, nByteCount: Integer;
begin
  if (AByteCount > 0) and (@ABuffer <> nil) then begin
    // Check if disconnected
    CheckForDisconnect(True, True);
    if connected then begin
      if (FWriteBuffer = nil) or AWriteNow then begin
        LBuffer := TIdSimpleBuffer.Create; try
          LBuffer.WriteBuffer(ABuffer, AByteCount);
          if Assigned(Intercept) then begin
            LBuffer.Position := 0;
            Intercept.Send(LBuffer);
            AByteCount := LBuffer.Size;
          end;
          nPos := 1;
          repeat
            nByteCount := IOHandler.Send(PChar(LBuffer.Memory)[nPos - 1], LBuffer.Size - nPos + 1);
            // Write always does someting - never retuns 0
            // TODO - Have a AntiFreeze param which allows the send to be split up so that process
            // can be called more. Maybe a prop of the connection, MaxSendSize?
            TIdAntiFreezeBase.DoProcess(False);
            FClosedGracefully := nByteCount = 0;

            // Check if other side disconnected
            CheckForDisconnect;
            // Check to see if the error signifies disconnection
            if GStack.CheckForSocketError(nByteCount
             , [ID_WSAESHUTDOWN, Id_WSAECONNABORTED, Id_WSAECONNRESET]) then begin
              DisconnectSocket;
              GStack.RaiseSocketError(GStack.WSGetLastError);
            end;
            DoWork(wmWrite, nByteCount);
            nPos := nPos + nByteCount;
          until nPos > AByteCount;
        finally FreeAndNil(LBuffer); end;
    // Write Buffering is enabled
      end else begin
        FWriteBuffer.WriteBuffer(ABuffer, AByteCount);
        if (FWriteBuffer.Size >= FWriteBufferThreshhold) and (FWriteBufferThreshhold > 0) then begin
          // TODO: Maybe? instead of flushing - Write until buffer is smaller than Threshold.
          // That is do at least one physical send.
          FlushWriteBuffer(FWriteBufferThreshhold);
        end;
      end;
    end
    else
    begin
      Raise EIdNotConnected.Create(RSNotConnected);
    end;
  end;
end;

function TIdTCPConnection.WriteFile(const AFile: String; const AEnableTransferFile: boolean = False): Cardinal;
var
//TODO: There is a way in linux to dump a file to a socket as well. use it.
  LFileStream: TFileStream;
begin
  if FileExists(AFile) then begin
    if Assigned(GServeFileProc) and (Intercept = nil) and AEnableTransferFile
      and (Socket <> nil) then begin
      Result := GServeFileProc(Socket.Binding.Handle, AFile);
    end else begin
      LFileStream := TFileStream.Create(AFile, fmOpenRead or fmShareDenyWrite);
      try
        WriteStream(LFileStream); //ALL Stream, no bcnt
        Result := LFileStream.Size;
      finally LFileStream.free; end;
    end;
  end else begin
    raise EIdFileNotFound.Create(Format(RSFileNotFound,[AFile]));
  end;
end;


procedure TIdTCPConnection.WriteHeader(AHeader: TStrings);
var
  i: Integer;
begin
  for i := 0 to AHeader.Count -1 do begin
    // No ReplaceAll flag - we only want to replace the first one
    WriteLn(StringReplace(AHeader[i], '=', ': ', []));
  end;
  WriteLn('');
end;

procedure TIdTCPConnection.WriteInteger(AValue: Integer; const AConvert: Boolean = True);
begin
  if AConvert then begin
    AValue := Integer(GStack.WSHToNl(LongWord(AValue)));
  end;
  WriteBuffer(AValue, SizeOf(AValue));
end;

procedure TIdTCPConnection.WriteLn(const AOut: string = '');
begin
  Write(AOut + EOL);
end;

procedure TIdTCPConnection.WriteStream(AStream: TStream; const AAll: boolean = true;
 const AWriteByteCount: Boolean = False; const ASize: Integer = 0);
var
  LBuffer: TMemoryStream;
  LSize: Integer;
  LStreamEnd: Integer;
begin
  if AAll then begin
    AStream.Position := 0;
  end;
  // This is copied to a local var because accessing .Size is very inefficient
  if ASize = 0 then begin
    LStreamEnd := AStream.Size;
  end else begin
    LStreamEnd := ASize + AStream.Position;
  end;
  LSize := LStreamEnd - AStream.Position;
  if AWriteByteCount then begin
  	WriteInteger(LSize);
  end;
  BeginWork(wmWrite, LSize); try
    LBuffer := TMemoryStream.Create; try
      LBuffer.SetSize(FSendBufferSize);
      while True do begin
        LSize := Min(LStreamEnd - AStream.Position, FSendBufferSize);
        if LSize = 0 then begin
          Break;
        end;
        // Do not use ReadBuffer. Some source streams are real time and will not
        // return as much data as we request. Kind of like recv()
        // NOTE: We use .Size - size must be supported even if real time