mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-19 06:49:16 +02:00
* Applied patch from Ondrej to bring it in sync with bugreport version
git-svn-id: trunk@31890 -
This commit is contained in:
michael
parent
8aa5a6e63b
commit
35a46aa5be
@ -2,7 +2,13 @@
|
||||
This file is part of the Free Component Library (FCL)
|
||||
Copyright (c) 2015 by Ondrej Pokorny
|
||||
|
||||
Unit implementing two-way (request/response) IPC between 1 server and more clients, based on files.
|
||||
Unit implementing two-way (request/response) IPC between 1 server and more
|
||||
clients, based on files.
|
||||
The order of message processing is not deterministic (if there are more
|
||||
pending messages, the server won't process them in the order they have
|
||||
been sent to the server.
|
||||
SendRequest and PostRequest+PeekResponse sequences from 1 client are
|
||||
blocking and processed in correct order.
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
@ -27,13 +33,14 @@ uses
|
||||
sysutils, Classes;
|
||||
|
||||
const
|
||||
HEADER_VERSION = 1;
|
||||
HEADER_VERSION = 2;
|
||||
|
||||
type
|
||||
TMessageType = LongInt;
|
||||
TMessageHeader = packed record
|
||||
HeaderVersion: Integer;
|
||||
HeaderVersion: Byte;
|
||||
FileLock: Byte;//0 = unlocked, 1 = locked
|
||||
MsgType: Integer;
|
||||
MsgType: TMessageType;
|
||||
MsgLen: Integer;
|
||||
MsgVersion: Integer;
|
||||
end;
|
||||
@ -45,47 +52,58 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
TIPCBase = class
|
||||
TIPCBase = class(TComponent)
|
||||
private
|
||||
FGlobal: Boolean;
|
||||
FFileName: string;
|
||||
FServerName: string;
|
||||
FServerID: string;
|
||||
FMessageVersion: Integer;
|
||||
protected
|
||||
class function ServerNameToFileName(const aServerName: string; const aGlobal: Boolean): string;
|
||||
class function ServerIDToFileName(const aServerID: string; const aGlobal: Boolean): string;
|
||||
function GetResponseFileName(const aMsgID: Integer): string;
|
||||
function GetResponseFileName(const aRequestFileName: string): string;
|
||||
function GetPeekedRequestFileName(const aMsgID: Integer): string;
|
||||
function GetPeekedRequestFileName(const aRequestFileName: string): string;
|
||||
function GetRequestPrefix: string;
|
||||
function GetRequestFileName(const aMsgID: Integer): string;
|
||||
function RequestFileNameToMsgID(const aFileName: string): Integer;
|
||||
|
||||
function GetUniqueRequest(out outFileName: string): Integer;
|
||||
procedure SetServerName(const aServerName: string); virtual;
|
||||
procedure SetServerID(const aServerID: string); virtual;
|
||||
procedure SetGlobal(const aGlobal: Boolean); virtual;
|
||||
|
||||
function CanReadMessage(const aFileName: string; out outStream: TStream; out outMsgType, outMsgLen: Integer): Boolean;
|
||||
procedure DoPostMessage(const aFileName: string; const aMsgType: Integer; const aStream: TStream);
|
||||
function CanReadMessage(const aFileName: string; out outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer): Boolean;
|
||||
procedure DoPostMessage(const aFileName: string; const aMsgType: TMessageType; const aStream: TStream);
|
||||
|
||||
property FileName: string read FFileName;
|
||||
public
|
||||
constructor Create; virtual;
|
||||
class procedure FindRunningServers(const aServerIDPrefix: string;
|
||||
const outServerIDs: TStrings; const aGlobal: Boolean = False);
|
||||
class function ServerRunning(const aServerID: string; const aGlobal: Boolean = False): Boolean; overload;
|
||||
public
|
||||
class procedure FindRunningServers(const aServerNamePrefix: string;
|
||||
const outServerNames: TStrings; const aGlobal: Boolean = False);
|
||||
class function ServerIsRunning(const aServerName: string; const aGlobal: Boolean = False): Boolean;
|
||||
property ServerName: string read FServerName write SetServerName;
|
||||
//ServerID: name/ID of the server. Use only ['a'..'z', 'A'..'Z', '_'] characters
|
||||
property ServerID: string read FServerID write SetServerID;
|
||||
//Global: if true, processes from different users can communicate; false, processes only from current users can communicate
|
||||
property Global: Boolean read FGlobal write SetGlobal;
|
||||
//MessageVersion: only messages with the same MessageVersion can be delivered between server/client
|
||||
property MessageVersion: Integer read FMessageVersion write FMessageVersion;
|
||||
end;
|
||||
|
||||
TIPCClient = class(TIPCBase)
|
||||
var
|
||||
private
|
||||
FLastMsgFileName: string;
|
||||
public
|
||||
function PostRequest(const aMsgType: Integer; const aStream: TStream): Integer;//returns ID
|
||||
function PeekResponse(const aStream: TStream; var outMsgType: Integer; const aTimeOut: Integer): Boolean;
|
||||
//post request to server, do not wait until request is peeked; returns request ID
|
||||
function PostRequest(const aMsgType: TMessageType; const aStream: TStream): Integer;
|
||||
//send request to server, wait until request is peeked; returns True if request was peeked within the aTimeOut limit
|
||||
function SendRequest(const aMsgType: TMessageType; const aStream: TStream; const aTimeOut: Integer): Boolean;
|
||||
function SendRequest(const aMsgType: TMessageType; const aStream: TStream; const aTimeOut: Integer; out outRequestID: Integer): Boolean;
|
||||
//peek a response from last request from this client
|
||||
function PeekResponse(const aStream: TStream; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
|
||||
//delete last request from this client
|
||||
procedure DeleteRequest;
|
||||
function ServerRunning: Boolean;
|
||||
//check if server is running
|
||||
function ServerRunning: Boolean; overload;
|
||||
end;
|
||||
|
||||
TIPCServer = class(TIPCBase)
|
||||
@ -93,33 +111,55 @@ type
|
||||
FFileHandle: TFileHandle;
|
||||
FActive: Boolean;
|
||||
|
||||
function FindFirstRequest(out outFileName: string; out outStream: TStream; out outMsgType, outMsgLen: Integer): Integer;
|
||||
function FindFirstRequest(out outFileName: string; out outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer): Integer;
|
||||
|
||||
protected
|
||||
procedure SetServerName(const aServerName: string); override;
|
||||
procedure SetServerID(const aServerID: string); override;
|
||||
procedure SetGlobal(const aGlobal: Boolean); override;
|
||||
public
|
||||
constructor Create; override;
|
||||
constructor Create(aOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
public
|
||||
function PeekRequest(const aStream: TStream; var outMsgType: Integer): Boolean; overload;
|
||||
function PeekRequest(const aStream: TStream; var outMsgID, outMsgType: Integer): Boolean; overload;
|
||||
function PeekRequest(const aStream: TStream; var outMsgID, outMsgType: Integer; const aTimeOut: Integer): Boolean; overload;
|
||||
procedure PostResponse(const aMsgID: Integer; const aMsgType: Integer; const aStream: TStream);
|
||||
//peek request and read the message into a stream
|
||||
function PeekRequest(const aStream: TStream; out outMsgType: TMessageType): Boolean; overload;
|
||||
function PeekRequest(const aStream: TStream; out outMsgID: Integer; out outMsgType: TMessageType): Boolean; overload;
|
||||
function PeekRequest(const aStream: TStream; out outMsgID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
|
||||
//only peek request, you have to read/delete the request manually with ReadRequest/DeleteRequest
|
||||
function PeekRequest(out outMsgType: TMessageType): Boolean; overload;
|
||||
function PeekRequest(out outMsgID: Integer; out outMsgType: TMessageType): Boolean; overload;
|
||||
function PeekRequest(out outMsgID: Integer; out outMsgType: TMessageType; const aTimeOut: Integer): Boolean; overload;
|
||||
//read a peeked request (that hasn't been read yet)
|
||||
function ReadRequest(const aMsgID: Integer; const aStream: TStream): Boolean;
|
||||
//delete a peeked request (that hasn't been read yet)
|
||||
procedure DeleteRequest(const aMsgID: Integer);
|
||||
|
||||
//post response to a request
|
||||
procedure PostResponse(const aMsgID: Integer; const aMsgType: TMessageType; const aStream: TStream);
|
||||
|
||||
//find the highest request ID from all pending requests
|
||||
function FindHighestPendingRequestId: Integer;
|
||||
//get the pending request count
|
||||
function GetPendingRequestCount: Integer;
|
||||
|
||||
function StartServer(const aDeletePendingRequests: Boolean = True): Boolean;//returns true if unique and started
|
||||
function StopServer(const aDeletePendingRequests: Boolean = True): Boolean;//returns true if stopped
|
||||
//start server: returns true if unique and started
|
||||
function StartServer(const aDeletePendingRequests: Boolean = True): Boolean;
|
||||
//stop server: returns true if stopped
|
||||
function StopServer(const aDeletePendingRequests: Boolean = True): Boolean;
|
||||
|
||||
//delete all pending requests and responses
|
||||
procedure DeletePendingRequests;
|
||||
|
||||
property Active: Boolean read FActive;//true if started
|
||||
public
|
||||
//true if server runs (was started)
|
||||
property Active: Boolean read FActive;
|
||||
end;
|
||||
|
||||
EICPException = class(Exception);
|
||||
|
||||
resourcestring
|
||||
SErrInvalidServerID = 'Invalid server ID "%s". Please use only alphanumerical characters and underlines.';
|
||||
SErrSetGlobalActive = 'You cannot change the global property when the server is active.';
|
||||
SErrSetServerIDActive = 'You cannot change the server ID when the server is active.';
|
||||
|
||||
implementation
|
||||
|
||||
const
|
||||
@ -132,7 +172,8 @@ const
|
||||
{ TIPCBase }
|
||||
|
||||
function TIPCBase.CanReadMessage(const aFileName: string; out
|
||||
outStream: TStream; out outMsgType, outMsgLen: Integer): Boolean;
|
||||
outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
|
||||
): Boolean;
|
||||
var
|
||||
xFileHandle: TFileHandle;
|
||||
xHeader: TMessageHeader;
|
||||
@ -172,11 +213,6 @@ begin
|
||||
outMsgLen := xHeader.MsgLen;
|
||||
end;
|
||||
|
||||
constructor TIPCBase.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
end;
|
||||
|
||||
function TIPCBase.GetUniqueRequest(out outFileName: string): Integer;
|
||||
begin
|
||||
Randomize;
|
||||
@ -186,13 +222,13 @@ begin
|
||||
until not FileExists(outFileName);
|
||||
end;
|
||||
|
||||
class function TIPCBase.ServerIsRunning(const aServerName: string;
|
||||
class function TIPCBase.ServerRunning(const aServerID: string;
|
||||
const aGlobal: Boolean): Boolean;
|
||||
var
|
||||
xServerFileHandle: TFileHandle;
|
||||
xFileName: String;
|
||||
begin
|
||||
xFileName := ServerNameToFileName(aServerName, aGlobal);
|
||||
xFileName := ServerIDToFileName(aServerID, aGlobal);
|
||||
Result := FileExists(xFileName);
|
||||
if Result then
|
||||
begin//+ check -> we should not be able to access the file
|
||||
@ -203,10 +239,10 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
class function TIPCBase.ServerNameToFileName(const aServerName: string;
|
||||
class function TIPCBase.ServerIDToFileName(const aServerID: string;
|
||||
const aGlobal: Boolean): string;
|
||||
begin
|
||||
Result := GetTempDir(aGlobal)+aServerName;
|
||||
Result := GetTempDir(aGlobal)+aServerID;
|
||||
end;
|
||||
|
||||
procedure TIPCBase.SetGlobal(const aGlobal: Boolean);
|
||||
@ -214,11 +250,11 @@ begin
|
||||
if FGlobal = aGlobal then Exit;
|
||||
|
||||
FGlobal := aGlobal;
|
||||
FFileName := ServerNameToFileName(FServerName, FGlobal);
|
||||
FFileName := ServerIDToFileName(FServerID, FGlobal);
|
||||
end;
|
||||
|
||||
procedure TIPCBase.DoPostMessage(const aFileName: string;
|
||||
const aMsgType: Integer; const aStream: TStream);
|
||||
const aMsgType: TMessageType; const aStream: TStream);
|
||||
var
|
||||
xHeader: TMessageHeader;
|
||||
xStream: TFileStream;
|
||||
@ -226,13 +262,17 @@ begin
|
||||
xHeader.HeaderVersion := HEADER_VERSION;
|
||||
xHeader.FileLock := 1;//locking
|
||||
xHeader.MsgType := aMsgType;
|
||||
xHeader.MsgLen := aStream.Size-aStream.Position;
|
||||
if Assigned(aStream) then
|
||||
xHeader.MsgLen := aStream.Size-aStream.Position
|
||||
else
|
||||
xHeader.MsgLen := 0;
|
||||
xHeader.MsgVersion := MessageVersion;
|
||||
|
||||
xStream := TFileStream.Create(aFileName, fmCreate or fmShareExclusive, GLOBAL_RIGHTS);
|
||||
try
|
||||
xStream.WriteBuffer(xHeader, SizeOf(xHeader));
|
||||
xStream.CopyFrom(aStream, 0);
|
||||
if Assigned(aStream) then
|
||||
xStream.CopyFrom(aStream, 0);
|
||||
|
||||
xStream.Position := 0;//unlocking
|
||||
xHeader.FileLock := 0;
|
||||
@ -244,29 +284,42 @@ end;
|
||||
|
||||
function TIPCBase.RequestFileNameToMsgID(const aFileName: string): Integer;
|
||||
begin
|
||||
if Length(aFileName) > 8 then
|
||||
//the function prevents all responses/temp files to be handled
|
||||
//only valid response files are returned
|
||||
if (Length(aFileName) > 9) and (aFileName[Length(aFileName)-8] = '-') then
|
||||
Result := StrToIntDef('$'+Copy(aFileName, Length(aFileName)-7, 8), -1)
|
||||
else
|
||||
Result := -1;
|
||||
end;
|
||||
|
||||
class procedure TIPCBase.FindRunningServers(const aServerNamePrefix: string;
|
||||
const outServerNames: TStrings; const aGlobal: Boolean);
|
||||
class procedure TIPCBase.FindRunningServers(const aServerIDPrefix: string;
|
||||
const outServerIDs: TStrings; const aGlobal: Boolean);
|
||||
var
|
||||
xRec: TRawByteSearchRec;
|
||||
begin
|
||||
if FindFirst(ServerNameToFileName(aServerNamePrefix+'*', aGlobal), faAnyFile, xRec) = 0 then
|
||||
if FindFirst(ServerIDToFileName(aServerIDPrefix+'*', aGlobal), faAnyFile, xRec) = 0 then
|
||||
begin
|
||||
repeat
|
||||
if (Pos('_', xRec.Name) = 0) and//file that we found is not pending a message
|
||||
ServerIsRunning(xRec.Name)
|
||||
if (Pos('-', xRec.Name) = 0) and//file that we found is a pending message
|
||||
ServerRunning(xRec.Name, aGlobal)
|
||||
then
|
||||
outServerNames.Add(xRec.Name);
|
||||
outServerIDs.Add(xRec.Name);
|
||||
until FindNext(xRec) <> 0;
|
||||
end;
|
||||
FindClose(xRec);
|
||||
end;
|
||||
|
||||
function TIPCBase.GetPeekedRequestFileName(const aMsgID: Integer): string;
|
||||
begin
|
||||
Result := GetPeekedRequestFileName(GetRequestFileName(aMsgID));
|
||||
end;
|
||||
|
||||
function TIPCBase.GetPeekedRequestFileName(const aRequestFileName: string
|
||||
): string;
|
||||
begin
|
||||
Result := aRequestFileName+'-t';
|
||||
end;
|
||||
|
||||
function TIPCBase.GetRequestFileName(const aMsgID: Integer): string;
|
||||
begin
|
||||
Result := GetRequestPrefix+IntToHex(aMsgID, 8);
|
||||
@ -274,7 +327,7 @@ end;
|
||||
|
||||
function TIPCBase.GetRequestPrefix: string;
|
||||
begin
|
||||
Result := FFileName+'_';
|
||||
Result := FFileName+'-';
|
||||
end;
|
||||
|
||||
function TIPCBase.GetResponseFileName(const aMsgID: Integer): string;
|
||||
@ -284,22 +337,22 @@ end;
|
||||
|
||||
function TIPCBase.GetResponseFileName(const aRequestFileName: string): string;
|
||||
begin
|
||||
Result := aRequestFileName+'_r';
|
||||
Result := aRequestFileName+'-r';
|
||||
end;
|
||||
|
||||
procedure TIPCBase.SetServerName(const aServerName: string);
|
||||
procedure TIPCBase.SetServerID(const aServerID: string);
|
||||
var
|
||||
I: Integer;
|
||||
begin
|
||||
if FServerName = aServerName then Exit;
|
||||
if FServerID = aServerID then Exit;
|
||||
|
||||
for I := 1 to Length(aServerName) do
|
||||
if not (aServerName[I] in ['a'..'z', 'A'..'Z', '0'..'9']) then
|
||||
raise EICPException.Create('You cannot use the "_" character in server name.');
|
||||
for I := 1 to Length(aServerID) do
|
||||
if not (aServerID[I] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) then
|
||||
raise EICPException.CreateFmt(SErrInvalidServerID , [aServerID]);
|
||||
|
||||
FServerName := aServerName;
|
||||
FServerID := aServerID;
|
||||
|
||||
FFileName := ServerNameToFileName(FServerName, FGlobal);
|
||||
FFileName := ServerIDToFileName(FServerID, FGlobal);
|
||||
end;
|
||||
|
||||
{ TIPCClient }
|
||||
@ -310,8 +363,8 @@ begin
|
||||
FLastMsgFileName := '';
|
||||
end;
|
||||
|
||||
function TIPCClient.PeekResponse(const aStream: TStream;
|
||||
var outMsgType: Integer; const aTimeOut: Integer): Boolean;
|
||||
function TIPCClient.PeekResponse(const aStream: TStream; out
|
||||
outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
|
||||
var
|
||||
xStart: QWord;
|
||||
xStream: TStream;
|
||||
@ -319,7 +372,6 @@ var
|
||||
xFileResponse: string;
|
||||
begin
|
||||
aStream.Size := 0;
|
||||
outMsgType := -1;
|
||||
Result := False;
|
||||
xStart := GetTickCount64;
|
||||
repeat
|
||||
@ -337,17 +389,45 @@ begin
|
||||
until (GetTickCount64-xStart > aTimeOut);
|
||||
end;
|
||||
|
||||
function TIPCClient.PostRequest(const aMsgType: Integer; const aStream: TStream
|
||||
): Integer;
|
||||
function TIPCClient.PostRequest(const aMsgType: TMessageType;
|
||||
const aStream: TStream): Integer;
|
||||
begin
|
||||
Result := GetUniqueRequest(FLastMsgFileName);
|
||||
DeleteFile(GetResponseFileName(FLastMsgFileName));//delete old response, if there is any
|
||||
DoPostMessage(FLastMsgFileName, aMsgType, aStream);
|
||||
end;
|
||||
|
||||
function TIPCClient.SendRequest(const aMsgType: TMessageType;
|
||||
const aStream: TStream; const aTimeOut: Integer): Boolean;
|
||||
var
|
||||
xRequestID: Integer;
|
||||
begin
|
||||
Result := SendRequest(aMsgType, aStream, aTimeOut, xRequestID);
|
||||
end;
|
||||
|
||||
function TIPCClient.SendRequest(const aMsgType: TMessageType;
|
||||
const aStream: TStream; const aTimeOut: Integer; out outRequestID: Integer
|
||||
): Boolean;
|
||||
var
|
||||
xStart: QWord;
|
||||
xRequestFileName: string;
|
||||
begin
|
||||
outRequestID := PostRequest(aMsgType, aStream);
|
||||
Result := False;
|
||||
|
||||
xRequestFileName := GetRequestFileName(outRequestID);
|
||||
xStart := GetTickCount64;
|
||||
repeat
|
||||
if not FileExists(xRequestFileName) then
|
||||
Exit(True)
|
||||
else if aTimeOut > 20 then
|
||||
Sleep(10);
|
||||
until (GetTickCount64-xStart > aTimeOut);
|
||||
end;
|
||||
|
||||
function TIPCClient.ServerRunning: Boolean;
|
||||
begin
|
||||
Result := ServerIsRunning(ServerName);
|
||||
Result := ServerRunning(ServerID, Global);
|
||||
end;
|
||||
|
||||
{ TReleaseHandleStream }
|
||||
@ -376,9 +456,14 @@ begin
|
||||
FindClose(xRec);
|
||||
end;
|
||||
|
||||
constructor TIPCServer.Create;
|
||||
procedure TIPCServer.DeleteRequest(const aMsgID: Integer);
|
||||
begin
|
||||
inherited Create;
|
||||
DeleteFile(GetPeekedRequestFileName(aMsgID));
|
||||
end;
|
||||
|
||||
constructor TIPCServer.Create(aOwner: TComponent);
|
||||
begin
|
||||
inherited Create(aOwner);
|
||||
|
||||
FFileHandle := feInvalidHandle;
|
||||
end;
|
||||
@ -392,7 +477,8 @@ begin
|
||||
end;
|
||||
|
||||
function TIPCServer.FindFirstRequest(out outFileName: string; out
|
||||
outStream: TStream; out outMsgType, outMsgLen: Integer): Integer;
|
||||
outStream: TStream; out outMsgType: TMessageType; out outMsgLen: Integer
|
||||
): Integer;
|
||||
var
|
||||
xRec: TRawByteSearchRec;
|
||||
begin
|
||||
@ -452,70 +538,111 @@ begin
|
||||
FindClose(xRec);
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; var outMsgID,
|
||||
outMsgType: Integer): Boolean;
|
||||
function TIPCServer.PeekRequest(out outMsgID: Integer; out
|
||||
outMsgType: TMessageType): Boolean;
|
||||
var
|
||||
xStream: TStream;
|
||||
xMsgLen: Integer;
|
||||
xMsgFileName: string;
|
||||
begin
|
||||
aStream.Size := 0;
|
||||
outMsgType := -1;
|
||||
xMsgFileName := '';
|
||||
outMsgID := FindFirstRequest(xMsgFileName, xStream, outMsgType, xMsgLen);
|
||||
Result := outMsgID >= 0;
|
||||
if Result then
|
||||
begin
|
||||
aStream.CopyFrom(xStream, xMsgLen);
|
||||
aStream.Position := 0;
|
||||
xStream.Free;
|
||||
DeleteFile(xMsgFileName);
|
||||
RenameFile(xMsgFileName, GetPeekedRequestFileName(xMsgFileName));
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; var outMsgID,
|
||||
outMsgType: Integer; const aTimeOut: Integer): Boolean;
|
||||
function TIPCServer.PeekRequest(out outMsgID: Integer; out
|
||||
outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
|
||||
var
|
||||
xStart: QWord;
|
||||
begin
|
||||
Result := False;
|
||||
xStart := GetTickCount64;
|
||||
repeat
|
||||
if PeekRequest(aStream, outMsgID, outMsgType) then
|
||||
if PeekRequest(outMsgID, outMsgType) then
|
||||
Exit(True)
|
||||
else if aTimeOut > 20 then
|
||||
Sleep(10);
|
||||
until (GetTickCount64-xStart > aTimeOut);
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; var outMsgType: Integer
|
||||
): Boolean;
|
||||
function TIPCServer.PeekRequest(out outMsgType: TMessageType): Boolean;
|
||||
var
|
||||
xMsgID: Integer;
|
||||
begin
|
||||
Result := PeekRequest(aStream, xMsgID{%H-}, outMsgType);
|
||||
Result := PeekRequest(xMsgID, outMsgType);
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; out outMsgID: Integer;
|
||||
out outMsgType: TMessageType): Boolean;
|
||||
begin
|
||||
Result := PeekRequest(outMsgID, outMsgType);
|
||||
if Result then
|
||||
Result := ReadRequest(outMsgID, aStream);
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; out outMsgID: Integer;
|
||||
out outMsgType: TMessageType; const aTimeOut: Integer): Boolean;
|
||||
begin
|
||||
Result := PeekRequest(outMsgID, outMsgType, aTimeOut);
|
||||
if Result then
|
||||
Result := ReadRequest(outMsgID, aStream);
|
||||
end;
|
||||
|
||||
function TIPCServer.PeekRequest(const aStream: TStream; out
|
||||
outMsgType: TMessageType): Boolean;
|
||||
var
|
||||
xMsgID: Integer;
|
||||
begin
|
||||
Result := PeekRequest(aStream, xMsgID, outMsgType);
|
||||
end;
|
||||
|
||||
procedure TIPCServer.PostResponse(const aMsgID: Integer;
|
||||
const aMsgType: Integer; const aStream: TStream);
|
||||
const aMsgType: TMessageType; const aStream: TStream);
|
||||
begin
|
||||
DoPostMessage(GetResponseFileName(aMsgID), aMsgType, aStream);
|
||||
end;
|
||||
|
||||
function TIPCServer.ReadRequest(const aMsgID: Integer; const aStream: TStream
|
||||
): Boolean;
|
||||
var
|
||||
xStream: TStream;
|
||||
xMsgLen: Integer;
|
||||
xMsgType: TMessageType;
|
||||
xFileRequest: string;
|
||||
begin
|
||||
aStream.Size := 0;
|
||||
xFileRequest := GetPeekedRequestFileName(aMsgID);
|
||||
Result := CanReadMessage(xFileRequest, xStream, xMsgType, xMsgLen);
|
||||
if Result then
|
||||
begin
|
||||
aStream.CopyFrom(xStream, xMsgLen);
|
||||
xStream.Free;
|
||||
aStream.Position := 0;
|
||||
DeleteFile(xFileRequest);
|
||||
Exit(True);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIPCServer.SetGlobal(const aGlobal: Boolean);
|
||||
begin
|
||||
if Active then
|
||||
raise EICPException.Create('You cannot change the global property when the server is active.');
|
||||
raise EICPException.Create(SErrSetGlobalActive);
|
||||
|
||||
inherited SetGlobal(aGlobal);
|
||||
end;
|
||||
|
||||
procedure TIPCServer.SetServerName(const aServerName: string);
|
||||
procedure TIPCServer.SetServerID(const aServerID: string);
|
||||
begin
|
||||
if Active then
|
||||
raise EICPException.Create('You cannot change the server name when the server is active.');
|
||||
raise EICPException.Create(SErrSetServerIDActive);
|
||||
|
||||
inherited SetServerName(aServerName);
|
||||
inherited SetServerID(aServerID);
|
||||
end;
|
||||
|
||||
function TIPCServer.StartServer(const aDeletePendingRequests: Boolean): Boolean;
|
||||
@ -534,7 +661,7 @@ begin
|
||||
|
||||
if FFileHandle<>feInvalidHandle then
|
||||
FileClose(FFileHandle);
|
||||
DeleteFile(FFileName);
|
||||
Result := DeleteFile(FFileName);
|
||||
FFileName := '';
|
||||
|
||||
if aDeletePendingRequests then
|
||||
|
||||
Loading…
Reference in New Issue
Block a user