dntcprequests.pas

一个国外比较早的IOCP控件

      else
        ;
    end;
  end;
end;

function TDnTcpReadRequest.IsComplete: Boolean;
begin
  inherited IsComplete;

  Result := (FWSABuf.len = 0) or    //everything is read
            (FRead = 0) or          //client close
            (FErrorCode <> 0) or    //network error
            not FMustAll;           //raw read
  if (FRead = 0) or (FErrorCode <> 0) then
    TDnTcpChannel.CheckImpl(FChannel).StopTimeOutTracking;
end;

function TDnTcpReadRequest.IsCPUNeeded: Boolean;
begin
  Result := False;
end;

procedure TDnTcpReadRequest.ReExecute;
begin
//  Dec(FWSABuf.len, FRead);
//  Inc(FWSABuf.buf, FRead);
  FRead := 0;
  Execute;
end;

procedure TDnTcpReadRequest.CallHandler(Context: TDnThreadContext);
begin
  try
    if (FErrorCode = 0) and (FRead <> 0) then
      FHandler.DoRead(Context, FChannel, FKey, FStartBuffer, FToRead - FWSABuf.len)
    else
    if FRead = 0 then
      FHandler.DoReadClose(Context, FChannel, FKey)
    else
      FHandler.DoReadError(Context, FChannel, FKey, FErrorCode);
  finally
    //InterlockedDecrement(RequestsPending);
  end;
end;
//-----------------------------------------------------------------------------

constructor TDnTcpLineRequest.Create( Channel: IDnChannel; Key: Pointer;
                                      Handler: IDnTcpLineHandler; MaxSize: Cardinal );
begin
  inherited Create(Channel, Key);
  if MaxSize > 1024 then
    FBufInitialSize := 1024
  else
    FBufInitialSize := MaxSize;
  
  Reset(Channel, Key, Handler, MaxSize);
  FContext.FRequest := Pointer(Self);
  SetLength(FRecv, MaxSize);
  FWSABuf.Len := MaxSize;
  FWSABuf.Buf := PChar(FRecv);
  FRead := 0;
  FToRead := MaxSize;
  FFlags := 0;
  //FTotalSize := MaxSize;
  FStartBuffer := PChar(FRecv);
  
  FHandler := Handler;
  FMaxSize := MaxSize;
  FEolFound := False;
  FWasRead := 0;
  FEolSign := CRLFZero; //CRLF - zero terminated string
end;

const MaxSizePerRecv: Cardinal = 65536;

procedure TDnTcpLineRequest.Reset(Channel: IDnChannel; Key: Pointer;
                                  Handler: IDnTcpLineHandler; MaxSize: Cardinal);
begin
  //bind POverlapped to this object
  FContext.FRequest := Pointer(Self);
  //allocate memory for recv'ed data
  SetLength(FRecv, FBufInitialSize);//SetLength(FRecv, MaxSize);
  FWSABuf.Len := FBufInitialSize; //FWSABuf.Len := MaxSize;
  FToRead := FBufInitialSize; //FToRead := MaxSize;
  FWSABuf.Buf := PChar(FRecv);
  FRead := 0;
  FFlags := 0;
  FStartBuffer := PChar(FRecv);
  FHandler := Handler;
  FMaxSize := MaxSize;
  FEolFound := False;
  FWasRead := 0;
  FEolSign := CRLFZero; //CRLF - zero terminated string
  FTotalWasRead := 0;
end;

destructor TDnTcpLineRequest.Destroy;
begin
  FHandler := Nil;
  inherited Destroy;
end;

function  TDnTcpLineRequest.RequestType: TDnIORequestType;
begin
  Result := rtRead;
end;

//scans Line for CRLF sequence
function TDnTcpLineRequest.CheckForEol(Line: PChar; Len: Integer): Integer;
var Ptr: PChar;
begin
  Ptr := StrPos(Line, FEolSign);
  if Ptr <> Nil then
    Result := Ptr - Line + 2
  else
    Result := -1;
end;

procedure TDnTcpLineRequest.SetTransferred(Transferred: Cardinal);
begin
  FRead := Transferred;
  Dec(FWSABuf.len, FRead);
  Inc(FWSABuf.buf, FRead);
  Inc(FTotalWasRead, FRead); 
