function TSocketDispatcherThread.Send(const Data: IDataBlock; WaitForResult: Boolean): IDataBlock;
begin
//用傳送器對象回傳數據，其中Data是由數據塊解析器創建的數據塊對象，以接口類型參數的方式傳到該函數
FTransport.Send(Data);
//當數據塊解析器需要進行連續的數據回傳（如數據太大，一次不能不能回傳所有數據）時，
//它向WaitForResult參數傳入True，SocketDispatcherThread就會
//在一次發送數據之後檢索並解析客戶端的回應，決定是否繼續回傳數據。
if WaitForResult then
while True do
begin
Result := FTransport.Receive(True, 0); //檢索客戶端回應
if Result = nil then break;
if (Result.Signature and ResultSig) = ResultSig then
break else
FInterpreter.InterpretData(Result ); //解析客戶端回應
end;
end;
CallSig = $DA00; // Call signature
ResultSig = $DB00; // Result signature
asError = $01; // Specify an exception was raised
asInvoke = $02; // Specify a call to Invoke
asGetID = $03; // Specify a call to GetIdsOfNames
asCreateObject = $04; // Specify a com object to create
asFreeObject = $05; // Specify a dispatch to free
asGetServers = $10; // Get classname list
asGetGUID = $11; // Get GUID for ClassName
asGetAppServers = $12; // Get AppServer classname list
asSoapCommand = $14; // Soap command
asMask = $FF; // Mask for action
procedure CheckSignature(Sig: Integer);
begin
if (Sig and $FF00 <> CallSig) and
(Sig and $FF00 <> ResultSig) then
raise Exception.CreateRes(@SInvalidDataPacket);
end;
function TSocketTransport.Receive(WaitForInput: Boolean; Context: Integer): IDataBlock;
var
RetLen, Sig, StreamLen: Integer;
P: Pointer;
FDSet: TFDSet;
TimeVal: PTimeVal;
RetVal: Integer;
begin
...
if (RetVal = 0 ) then Exit;
if not IsCustomTrans then { === My Code === }
begin
RetLen := FSocket.ReceiveBuf(Sig, SizeOf(Sig));
...
if RetLen <> SizeOf(StreamLen) then
raise ESocketConnectionError.CreateRes (@SSocketReadError);
end
else
StreamLen:=FSocket.ReceiveLength; { === My Code === }
Result := TDataBlock.Create as IDataBlock;
if not IsCustomTrans then { === My Code === }
Result.Signature := Sig;
...
end;
2、TSocketTransport的Send方法用於實際回傳數據，也需改寫：
function TSocketTransport.Send(const Data: IDataBlock): Integer;
var
P: Pointer;
begin
Result := 0;
InterceptOutgoing(Data);
P := Data.Memory;
if IsCustomTrans then { === My Code === }
FSocket .SendBuf(PByteArray(P)^[Data.BytesReserved],Data.Size) { === My Code ===不發送保留字節}
else
FSocket.SendBuf(P^, Data.Size + Data.BytesReserved);
end;
destructor TBaseDataBlockInterpreter.Destroy;
var
i: Integer;
begin
for i := FDispatchList.Count - 1 downto 0 do
TDataDispatch(FDispatchList).FInterpreter := nil;
FDispatchList.Free;
FSendDataBlock := nil;
inherited;
end;
function TBaseDataBlockInterpreter.DisconnectOnComplete: Boolean;
begin
Result:=False;
end;
function TSocketDispatcherThread.CreateServerTransport: ITransport;
var
SocketTransport: TSocketTransport;
begin
SocketTransport := TSocketTransport.Create;
SocketTransport.Socket := ClientSocket;
SocketTransport.InterceptGUID := FInterceptGUID;
Result := SocketTransport as ITransport;
end;
function TSocketDispatcherThread.CreateServerTransport: ITransport;
var
SocketTransport: TSocketTransport;
begin
SocketTransport := TSocketTransport.Create;
SocketTransport.Socket := ClientSocket;
SocketTransport.InterceptGUID := FInterceptGUID;
if DataBlockInterpreterClass.ClassName='TDataBlockInterpreter' then { === New == = }
SocketTransport.IsCustomTrans:=False { === New === }
else { === New === }
SocketTransport.IsCustomTrans:=True; { === New === }
Result := SocketTransport as ITransport;
end;
procedure TSocketDispatcherThread.ClientExecute;
begin
...
if FRegisteredOnly then
FInterpreter := DataBlockInterpreterClass.Create(Obj, SSockets) { === Modified === }
else
FInterpreter := DataBlockInterpreterClass.Create(Obj, ''); { === Modified === }
try
...
WAIT_OBJECT_0:
begin
WSAResetEvent(Event);
...
if FInterpreter.DisconnectOnComplete then //添加的兩行代碼，DisconnectOnComplete在此運用
FTransport.Connected := False;
end;
WAIT_OBJECT_0 + 1:
...
finally
FInterpreter.Free;
FInterpreter := nil;
end;
...
end;
procedure CreateItem(ID: Integer);
var
SH: TSocketDispatcher;
begin
SH := TSocketDispatcher.Create(nil);
SH.DataBlockInterpreterClass:=TDataBlockInterpreter; { === New === }
...
end;