335 lines
8.4 KiB
Plaintext
335 lines
8.4 KiB
Plaintext
{
|
|
$Project$
|
|
$Workfile$
|
|
$Revision$
|
|
$DateUTC$
|
|
$Id$
|
|
|
|
This file is part of the Indy (Internet Direct) project, and is offered
|
|
under the dual-licensing agreement described on the Indy website.
|
|
(http://www.indyproject.org/)
|
|
|
|
Copyright:
|
|
(c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
|
|
}
|
|
{
|
|
$Log$
|
|
}
|
|
{
|
|
Rev 1.2 6/11/2004 8:40:10 AM DSiders
|
|
Added "Do not Localize" comments.
|
|
|
|
Rev 1.1 2004.02.09 9:16:54 PM czhower
|
|
Updated to compile and match lib changes.
|
|
|
|
Rev 1.0 2004.02.03 12:39:08 AM czhower
|
|
Move
|
|
|
|
Rev 1.17 2003.10.19 2:50:42 PM czhower
|
|
Fiber cleanup
|
|
|
|
Rev 1.16 2003.10.11 5:44:02 PM czhower
|
|
Chained servers now functional.
|
|
|
|
Rev 1.15 2003.07.17 4:42:06 PM czhower
|
|
More IOCP improvements.
|
|
|
|
Rev 1.14 2003.07.17 3:55:18 PM czhower
|
|
Removed IdIOChainEngineIOCP and merged it into TIdChaingEngine in
|
|
IdIOHandlerChain.pas.
|
|
|
|
Rev 1.10 2003.07.14 12:54:32 AM czhower
|
|
Fixed graceful close detection if it occurs after connect.
|
|
|
|
Rev 1.9 2003.07.10 7:40:24 PM czhower
|
|
Comments
|
|
|
|
Rev 1.8 7/5/2003 11:47:12 PM BGooijen
|
|
Added TIdWorkOpUnitCheckForDisconnect and TIdWorkOpUnitWriteFile
|
|
|
|
Rev 1.7 4/23/2003 8:22:20 PM BGooijen
|
|
|
|
Rev 1.6 2003.04.22 9:48:50 PM czhower
|
|
|
|
Rev 1.5 2003.04.20 9:12:20 PM czhower
|
|
|
|
Rev 1.5 2003.04.19 3:14:14 PM czhower
|
|
|
|
Rev 1.4 2003.04.17 7:45:02 PM czhower
|
|
|
|
Rev 1.2 3/27/2003 2:43:04 PM BGooijen
|
|
Added woWriteStream and woWriteBuffer
|
|
|
|
Rev 1.1 3/2/2003 12:36:24 AM BGooijen
|
|
Added woReadBuffer and TIdWorkOpUnitReadBuffer to read a buffer. Now
|
|
ReadBuffer doesn't use ReadStream any more.
|
|
TIdIOHandlerChain.ReadLn now supports MaxLineLength (splitting, and
|
|
exceptions).
|
|
woReadLn doesn't check the intire buffer any more, but continued where it
|
|
stopped the last time.
|
|
Added basic support for timeouts (probably only on read operations, and maybe
|
|
connect), accuratie of timeout is currently 500msec.
|
|
|
|
Rev 1.0 2/25/2003 10:45:46 PM BGooijen
|
|
Opcode files, some of these were in IdIOHandlerChain.pas
|
|
}
|
|
|
|
unit IdWorkOpUnit;
|
|
|
|
interface
|
|
|
|
uses
|
|
IdFiber, IdIOHandlerSocket, IdStackConsts, IdWinsock2, IdGlobal,
|
|
SysUtils, Windows;
|
|
|
|
type
|
|
TIdWorkOpUnit = class;
|
|
TOnWorkOpUnitCompleted = procedure(ASender: TIdWorkOpUnit) of object;
|
|
|
|
TIdOverLapped = packed record
|
|
// Reqquired parts of structure
|
|
Internal: DWORD;
|
|
InternalHigh: DWORD;
|
|
Offset: DWORD;
|
|
OffsetHigh: DWORD;
|
|
HEvent: THandle;
|
|
// Indy parts
|
|
WorkOpUnit: TIdWorkOpUnit;
|
|
Buffer: PWSABUF; // Indy part too, we reference it and pass it to IOCP
|
|
end;
|
|
PIdOverlapped = ^TIdOverlapped;
|
|
|
|
TIdWorkOpUnit = class(TObject)
|
|
protected
|
|
FCompleted: Boolean;
|
|
FException: Exception;
|
|
FFiber: TIdFiber;
|
|
FIOHandler: TIdIOHandlerSocket;
|
|
FOnCompleted: TOnWorkOpUnitCompleted;
|
|
FSocketHandle:TIdStackSocketHandle;
|
|
FTimeOutAt: Integer;
|
|
FTimedOut: Boolean;
|
|
//
|
|
procedure DoCompleted;
|
|
virtual;
|
|
function GetOverlapped(
|
|
ABuffer: Pointer;
|
|
ABufferSize: Integer
|
|
): PIdOverlapped;
|
|
procedure Starting; virtual; abstract;
|
|
public
|
|
procedure Complete; virtual;
|
|
destructor Destroy; override;
|
|
procedure MarkComplete; virtual;
|
|
// Process is called by the chain engine when data has been processed
|
|
procedure Process(
|
|
AOverlapped: PIdOverlapped;
|
|
AByteCount: Integer
|
|
); virtual; abstract;
|
|
procedure RaiseException;
|
|
procedure Start;
|
|
//
|
|
property Completed: Boolean read FCompleted;
|
|
property Fiber: TIdFiber read FFiber write FFiber;
|
|
property IOHandler: TIdIOHandlerSocket read FIOHandler write FIOHandler;
|
|
property OnCompleted: TOnWorkOpUnitCompleted read FOnCompleted
|
|
write FOnCompleted;
|
|
property SocketHandle:TIdStackSocketHandle read FSocketHandle
|
|
write FSocketHandle;
|
|
property TimeOutAt:integer read FTimeOutAt write FTimeOutAt;
|
|
property TimedOut:boolean read FTimedOut write FTimedOut;
|
|
end;
|
|
|
|
TIdWorkOpUnitRead = class(TIdWorkOpUnit)
|
|
protected
|
|
// Used when a dynamic buffer is needed
|
|
// Since its reference managed, memory is auto cleaned up
|
|
FBytes: TIdBytes;
|
|
//
|
|
procedure Processing(
|
|
ABuffer: TIdBytes
|
|
); virtual; abstract;
|
|
procedure Starting;
|
|
override;
|
|
public
|
|
procedure Process(
|
|
AOverlapped: PIdOverlapped;
|
|
AByteCount: Integer
|
|
); override;
|
|
procedure Read;
|
|
end;
|
|
|
|
TIdWorkOpUnitWrite = class(TIdWorkOpUnit)
|
|
protected
|
|
procedure Processing(
|
|
ABytes: Integer
|
|
); virtual; abstract;
|
|
procedure Write(
|
|
ABuffer: Pointer;
|
|
ASize: Integer
|
|
);
|
|
public
|
|
procedure Process(
|
|
AOverlapped: PIdOverlapped;
|
|
AByteCount: Integer
|
|
); override;
|
|
end;
|
|
|
|
const
|
|
WOPageSize = 8192;
|
|
|
|
implementation
|
|
|
|
uses
|
|
IdException, IdIOHandlerChain, IdStack, IdStackWindows;
|
|
|
|
{ TIdWorkOpUnit }
|
|
|
|
procedure TIdWorkOpUnit.Complete;
|
|
begin
|
|
DoCompleted;
|
|
end;
|
|
|
|
destructor TIdWorkOpUnit.Destroy;
|
|
begin
|
|
FreeAndNil(FException);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TIdWorkOpUnit.DoCompleted;
|
|
begin
|
|
if Assigned(OnCompleted) then begin
|
|
OnCompleted(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TIdWorkOpUnit.MarkComplete;
|
|
begin
|
|
FCompleted := True;
|
|
end;
|
|
|
|
procedure TIdWorkOpUnit.RaiseException;
|
|
var
|
|
LException: Exception;
|
|
begin
|
|
if FException <> nil then begin
|
|
LException := FException;
|
|
// We need to set this to nil so it wont be freed. Delphi will free it
|
|
// as part of its exception handling mechanism
|
|
FException := nil;
|
|
raise LException;
|
|
end;
|
|
end;
|
|
|
|
function TIdWorkOpUnit.GetOverlapped(
|
|
ABuffer: Pointer;
|
|
ABufferSize: Integer
|
|
): PIdOverlapped;
|
|
begin
|
|
Result := TIdIOHandlerChain(IOHandler).Overlapped;
|
|
with Result^ do begin
|
|
Internal := 0;
|
|
InternalHigh := 0;
|
|
Offset := 0;
|
|
OffsetHigh := 0;
|
|
HEvent := 0;
|
|
WorkOpUnit := Self;
|
|
Buffer.Buf := ABuffer;
|
|
Buffer.Len := ABufferSize;
|
|
end;
|
|
end;
|
|
|
|
procedure TIdWorkOpUnit.Start;
|
|
begin
|
|
Starting;
|
|
// This can get called after its already been marked complete. This is
|
|
// ok and the fiber scheduler handles such a situation.
|
|
Fiber.Relinquish;
|
|
end;
|
|
|
|
{ TIdWorkOpUnitWrite }
|
|
|
|
procedure TIdWorkOpUnitWrite.Process(
|
|
AOverlapped: PIdOverlapped;
|
|
AByteCount: Integer
|
|
);
|
|
begin
|
|
Processing(AByteCount);
|
|
end;
|
|
|
|
procedure TIdWorkOpUnitWrite.Write(ABuffer: Pointer;
|
|
ASize: Integer);
|
|
var
|
|
LFlags: DWORD;
|
|
LOverlapped: PIdOverlapped;
|
|
LLastError: Integer;
|
|
LVoid: DWORD;
|
|
begin
|
|
LFlags := 0;
|
|
LOverlapped := GetOverlapped(ABuffer, ASize);
|
|
case WSASend(SocketHandle, LOverlapped.Buffer, 1, LVoid, LFlags, LOverlapped
|
|
, nil) of
|
|
0: ; // Do nothing
|
|
|
|
SOCKET_ERROR: begin
|
|
LLastError := GWindowsStack.WSGetLastError;
|
|
if LLastError <> WSA_IO_PENDING then begin
|
|
GWindowsStack.RaiseSocketError(LLastError);
|
|
end;
|
|
end;
|
|
|
|
else Assert(False, 'Unknown result code received from WSARecv'); {do not localize}
|
|
end;
|
|
end;
|
|
|
|
{ TIdWorkOpUnitRead }
|
|
|
|
procedure TIdWorkOpUnitRead.Process(
|
|
AOverlapped: PIdOverlapped;
|
|
AByteCount: Integer
|
|
);
|
|
begin
|
|
SetLength(FBytes, AByteCount);
|
|
Processing(FBytes);
|
|
end;
|
|
|
|
procedure TIdWorkOpUnitRead.Read;
|
|
var
|
|
LBytesReceived: DWORD;
|
|
LFlags: DWORD;
|
|
LOverlapped: PIdOverlapped;
|
|
LLastError: Integer;
|
|
begin
|
|
LFlags := 0;
|
|
// Initialize byte array and pass it to overlapped
|
|
SetLength(FBytes, WOPageSize);
|
|
LOverlapped := GetOverlapped(@FBytes[0], Length(FBytes));
|
|
//TODO: What is this 997? Need to check for it? If changed, do in Write too
|
|
// GStack.CheckForSocketError( // can raise a 997
|
|
case WSARecv(SocketHandle, LOverlapped.Buffer, 1, LBytesReceived, LFlags
|
|
, LOverlapped, nil) of
|
|
// , [997] );
|
|
// Kudzu
|
|
// In this case it completed immediately. The MS docs are not clear, but
|
|
// testing shows that it still causes the completion port.
|
|
0: ; // Do nothing
|
|
|
|
SOCKET_ERROR: begin
|
|
LLastError := GWindowsStack.WSGetLastError;
|
|
// If its WSA_IO_PENDING this is normal and its been queued
|
|
if LLastError <> WSA_IO_PENDING then begin
|
|
GWindowsStack.RaiseSocketError(LLastError);
|
|
end;
|
|
end;
|
|
|
|
else Assert(False, 'Unknown result code received from WSARecv'); {do not localize}
|
|
end;
|
|
end;
|
|
|
|
procedure TIdWorkOpUnitRead.Starting;
|
|
begin
|
|
Read;
|
|
end;
|
|
|
|
end.
|