end;

function  TDnTcpLineRequest.IssueWSARecv( s : TSocket; lpBuffers : LPWSABUF; dwBufferCount : DWORD; var lpNumberOfBytesRecvd : DWORD; var lpFlags : DWORD;
              lpOverlapped : LPWSAOVERLAPPED; lpCompletionRoutine : LPWSAOVERLAPPED_COMPLETION_ROUTINE ): Integer;
begin
  Result := Winsock2.WSARecv(s, lpBuffers, dwBufferCount, lpNumberOfBytesRecvd, lpFlags, lpOverlapped, lpCompletionRoutine);
end;


procedure TDnTcpLineRequest.Execute;
var ResCode: Integer;
    Len: Cardinal;
    ChannelImpl: TDnTcpChannel;
begin
  inherited Execute;
  FContext.FRequest := Self;
  //grab the channel read cache
  InterlockedIncrement(PendingRequests);
  ChannelImpl := TDnTcpChannel.CheckImpl(FChannel);
  if ChannelImpl.CacheHasData then
  begin
    FRead := ChannelImpl.ExtractFromCache(FWSABuf.buf, FWSABuf.len);
    Len := Self.CheckForEol(FWSABuf.buf, FRead);
    if Len <> $FFFFFFFF then
    begin
      ChannelImpl.InsertToCache(FWSABuf.buf + Len, FRead - Len);
      FRead := Len;
      PostQueuedCompletionStatus(ChannelImpl.Reactor.PortHandle, FRead, Cardinal(Pointer(ChannelImpl)), @FContext);
    end else
    if FRead <> 0 then
      PostQueuedCompletionStatus(ChannelImpl.Reactor.PortHandle, FRead, Cardinal(Pointer(ChannelImpl)), @FContext)
  end
  else
  begin //start reading from socket
    ResCode := IssueWSARecv(ChannelImpl.SocketHandle, @FWSABuf, 1,  FRead, FFlags, @FContext, Nil);

    if ResCode <> 0 then
    begin
      ResCode := WSAGetLastError;
      if ResCode <> WSA_IO_PENDING then
        Self.PostError(ResCode, FRead);
    end;
  end;
end;

function TDnTcpLineRequest.IsComplete: Boolean;
var ChannelImpl: TDnTcpChannel;
    Found: Integer;
    Tail: Integer;
    NeedToRead: Cardinal;
    OldSize, NewSize: Integer;
begin
  inherited IsComplete;
  ChannelImpl := TDnTcpChannel.CheckImpl(FChannel);
  if (FErrorCode <> 0) or (FRead = 0)then
  begin
    ChannelImpl.StopTimeOutTracking;
    Result := True;
    Exit;
  end;
  FEolFound := False;
  Dec(FToRead, FRead);

  Inc(FWasRead, FRead);
  //Inc(FTotalWasRead, FRead);
  if FWasRead <> 0 then
    Found := Self.CheckForEol(PChar(FRecv), FWasRead)
  else
    Found := -1;

  if (Found = -1) and (FToRead <> 0) then
    Result := False
  else
  if (Found = -1) and (FToRead = 0) then
  begin //ok, here we read all FToRead's bytes but EOL is not found
    //ok, do we need to read smth else?
    if Length(FRecv) < FMaxSize then
    begin
      OldSize := Length(FRecv);
      NewSize := Trunc(Length(FRecv) * 1.25 + 0.5);
      if NewSize > FMaxSize then
        NewSize := FMaxSize;
      SetLength(FRecv, NewSize);
      NeedToRead := NewSize - OldSize;
      FWSABuf.buf := @FRecv[OldSize+1];
      FWSABuf.len := NeedToRead;
      FToRead := NeedToRead;
      FRead := 0; FWasRead := 0;
      Execute;
      Result := False;
    end else
      Result := True
  end
  else
  if (Found <> -1) then
  begin
    Tail := FWasRead - Found;
    ChannelImpl.Add2Cache(PChar(FRecv) + Found, Tail);
    Inc(FToRead, Tail); Dec(FWasRead, Tail);
    Dec(FTotalWasRead, Tail);
    SetLength(FRecv, Found);
    FEolFound := True;
    Result := True;
  end else
    Result := True;
