TROSynapseTCPChannel源码如下：
unit uROSynpaseTCPChannel;
interface
uses Classes, uROClient, {IdBaseComponent,} uROClientIntf, blcksock, synsock;
type
TSynapseClient = class(TTCPBlockSocket)
private
FConnected: Boolean;
protected
procedure DoStatus(Reason: THookSocketReason; const Value: string);override;
published
property Connected:Boolean read FConnected default False;
end;
{ TROCustomIndyTCPChannel }
TROCustomSynapseTCPChannel = class(TROTransportChannel, IROTransport, IROTCPTransport)
private
fSynapseClient : TSynapseClient;
fKeepAlive: boolean;
fDisableNagle: boolean;
FConnectTimeout: Integer;
FConnectFromIndy: Boolean;
FPort: integer;
FHost: string;
FUsingIP6: Boolean;
FRecvTimeout: Integer;
FSendTimeout: Integer;
procedure SetHost(const Value: string);
procedure SetPort(const Value: integer);
procedure SetConnectTimeout(const Value: Integer);
procedure SetConnectFromIndy(const Value: Boolean);
function GetHost: string;
function GetPort: integer;
procedure SetUsingIP6(const Value: Boolean);
procedure SetRecvTimeout(const Value: Integer);
procedure SetSendTimeout(const Value: Integer);
protected
procedure IntDispatch(aRequest, aResponse : TStream); override;
procedure IntSetServerLocator(aServerLocator : TROServerLocator); override;
function CreateSynapseClient: TSynapseClient; virtual;
{ IROTransport }
function GetTransportObject : TObject; override;
{ IROTCPTransport }
function GetClientAddress : string;
public
constructor Create(aOwner : TComponent); override;
property Port : integer read FPort write SetPort;
property Host : string read FHost write SetHost;
property DisableNagle : boolean read fDisableNagle write fDisableNagle default FALSE;
property SynapseClient : TSynapseClient read fSynapseClient;
property KeepAlive : boolean read fKeepAlive write fKeepAlive default false;
property ConnectTimeout:Integer read FConnectTimeout write SetConnectTimeout;
property RecvTimeout:Integer read FRecvTimeout write SetRecvTimeout;
property SendTimeout:Integer read FSendTimeout write SetSendTimeout;
property ConnectFromIndy:Boolean read FConnectFromIndy write SetConnectFromIndy default False;
property UsingIP6:Boolean read FUsingIP6 write SetUsingIP6 default False;
published
property SynchronizedProbing;
property OnSendStream;
property OnReceiveStream;
property ServerLocators;
property DispatchOptions;
property OnServerLocatorAssignment;
property ProbeServers;
property ProbeFrequency;
property OnBeforeProbingServers;
property OnAfterProbingServers;
property OnBeforeProbingServer;
property OnAfterProbingServer;
property OnLoginNeeded;
end;
{ TROIndyTCPChannel }
TROSynapseTCPChannel = class(TROCustomSynapseTCPChannel, IROTransport, IROTCPTransport)
private
protected
published
property Port;
property Host;
property DisableNagle;
property SynapseClient;
property KeepAlive;
property ConnectTimeout;
property RecvTimeout;
property SendTimeout;
end;
implementation
uses
SysUtils, uROClasses;
{ TROCustomIndyTCPChannel }
constructor TROCustomSynapseTCPChannel.Create(aOwner: TComponent);
begin
inherited;
fSynapseClient := CreateSynapseClient;
//fSynapseClient.Name := 'InternalSynapseClient';
//
// {$IFDEF DELPHI6UP}
// fSynapseClient.SetSubComponent(TRUE);
// {$ENDIF}
FUsingIP6 := False;
FSynapseClient.Family := SF_IP4;
FConnectFromIndy := False;
FConnectTimeout := 10000;
FSendTimeout := 15000;
FRecvTimeout := 60000;
fKeepAlive := True;
end;
function TROCustomSynapseTCPChannel.CreateSynapseClient: TSynapseClient;
begin
result := TSynapseClient.Create;
TSynapseClient(result).Bind('127.0.0.1','8090');
end;
function TROCustomSynapseTCPChannel.GetClientAddress: string;
begin
Result := fSynapseClient.GetLocalSinIP;
end;
function TROCustomSynapseTCPChannel.GetTransportObject: TObject;
begin
result := Self;
end;
procedure TROCustomSynapseTCPChannel.IntSetServerLocator(
aServerLocator: TROServerLocator);
begin
Host := aServerLocator.Host;
Port := aServerLocator.Port;
end;
procedure TROCustomSynapseTCPChannel.IntDispatch(aRequest, aResponse: TStream);
begin
try
if not fSynapseClient.Connected then
fSynapseClient.Connect(FHost,IntToStr(FPort));
if FConnectFromIndy then
begin
aRequest.Position := 0;
fSynapseClient.SendStreamIndy(aRequest);
fSynapseClient.RecvStreamIndy(aResponse,FRecvTimeout);
aResponse.Position := 0;
end
else
begin
aRequest.Position := 0;
fSynapseClient.SendStream(aRequest);
fSynapseClient.RecvStream(aResponse,FRecvTimeout);
aResponse.Position := 0;
end;
finally
if not KeepAlive then
fSynapseClient.CloseSocket;
end;
end;
function TROCustomSynapseTCPChannel.GetHost: string;
begin
result := TSynapseClient(SynapseClient).GetRemoteSinIP;
end;
function TROCustomSynapseTCPChannel.GetPort: integer;
begin
result := TSynapseClient(SynapseClient).GetRemoteSinPort;
end;
procedure TROCustomSynapseTCPChannel.SetConnectFromIndy(const Value: Boolean);
begin
FConnectFromIndy := Value;
end;
procedure TROCustomSynapseTCPChannel.SetConnectTimeout(const Value: Integer);
begin
FConnectTimeout := Value;
fSynapseClient.SetTimeout(FConnectTimeout);
end;
procedure TROCustomSynapseTCPChannel.SetHost(const Value: string);
begin
FHost := Value;
fSynapseClient.Bind(Host,IntToStr(FPort));
end;
procedure TROCustomSynapseTCPChannel.SetPort(const Value: integer);
begin
FPort := Value;
fSynapseClient.Bind(Host,IntToStr(FPort));
end;
procedure TROCustomSynapseTCPChannel.SetRecvTimeout(const Value: Integer);
begin
FRecvTimeout := Value;
end;
procedure TROCustomSynapseTCPChannel.SetSendTimeout(const Value: Integer);
begin
FSendTimeout := Value;
fSynapseClient.SetSendTimeout(FSendTimeout);
end;
procedure TROCustomSynapseTCPChannel.SetUsingIP6(const Value: Boolean);
begin
FUsingIP6 := Value;
if FUsingIP6 then
FSynapseClient.Family := SF_IP6
else
FSynapseClient.Family := SF_IP4;
end;
{ TSynapseClient }
procedure TSynapseClient.DoStatus(Reason: THookSocketReason;
const Value: string);
begin
inherited;
FConnected := (Reason in [HR_Connect,HR_CanRead,HR_CanWrite,HR_Accept,
HR_WriteCount,HR_ReadCount,HR_Listen]);
// FConnected := not (Reason in [HR_Error,HR_SocketClose,HR_SocketCreate]);
end;
initialization
RegisterTransportChannelClass(TROSynapseTCPChannel);
finalization
UnRegisterTransportChannelClass(TROSynapseTCPChannel);
end.