end;

function TDnTcpLineRequest.IsCPUNeeded: Boolean;
begin
  Result := False;
end;

procedure TDnTcpLineRequest.ReExecute;
begin
  Execute;
end;

procedure TDnTcpLineRequest.CallHandler(Context: TDnThreadContext);
//var ChannelImpl: TDnTcpChannel;
begin
  try
    if FErrorCode = 0 then
    begin
      if FRead = 0 then
        FHandler.DoLineClose(Context, FChannel, FKey)
      else
        FHandler.DoLine(Context, FChannel, FKey, FRecv, FEolFound);
    end else
      FHandler.DoLineError(Context, FChannel, FKey, FErrorCode);
  finally
    //InterlockedDecrement(RequestsPending);
  end;
end;
//-----------------------------------------------------------------------------

constructor TDnTcpWriteRequest.Create(Channel: IDnChannel; Key: Pointer;
                                      Handler: IDnTcpWriteHandler; Buf: PChar;
                                      BufSize: Cardinal);
begin
  inherited Create(Channel, Key);

  FWSABuf.Len := BufSize;
  FWSABuf.Buf := Buf;
  FWritten := 0;
  FToWrite := BufSize;
  FFlags := 0;
  //FTotalSize := BufSize;
  FStartBuffer := @Buf;
  FHandler := Handler;
  FTempStorage := '';
end;

constructor TDnTcpWriteRequest.CreateString(Channel: IDnChannel; Key: Pointer;
                                      Handler: IDnTcpWriteHandler; Buf: String);
begin
  inherited Create(Channel, Key);

  FWSABuf.Len := Length(Buf);
  FWSABuf.Buf := PChar(Buf);
  FWritten := 0;
  FToWrite := Length(Buf);
  FFlags := 0;
  FTotalSize := Length(Buf);
  FStartBuffer := PChar(Buf);
  FHandler := Handler;
  FTempStorage := Buf;
end;

destructor TDnTcpWriteRequest.Destroy;
begin
  FHandler := Nil;
  inherited Destroy;
end;

function TDnTcpWriteRequest.RequestType: TDnIORequestType;
begin
  Result := rtWrite;
end;

procedure TDnTcpWriteRequest.SetTransferred(Transferred: Cardinal);
begin
  FWritten := Transferred;
  Dec(FWSABuf.len, FWritten);
  Inc(FWSABuf.buf, FWritten);
end;

procedure TDnTcpWriteRequest.Execute;
var ResCode: Integer;
    ChannelImpl: TDnTcpChannel;
begin
  inherited Execute;
  ChannelImpl := TDnTcpChannel.CheckImpl(FChannel);
  InterlockedIncrement(PendingRequests);
  ResCode := Winsock2.WSASend(ChannelImpl.SocketHandle, @FWSABuf , 1, FWritten, 0, @FContext, Nil);
  if ResCode = 0 then
  begin //WSASend completed immediately
    ;
  end else
  begin
    ResCode := WSAGetLastError;
    if (ResCode <> WSA_IO_PENDING)  then
      Self.PostError(ResCode, 0);
  end;
end;

function TDnTcpWriteRequest.IsComplete: Boolean;
begin
  inherited IsComplete;
  Result := (FWSABuf.len = 0) or (FErrorCode <> 0);
end;

function TDnTcpWriteRequest.IsCPUNeeded: Boolean;
begin
  Result := False;
end;

procedure TDnTcpWriteRequest.ReExecute;
begin
  Execute;
end;

procedure TDnTcpWriteRequest.CallHandler(Context: TDnThreadContext);
begin
  if FErrorCode = 0 then
    FHandler.DoWrite(Context, FChannel, FKey, FStartBuffer, FWritten)
  else
    FHandler.DoWriteError(Context, FChannel, FKey, FErrorCode);
  FTempStorage := '';
end;
//----------------------------------------------------------------------------
//----------------------------------------------------------------------------
end.