1120 lines
28 KiB
Plaintext
1120 lines
28 KiB
Plaintext
{*******************************************************}
|
|
{ }
|
|
{ Tocsg.Process.IPC }
|
|
{ }
|
|
{ Copyright (C) 2023 kku }
|
|
{ }
|
|
{*******************************************************}
|
|
|
|
unit Tocsg.Process.IPC;
|
|
|
|
interface
|
|
|
|
uses
|
|
Tocsg.Obj, System.Classes, System.SysUtils, Winapi.Windows,
|
|
Winapi.Messages, System.Generics.Collections, System.SyncObjs, Tocsg.Packet,
|
|
Tocsg.Exception;
|
|
|
|
const
|
|
WM_WND_HANDSHAKE = WM_USER + 4632;
|
|
|
|
W2W_SENDFILE_INIT = 10;
|
|
W2W_SENDFILE_DATA = 11;
|
|
W2W_SENDFILE_COMPLETE = 12;
|
|
|
|
type
|
|
PWndDataEnt = ^TWndDataEnt;
|
|
TWndDataEnt = record
|
|
llSender: LONGLONG;
|
|
pBuf: Pointer;
|
|
dwLen,
|
|
dwData: DWORD;
|
|
end;
|
|
TWndDataEntQueue = TQueue<PWndDataEnt>;
|
|
|
|
PW2wLinkProc = ^TW2wLinkProc;
|
|
TW2wLinkProc = record
|
|
// dwPid: DWORD;
|
|
hRcvWnd: HWND;
|
|
end;
|
|
TW2wLinkProcList = class(TList<PW2wLinkProc>)
|
|
protected
|
|
procedure Notify(const Item: PW2wLinkProc; Action: TCollectionNotification); override;
|
|
end;
|
|
TW2wLinkProcEnumerator = TEnumerator<PW2wLinkProc>;
|
|
|
|
TW2wConnState = (wcsConnect, wcsDisconnect);
|
|
TEventWnd2WndConnection = procedure(Sender: TTgObject; aState: TW2wConnState; hRcvWnd: HWND) of object;
|
|
TTgWnd2Wnd = class(TTgObject)
|
|
private
|
|
CS_: TCriticalSection;
|
|
hRcvWnd_: HWND;
|
|
qDataEnts_: TWndDataEntQueue;
|
|
evW2WConnected_: TEventWnd2WndConnection;
|
|
// {$IFDEF _IPC_TEST_}
|
|
// LinkProcList_: TW2wLinkProcList;
|
|
// procedure AddLinkProc(hRcvWnd: HWND);
|
|
// {$ENDIF}
|
|
procedure Lock;
|
|
procedure Unlock;
|
|
procedure OnWndDataNotify(Sender: TObject; const Item: PWndDataEnt; Action: TCollectionNotification);
|
|
procedure SetEventW2WConnected(evVal: TEventWnd2WndConnection);
|
|
procedure ProcessWindowMessage(var msg: TMessage); virtual;
|
|
public
|
|
Constructor Create(sClassName: String; hInst: HMODULE = 0);
|
|
Destructor Destroy; override;
|
|
|
|
procedure ClearQueue;
|
|
function DeququeData: PWndDataEnt;
|
|
function SendData(hTargetWnd: HWND; pBuf: Pointer; dwLen: DWORD; dwData: DWORD = 0): Boolean; overload;
|
|
function SendData(hTargetWnd: HWND; aSend: ISendPacket; dwData: DWORD = 0): Boolean; overload;
|
|
function SendData(hTargetWnd: HWND; sSend: String; dwData: DWORD = 0): Boolean; overload;
|
|
|
|
// {$IFDEF _IPC_TEST_}
|
|
// function GetLinkProcEnumerator: TW2wLinkProcEnumerator;
|
|
// {$ENDIF}
|
|
|
|
property RcWnd: HWND read hRcvWnd_;
|
|
property OnW2WConnection: TEventWnd2WndConnection write SetEventW2WConnected;
|
|
end;
|
|
|
|
// ....\DropBox\....\네임드 파이프 (NamedPipe)\NamedPipeExchange-master.zip 참조
|
|
const
|
|
MaxBuffSize = MAXWORD;
|
|
|
|
BLOCK_BUF_LEN = 60000;
|
|
|
|
type
|
|
ETgNamedPipe = class(ETgException);
|
|
TTgNpBase = class;
|
|
TEventNpNotification = procedure(Sender: TTgNpBase; hPipe: THandle) of object;
|
|
|
|
TTgNpBase = class(TTgObject)
|
|
protected
|
|
bIsServer_: Boolean;
|
|
sPipeName_: String;
|
|
evConnected_: TEventNpNotification;
|
|
evDisconnected_: TEventNpNotification;
|
|
procedure ProcessFail(hPipe: THandle); virtual; abstract;
|
|
function _SendData(hTgPipe: THandle; pData: Pointer; dwLen: DWORD): Boolean;
|
|
function _RcvData(hTgPipe: THandle; var pBuf: TBytes): DWORD;
|
|
public
|
|
Constructor Create(sPipeName: String); virtual;
|
|
|
|
// function SendData(sData: UTF8String): Boolean; overload;
|
|
function SendData(aSend: ISendPacket): Boolean; virtual; abstract;
|
|
function RcvData(var pBuf: TBytes): DWORD; virtual; abstract;
|
|
|
|
property IsServer: Boolean read bIsServer_;
|
|
property PipeName: String read sPipeName_;
|
|
property OnConnected: TEventNpNotification write evConnected_;
|
|
property OnDisconnected: TEventNpNotification write evDisconnected_;
|
|
end;
|
|
|
|
TClientPipeList = TList<THandle>;
|
|
TTgNpServer = class(TTgNpBase)
|
|
private
|
|
bActive_: Boolean;
|
|
hEvent_: THandle;
|
|
hWaitPipe_: THandle;
|
|
ConnOvrl_: TOverlapped;
|
|
PipeList_: TClientPipeList;
|
|
CS_: TCriticalSection;
|
|
enumRcv_: TEnumerator<THandle>;
|
|
hLastRcvPipe_: THandle;
|
|
|
|
procedure Lock;
|
|
procedure Unlock;
|
|
procedure OnClientPipeNotify(Sender: TObject; const Item: THandle; Action: TCollectionNotification);
|
|
function CreatePipeInstance(out hPipe: THandle; bAsync: Boolean = false): Boolean;
|
|
procedure SetPipeClientEnt(hPipe: THandle);
|
|
protected
|
|
procedure ProcessFail(hPipe: THandle); override;
|
|
public
|
|
Constructor Create(sPipeName: String); override;
|
|
Destructor Destroy; override;
|
|
|
|
function Listen: Boolean;
|
|
procedure Close;
|
|
function DoAcceptPipe: Boolean;
|
|
|
|
function SendData(aSend: ISendPacket): Boolean; override;
|
|
function RcvData(var pBuf: TBytes): DWORD; override;
|
|
|
|
property Active: Boolean read bActive_;
|
|
property LastRcvPipe: THandle read hLastRcvPipe_;
|
|
end;
|
|
|
|
TTgNpClient = class(TTgNpBase)
|
|
private
|
|
bConnected_: Boolean;
|
|
hConnPipe_: THandle;
|
|
protected
|
|
procedure ProcessFail(hPipe: THandle); override;
|
|
public
|
|
Constructor Create(sPipeName: String); override;
|
|
Destructor Destroy; override;
|
|
|
|
function Connect: Boolean;
|
|
procedure Disconnect;
|
|
|
|
function SendData(aSend: ISendPacket): Boolean; override;
|
|
function RcvData(var pBuf: TBytes): DWORD; override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Tocsg.Param, Tocsg.Safe;
|
|
|
|
{ TW2wLinkProcList }
|
|
|
|
procedure TW2wLinkProcList.Notify(const Item: PW2wLinkProc; Action: TCollectionNotification);
|
|
begin
|
|
case Action of
|
|
cnAdded: ;
|
|
cnRemoved: Dispose(Item);
|
|
cnExtracted: ;
|
|
end;
|
|
end;
|
|
|
|
{ TTgWnd2Wnd }
|
|
|
|
function AllocateHWnd_kku(const AMethod: TWndMethod; sClassName: String; hInst: HMODULE): HWND;
|
|
var
|
|
UtilWindowClass, TempClass: TWndClass;
|
|
ClassRegistered: Boolean;
|
|
begin
|
|
Result := 0;
|
|
try
|
|
ZeroMemory(@UtilWindowClass, SizeOf(UtilWindowClass));
|
|
UtilWindowClass.lpfnWndProc := @DefWindowProc;
|
|
UtilWindowClass.lpszClassName := PChar(sClassName);
|
|
UtilWindowClass.hInstance := HInstance;
|
|
// UtilWindowClass.cbWndExtra := SizeOf(TMethod);
|
|
|
|
ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
|
|
TempClass);
|
|
if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
|
|
begin
|
|
if ClassRegistered then
|
|
Winapi.Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
|
|
Winapi.Windows.RegisterClass(UtilWindowClass);
|
|
end;
|
|
Result := CreateWindowEx(WS_EX_TOOLWINDOW, UtilWindowClass.lpszClassName,
|
|
'', WS_POPUP {+ 0}, 0, 0, 0, 0, 0, 0, HInstance, nil);
|
|
if Assigned(AMethod) then
|
|
SetWindowLongPtr(Result, GWL_WNDPROC, IntPtr(MakeObjectInstance(AMethod)));
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(E, 'Fail .. AllocateHWnd_kku()');
|
|
end;
|
|
end;
|
|
|
|
Constructor TTgWnd2Wnd.Create(sClassName: String; hInst: HMODULE = 0);
|
|
begin
|
|
CS_ := TCriticalSection.Create;
|
|
Inherited Create;
|
|
|
|
if sClassName = '' then
|
|
sClassName := 'TTgWnd2Wnd';
|
|
|
|
if hInst = 0 then
|
|
hInst := HInstance;
|
|
evW2WConnected_ := nil;
|
|
//{$IFDEF _IPC_TEST_}
|
|
// LinkProcList_ := TW2wLinkProcList.Create;
|
|
//{$ENDIF}
|
|
qDataEnts_ := TWndDataEntQueue.Create;
|
|
|
|
ChangeWindowMessageFilter(WM_WND_HANDSHAKE, MSGFLT_ADD);
|
|
ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
|
|
hRcvWnd_ := AllocateHWnd_kku(ProcessWindowMessage, sClassName, hInst);
|
|
if hRcvWnd_ = 0 then
|
|
begin
|
|
_Trace('Fail .. No Allocate HWND');
|
|
// raise ETgException.Create('Fail .. AllocateHWnd()');
|
|
end;
|
|
end;
|
|
|
|
Destructor TTgWnd2Wnd.Destroy;
|
|
begin
|
|
if hRcvWnd_ <> 0 then
|
|
begin
|
|
DeallocateHWnd(hRcvWnd_);
|
|
hRcvWnd_ := 0;
|
|
end;
|
|
qDataEnts_.OnNotify := OnWndDataNotify;
|
|
FreeAndNil(qDataEnts_);
|
|
//{$IFDEF _IPC_TEST_}
|
|
// FreeAndNil(LinkProcList_);
|
|
//{$ENDIF}
|
|
Inherited;
|
|
FreeAndNil(CS_);
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.Lock;
|
|
begin
|
|
CS_.Acquire;
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.Unlock;
|
|
begin
|
|
CS_.Release;
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.OnWndDataNotify(Sender: TObject; const Item: PWndDataEnt; Action: TCollectionNotification);
|
|
begin
|
|
case Action of
|
|
cnAdded: ;
|
|
cnRemoved:
|
|
begin
|
|
if Item.pBuf <> nil then
|
|
FreeMem(Item.pBuf, Item.dwLen);
|
|
end;
|
|
cnExtracted: ;
|
|
end;
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.SetEventW2WConnected(evVal: TEventWnd2WndConnection);
|
|
begin
|
|
if @evW2WConnected_ <> @evVal then
|
|
evW2WConnected_ := evVal;
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.ClearQueue;
|
|
begin
|
|
Lock;
|
|
qDataEnts_.OnNotify := OnWndDataNotify;
|
|
try
|
|
qDataEnts_.Clear;
|
|
finally
|
|
qDataEnts_.OnNotify := nil;
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TTgWnd2Wnd.DeququeData: PWndDataEnt;
|
|
begin
|
|
Lock;
|
|
try
|
|
if qDataEnts_.Count > 0 then
|
|
Result := qDataEnts_.Dequeue
|
|
else
|
|
Result := nil;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
|
|
function TTgWnd2Wnd.SendData(hTargetWnd: HWND; pBuf: Pointer; dwLen: DWORD; dwData: DWORD = 0): Boolean;
|
|
var
|
|
CD: TCopyDataStruct;
|
|
begin
|
|
if hTargetWnd <> 0 then
|
|
begin
|
|
CD.dwData := dwData;
|
|
CD.cbData := dwLen;
|
|
CD.lpData := pBuf;
|
|
Result := SendMessage(hTargetWnd, WM_COPYDATA, NativeUInt(hRcvWnd_), NativeInt(@CD)) = WM_COPYDATA;
|
|
// Result := SendMessageTimeout(hTargetWnd, WM_COPYDATA, NativeUInt(hRcvWnd_), NativeInt(@CD),
|
|
// SMTO_ABORTIFHUNG, 5000, nil) = WM_COPYDATA;
|
|
end else
|
|
Result := false;
|
|
end;
|
|
|
|
function TTgWnd2Wnd.SendData(hTargetWnd: HWND; aSend: ISendPacket; dwData: DWORD = 0): Boolean;
|
|
var
|
|
sJsonStr: String;
|
|
begin
|
|
sJsonStr := aSend.ToJsonString;
|
|
Result := SendData(hTargetWnd, PChar(sJsonStr), (Length(sJsonStr) + 1) * 2, dwData);
|
|
end;
|
|
|
|
function TTgWnd2Wnd.SendData(hTargetWnd: HWND; sSend: String; dwData: DWORD = 0): Boolean;
|
|
begin
|
|
Result := SendData(hTargetWnd, PChar(sSend), (Length(sSend) + 1) * 2, dwData);
|
|
end;
|
|
|
|
procedure TTgWnd2Wnd.ProcessWindowMessage(var msg: TMessage);
|
|
var
|
|
pCD: PCopyDataStruct;
|
|
pData: PWndDataEnt;
|
|
begin
|
|
try
|
|
case msg.Msg of
|
|
WM_WND_HANDSHAKE :
|
|
begin
|
|
// {$IFDEF _IPC_TEST_}
|
|
// AddLinkProc(msg.LParam);
|
|
// {$ENDIF}
|
|
if Assigned(evW2WConnected_) then
|
|
evW2WConnected_(Self, TW2wConnState(msg.WParam), msg.LParam);
|
|
|
|
msg.Result := WM_WND_HANDSHAKE;
|
|
end;
|
|
WM_COPYDATA :
|
|
begin
|
|
pCD := PCopyDataStruct(msg.LParam);
|
|
if pCD.cbData > 0 then
|
|
begin
|
|
New(pData);
|
|
pData.dwData := pCD.dwData;
|
|
pData.llSender := msg.WParam;
|
|
pData.dwLen := pCD.cbData;
|
|
pData.pBuf := AllocMem(pData.dwLen);
|
|
CopyMemory(pData.pBuf, pCD.lpData, pData.dwLen);
|
|
|
|
// {$IFDEF _IPC_TEST_}
|
|
// if pData.dwData > 0 then
|
|
// begin
|
|
// case pData.dwData of
|
|
// 1 : SendData(pData.llSender, Copy(PChar(pData.pBuf), 1, pData.dwLen), 2);
|
|
// 2 : _Trace(PChar(Copy(PChar(pData.pBuf), 1, pData.dwLen) + ' : DONE'));
|
|
// end;
|
|
// Dispose(pData);
|
|
// exit;
|
|
// end;
|
|
// {$ENDIF}
|
|
|
|
Lock;
|
|
try
|
|
qDataEnts_.Enqueue(pData);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
end;
|
|
msg.Result := WM_COPYDATA; //DefWindowProc(hRcvWnd_, msg.Msg, msg.wParam, msg.lParam);
|
|
end;
|
|
else msg.Result := 0;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. ProcessWindowMessage()');
|
|
end;
|
|
end;
|
|
|
|
//{$IFDEF _IPC_TEST_}
|
|
//procedure TTgWnd2Wnd.AddLinkProc(hRcvWnd: HWND);
|
|
//var
|
|
// pEnt: PW2wLinkProc;
|
|
//begin
|
|
// New(pEnt);
|
|
//// pEnt.dwPid := dwPid;
|
|
// pEnt.hRcvWnd := hRcvWnd;
|
|
// LinkProcList_.Add(pEnt);
|
|
//end;
|
|
//
|
|
//function TTgWnd2Wnd.GetLinkProcEnumerator: TW2wLinkProcEnumerator;
|
|
//begin
|
|
// Result := LinkProcList_.GetEnumerator;
|
|
//end;
|
|
//{$ENDIF}
|
|
|
|
|
|
type
|
|
PACE_HEADER = ^ACE_HEADER;
|
|
{$EXTERNALSYM PACE_HEADER}
|
|
|
|
_ACE_HEADER = record
|
|
AceType: Byte;
|
|
AceFlags: Byte;
|
|
AceSize: Word;
|
|
end;
|
|
{$EXTERNALSYM _ACE_HEADER}
|
|
|
|
ACE_HEADER = _ACE_HEADER;
|
|
{$EXTERNALSYM ACE_HEADER}
|
|
TAceHeader = ACE_HEADER;
|
|
PAceHeader = PACE_HEADER;
|
|
|
|
PACCESS_ALLOWED_ACE = ^ACCESS_ALLOWED_ACE;
|
|
{$EXTERNALSYM PACCESS_ALLOWED_ACE}
|
|
|
|
_ACCESS_ALLOWED_ACE = record
|
|
Header: ACE_HEADER;
|
|
Mask: ACCESS_MASK;
|
|
SidStart: DWORD;
|
|
end;
|
|
{$EXTERNALSYM _ACCESS_ALLOWED_ACE}
|
|
|
|
ACCESS_ALLOWED_ACE = _ACCESS_ALLOWED_ACE;
|
|
{$EXTERNALSYM ACCESS_ALLOWED_ACE}
|
|
TAccessAllowedAce = ACCESS_ALLOWED_ACE;
|
|
PAccessAllowedAce = PACCESS_ALLOWED_ACE;
|
|
|
|
{ TTgNpBase }
|
|
|
|
Constructor TTgNpBase.Create(sPipeName: String);
|
|
begin
|
|
Inherited Create;
|
|
sPipeName_ := sPipeName;
|
|
evConnected_ := nil;
|
|
evDisconnected_ := nil;
|
|
end;
|
|
|
|
//function TTgNpBase.SendData(sData: UTF8String): Boolean;
|
|
//begin
|
|
// Result := SendData(@sData[1], Length(sData) + 1);
|
|
//end;
|
|
|
|
function TTgNpBase._SendData(hTgPipe: THandle; pData: Pointer; dwLen: DWORD): Boolean;
|
|
var
|
|
dwWrote: DWORD;
|
|
pBuf: TBytes;
|
|
dwRead,
|
|
dwReaded: DWORD;
|
|
|
|
Label
|
|
LB_RetryWrite1,
|
|
LB_RetryWrite2;
|
|
|
|
begin
|
|
Result := false;
|
|
if hTgPipe <> 0 then
|
|
begin
|
|
if dwLen = 0 then
|
|
exit;
|
|
|
|
try
|
|
// MAXBUFSIZE = 65535
|
|
{
|
|
PIPEDATA_STX = 'PS!_';
|
|
PIPEDATA_STX_LEN = 4;
|
|
PIPEDATA_ETX = '_!PE';
|
|
PIPEDATA_ETX_LEN = 4;
|
|
}
|
|
if dwLen > BLOCK_BUF_LEN then
|
|
begin
|
|
SetLength(pBuf, MAXWORD);
|
|
|
|
// 전체 크기 미리 보내놓고
|
|
CopyMemory(@pBuf[0], @dwLen, 4);
|
|
Result := WriteFile(hTgPipe, pBuf[0], 4, dwWrote, nil);
|
|
if not Result then
|
|
begin
|
|
if Assigned(evDisconnected_) then
|
|
evDisconnected_(Self, hTgPipe);
|
|
ProcessFail(hTgPipe);
|
|
exit;
|
|
end;
|
|
|
|
// 쪼개서 보낸다.
|
|
dwReaded := 0;
|
|
while dwReaded < dwLen do
|
|
begin
|
|
if (dwLen - dwReaded) > BLOCK_BUF_LEN then
|
|
dwRead := BLOCK_BUF_LEN
|
|
else
|
|
dwRead := dwLen - dwReaded;
|
|
|
|
CopyMemory(@pBuf[0], @dwRead, 4);
|
|
CopyMemory(@pBuf[4], Pointer(LONGLONG(pData) + dwReaded), dwRead);
|
|
LB_RetryWrite1 :
|
|
Result := WriteFile(hTgPipe, pBuf[0], dwRead + 4, dwWrote, nil);
|
|
if Result and (dwWrote = 0) then
|
|
goto LB_RetryWrite1;
|
|
|
|
if not Result then
|
|
begin
|
|
if Assigned(evDisconnected_) then
|
|
evDisconnected_(Self, hTgPipe);
|
|
ProcessFail(hTgPipe);
|
|
exit;
|
|
end;
|
|
if dwWrote > 4 then
|
|
Inc(dwReaded, dwWrote - 4);
|
|
end;
|
|
end else begin
|
|
SetLength(pBuf, dwLen + 4);
|
|
CopyMemory(@pBuf[0], @dwLen, 4);
|
|
CopyMemory(@pBuf[4], pData, dwLen);
|
|
LB_RetryWrite2 :
|
|
Result := WriteFile(hTgPipe, pBuf[0], dwLen + 4, dwWrote, nil);
|
|
if Result and (dwWrote = 0) then
|
|
goto LB_RetryWrite2;
|
|
|
|
if not Result then
|
|
begin
|
|
if Assigned(evDisconnected_) then
|
|
evDisconnected_(Self, hTgPipe);
|
|
ProcessFail(hTgPipe);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgNamedPipe.TraceException(Self, E, 'Fail .. SendData()');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTgNpBase._RcvData(hTgPipe: THandle; var pBuf: TBytes): DWORD;
|
|
var
|
|
dwLen,
|
|
dwWrote,
|
|
dwRead,
|
|
dwReaded: DWORD;
|
|
Label
|
|
LB_RetryRead1,
|
|
LB_RetryRead2;
|
|
begin
|
|
Result := 0;
|
|
if hTgPipe <> 0 then
|
|
begin
|
|
// ReadFile() 은 현재 XE2 문제 인지는 모르겠지만... Return 값이 항상 FALSE로 뜬다.
|
|
// dwWrote 리턴으로 성공 유무를 확인한다. 19_0509 13:56:13 sunk
|
|
dwWrote := 0;
|
|
|
|
ReadFile(hTgPipe, dwLen, 4, dwWrote, nil);
|
|
if dwWrote = 4 then
|
|
begin
|
|
try
|
|
SetLength(pBuf, dwLen);
|
|
except
|
|
exit;
|
|
end;
|
|
|
|
if dwLen > BLOCK_BUF_LEN then
|
|
begin
|
|
// 쪼개서 보낸거 모아서 받자
|
|
dwReaded := 0;
|
|
while dwReaded < dwLen do
|
|
begin
|
|
LB_RetryRead1 :
|
|
ReadFile(hTgPipe, dwRead, 4, dwWrote, nil);
|
|
if dwWrote = 0 then
|
|
goto LB_RetryRead1;
|
|
|
|
if dwWrote <> 4 then
|
|
break;
|
|
|
|
LB_RetryRead2 :
|
|
ReadFile(hTgPipe, pBuf[dwReaded], dwRead, dwWrote, nil);
|
|
if dwWrote = 0 then
|
|
goto LB_RetryRead2;
|
|
|
|
if dwRead <> dwWrote then
|
|
break;
|
|
|
|
Inc(dwReaded, dwWrote);
|
|
end;
|
|
Result := dwReaded;
|
|
end else
|
|
ReadFile(hTgPipe, pBuf[0], dwLen, Result, nil);
|
|
end;
|
|
|
|
// _Trace('_RcvData() .. Error=%d', [GetLastError]);
|
|
case GetLastError of
|
|
234 : ; // 더 많은 데이터가 있습니다.
|
|
232 : ; // 파이프가 닫히는 중입니다.
|
|
233, // 파이프의 다른 끝에 프로세스가 없습니다.
|
|
109 : // 파이프가 끝났습니다.
|
|
begin
|
|
if Assigned(evDisconnected_) then
|
|
evDisconnected_(Self, hTgPipe);
|
|
ProcessFail(hTgPipe);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TTgNamedPipeServer }
|
|
|
|
Constructor TTgNpServer.Create(sPipeName: String);
|
|
begin
|
|
Inherited Create(sPipeName);
|
|
bIsServer_ := true;
|
|
bActive_ := false;
|
|
hEvent_ := 0;
|
|
PipeList_ := TClientPipeList.Create;
|
|
PipeList_.OnNotify := OnClientPipeNotify;
|
|
enumRcv_ := nil;
|
|
hLastRcvPipe_ := 0;
|
|
CS_ := TCriticalSection.Create;
|
|
end;
|
|
|
|
Destructor TTgNpServer.Destroy;
|
|
begin
|
|
if enumRcv_ <> nil then
|
|
FreeAndNil(enumRcv_);
|
|
|
|
Close;
|
|
FreeAndNil(PipeList_);
|
|
|
|
Inherited;
|
|
FreeAndnil(CS_);
|
|
end;
|
|
|
|
procedure TTgNpServer.Lock;
|
|
begin
|
|
CS_.Acquire;
|
|
end;
|
|
|
|
procedure TTgNpServer.Unlock;
|
|
begin
|
|
CS_.Release;
|
|
end;
|
|
|
|
procedure TTgNpServer.OnClientPipeNotify(Sender: TObject; const Item: THandle; Action: TCollectionNotification);
|
|
begin
|
|
try
|
|
if Action = cnRemoved then
|
|
begin
|
|
if (Item <> 0) and (Item <> INVALID_HANDLE_VALUE) then
|
|
begin
|
|
DisconnectNamedPipe(Item);
|
|
CloseHandle(Item);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. OnClientPipeNotify()');
|
|
end;
|
|
end;
|
|
|
|
procedure TTgNpServer.ProcessFail(hPipe: THandle);
|
|
var
|
|
nIdx: Integer;
|
|
begin
|
|
try
|
|
Lock;
|
|
try
|
|
nIdx := PipeList_.IndexOf(hPipe);
|
|
if nIdx <> -1 then
|
|
PipeList_.Delete(nIdx);
|
|
// Close;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. ProcessFail()');
|
|
end;
|
|
end;
|
|
|
|
function TTgNpServer.Listen: Boolean;
|
|
begin
|
|
Result := false;
|
|
|
|
if bActive_ then
|
|
exit;
|
|
|
|
try
|
|
hWaitPipe_ := 0;
|
|
ZeroMemory(@ConnOvrl_, SizeOf(ConnOvrl_));
|
|
|
|
hEvent_ := CreateEvent(nil, true, true, nil);
|
|
if hEvent_ = 0 then
|
|
begin
|
|
_Trace('Fail .. SetActive() .. CreateEvent()');
|
|
exit;
|
|
end;
|
|
|
|
ConnOvrl_.hEvent := hEvent_;
|
|
if not CreatePipeInstance(hWaitPipe_) then
|
|
begin
|
|
_Trace('Fail .. SetActive() .. CreatePipeInstance()');
|
|
Close;
|
|
exit;
|
|
end;
|
|
|
|
bActive_ := true;
|
|
Result := true;
|
|
except
|
|
on E: Exception do
|
|
ETgNamedPipe.TraceException(Self, E, 'Fail .. Listen()');
|
|
end;
|
|
end;
|
|
|
|
procedure TTgNpServer.Close;
|
|
begin
|
|
try
|
|
if not bActive_ then
|
|
exit;
|
|
|
|
bActive_ := false;
|
|
|
|
PipeList_.Clear;
|
|
|
|
// 이거 초기화 하면 크러쉬 되는 문제가 있다...
|
|
// 일반적인 정책을 받아서 쓸때는 상관없는데 정책이 비어 있을때 문제가 됨...
|
|
// 정확한 원인은 모르겠음.. 23_0412 16:36:40 kku
|
|
if (hWaitPipe_ <> 0) and (hWaitPipe_ <> INVALID_HANDLE_VALUE) then
|
|
begin
|
|
DisconnectNamedPipe(hWaitPipe_);
|
|
CLoseHandle(hWaitPipe_);
|
|
end;
|
|
hWaitPipe_ := 0;
|
|
|
|
if hEvent_ <> 0 then
|
|
begin
|
|
CloseHandle(hEvent_);
|
|
hEvent_ := 0;
|
|
end;
|
|
ZeroMemory(@ConnOvrl_, SizeOf(TOverlapped));
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. Close()');
|
|
end;
|
|
end;
|
|
|
|
function TTgNpServer.DoAcceptPipe: Boolean;
|
|
var
|
|
dwResult,
|
|
dwTransferred: DWORD;
|
|
begin
|
|
Result := false;
|
|
if bActive_ and (hEvent_ <> 0) and (hWaitPipe_ <> 0) then
|
|
begin
|
|
try
|
|
try
|
|
dwResult := WaitForSingleObjectEx(hEvent_, 500, True);
|
|
except
|
|
// ..
|
|
end;
|
|
|
|
case dwResult of
|
|
WAIT_FAILED :
|
|
begin
|
|
_Trace('Fail .. DoAcceptPipe() .. WAIT_FAILED');
|
|
Close;
|
|
end;
|
|
|
|
WAIT_TIMEOUT : exit;
|
|
WAIT_IO_COMPLETION : exit;
|
|
WAIT_OBJECT_0 :
|
|
begin
|
|
if not GetOverlappedResult(hWaitPipe_, ConnOvrl_, dwTransferred, False) then
|
|
begin
|
|
_Trace('Fail .. DoAcceptPipe() .. GetOverlappedResult()');
|
|
Close;
|
|
exit;
|
|
end else
|
|
SetPipeClientEnt(hWaitPipe_);
|
|
|
|
hWaitPipe_ := 0;
|
|
if not CreatePipeInstance(hWaitPipe_) then
|
|
begin
|
|
_Trace('Fail .. DoAcceptPipe() .. CreatePipeInstance()');
|
|
Close;
|
|
exit;
|
|
end;
|
|
|
|
Result := true;
|
|
|
|
// if Assigned(evConnected_) then
|
|
// evConnected_(Self);
|
|
end;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgNamedPipe.TraceException(Self, E, 'Fail .. DoAcceptPipe()');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTgNpServer.SendData(aSend: ISendPacket): Boolean;
|
|
var
|
|
llToss: LONGLONG;
|
|
pBuf: TBytes;
|
|
dwLen: DWORD;
|
|
i, n: Integer;
|
|
enum: TEnumerator<THandle>;
|
|
begin
|
|
Result := false;
|
|
try
|
|
dwLen := aSend.ToBytes(pBuf);
|
|
if dwLen = 0 then
|
|
exit;
|
|
|
|
llToss := TTgPacket(aSend).Toss;
|
|
if llToss = 0 then
|
|
begin
|
|
Lock;
|
|
try
|
|
enum := PipeList_.GetEnumerator;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
|
|
n := 0;
|
|
// 지정 되지 않으면 전체 전달 23_0313 18:34:50 kku
|
|
while enum.MoveNext do
|
|
begin
|
|
if _SendData(enum.Current, pBuf, dwLen) then
|
|
Inc(n);
|
|
end;
|
|
enum.Free;
|
|
|
|
Result := n > 0;
|
|
end else
|
|
Result := _SendData(llToss, pBuf, dwLen);
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. SendData()');
|
|
end;
|
|
end;
|
|
|
|
function TTgNpServer.RcvData(var pBuf: TBytes): DWORD;
|
|
begin
|
|
Result := 0;
|
|
try
|
|
if enumRcv_ = nil then
|
|
begin
|
|
Lock;
|
|
try
|
|
enumRcv_ := PipeList_.GetEnumerator;
|
|
finally
|
|
Unlock;
|
|
end;
|
|
|
|
if not enumRcv_.MoveNext then
|
|
begin
|
|
FreeAndNil(enumRcv_);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
hLastRcvPipe_ := enumRcv_.Current;
|
|
Result := _RcvData(hLastRcvPipe_, pBuf);
|
|
|
|
if not enumRcv_.MoveNext then
|
|
FreeAndNil(enumRcv_);
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. RcvData()');
|
|
end;
|
|
end;
|
|
|
|
procedure TTgNpServer.SetPipeClientEnt(hPipe: THandle);
|
|
var
|
|
dwMode: DWORD;
|
|
bAdd: Boolean;
|
|
begin
|
|
if hPipe = 0 then
|
|
exit;
|
|
|
|
Lock;
|
|
try
|
|
bAdd := PipeList_.IndexOf(hPipe) = -1;
|
|
if bAdd then
|
|
PipeList_.Add(hPipe);
|
|
finally
|
|
Unlock;
|
|
end;
|
|
|
|
if not bAdd then
|
|
begin
|
|
_Trace('Fail .. SetPipeClientEnt() .. Already Pipe');
|
|
exit;
|
|
end;
|
|
|
|
// dwMode := PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE or PIPE_NOWAIT; // fail ..
|
|
dwMode := PIPE_READMODE_MESSAGE or PIPE_NOWAIT;
|
|
if not SetNamedPipeHandleState(hPipe, dwMode, nil, nil) then
|
|
_Trace('Fail .. SetPipeClientEnt() .. SetNamedPipeHandleState()');
|
|
end;
|
|
|
|
function TTgNpServer.CreatePipeInstance(out hPipe: THandle; bAsync: Boolean = false): Boolean;
|
|
const
|
|
SECURITY_WORLD_SID_AUTHORITY: TSidIdentifierAuthority = (Value: (0, 0, 0, 0, 0, 1));
|
|
SECURITY_WORLD_RID = ($00000000);
|
|
ACL_REVISION = (2);
|
|
var
|
|
SIA: SID_IDENTIFIER_AUTHORITY;
|
|
SID: PSID;
|
|
pAclBuf, pSidBuf: TBytes;
|
|
nAclSize,
|
|
nSidSize: Integer;
|
|
ACL: PACL;
|
|
Descriptor: SECURITY_DESCRIPTOR;
|
|
Attributes: SECURITY_ATTRIBUTES;
|
|
dwError,
|
|
dwPipeMode: DWORD;
|
|
begin
|
|
Result := False;
|
|
try
|
|
SIA := SECURITY_WORLD_SID_AUTHORITY;
|
|
nSidSize := GetSidLengthRequired(1);
|
|
SetLength(pSidBuf, nSidSize);
|
|
ZeroMemory(pSidBuf, nSidSize);
|
|
SID := PSID(@pSidBuf[0]); // AllocMem(nSidSize);
|
|
try
|
|
Win32Check(InitializeSid(SID, SECURITY_WORLD_SID_AUTHORITY, 1));
|
|
PDWORD(GetSidSubAuthority(SID, 0))^ := SECURITY_WORLD_RID;
|
|
nAclSize := SizeOf(ACL) + SizeOf(ACCESS_ALLOWED_ACE) + GetLengthSid(SID);
|
|
SetLength(pAclBuf, nAclSize);
|
|
ZeroMemory(pAclBuf, nAclSize);
|
|
ACL := PACL(@pAclBuf[0]); // AllocMem(nAclSize);
|
|
try
|
|
Win32Check(InitializeAcl(ACL^, nAclSize, ACL_REVISION));
|
|
Win32Check(AddAccessAllowedAce(ACL^, ACL_REVISION, GENERIC_ALL, SID));
|
|
Win32Check(InitializeSecurityDescriptor(@Descriptor, SECURITY_DESCRIPTOR_REVISION));
|
|
Win32Check(SetSecurityDescriptorDacl(@Descriptor, true, ACL, False));
|
|
Attributes.nLength := SizeOf(SECURITY_ATTRIBUTES);
|
|
Attributes.lpSecurityDescriptor := @Descriptor;
|
|
Attributes.bInheritHandle := False;
|
|
|
|
dwPipeMode := PIPE_TYPE_MESSAGE or PIPE_READMODE_MESSAGE;
|
|
if bAsync then
|
|
dwPipeMode := dwPipeMode or PIPE_NOWAIT
|
|
else
|
|
dwPipeMode := dwPipeMode or PIPE_WAIT;
|
|
|
|
hPipe := CreateNamedPipe(PChar('\\.\Pipe\' + sPipeName_),
|
|
PIPE_ACCESS_DUPLEX or FILE_FLAG_OVERLAPPED,
|
|
dwPipeMode,
|
|
PIPE_UNLIMITED_INSTANCES,
|
|
MaxBuffSize,
|
|
MaxBuffSize,
|
|
NMPWAIT_WAIT_FOREVER,
|
|
@Attributes);
|
|
|
|
if (hPipe <> 0) and (hPipe <> INVALID_HANDLE_VALUE) then
|
|
begin
|
|
if not ConnectNamedPipe(hPipe, @ConnOvrl_) then
|
|
begin
|
|
dwError := GetLastError;
|
|
case dwError of
|
|
ERROR_IO_PENDING:
|
|
Result := true;
|
|
ERROR_PIPE_CONNECTED:
|
|
SetEvent(ConnOvrl_.hEvent);
|
|
else
|
|
_Trace('Fail .. CreatePipeInstance() .. ConnectNamedPipe(), Error=%d', [dwError]);
|
|
end;
|
|
end else
|
|
SetPipeClientEnt(hPipe);
|
|
end else
|
|
_Trace('Fail .. CreatePipeInstance() .. CreateNamedPipe()');
|
|
finally
|
|
// FreeMem(ACL, nAclSize); // 여기서 FreeMem 하면 AS 디버그 모드에서 크러쉬 오류가 발생한다.. 그래서 수정함 23_0517 16:26:57 kku
|
|
end;
|
|
finally
|
|
// FreeMem(SID, nSidSize); // 여기서 FreeMem 하면 AS 디버그 모드에서 크러쉬 오류가 발생한다.. 그래서 수정함 23_0517 16:26:57 kku
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
begin
|
|
if hPipe <> INVALID_HANDLE_VALUE then
|
|
begin
|
|
CloseHandle(hPipe);
|
|
hPipe := INVALID_HANDLE_VALUE;
|
|
end;
|
|
|
|
ETgNamedPipe.TraceException(Self, E, 'Fail .. CreatePipeInstance()');
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TTgNpClient }
|
|
|
|
Constructor TTgNpClient.Create(sPipeName: String);
|
|
begin
|
|
Inherited Create(sPipeName);
|
|
bIsServer_ := false;
|
|
hConnPipe_ := 0;
|
|
bConnected_ := false;
|
|
end;
|
|
|
|
Destructor TTgNpClient.Destroy;
|
|
begin
|
|
Disconnect;
|
|
Inherited;
|
|
end;
|
|
|
|
procedure TTgNpClient.ProcessFail(hPipe: THandle);
|
|
begin
|
|
// _Trace('ProcessFail()');
|
|
Disconnect;
|
|
end;
|
|
|
|
function TTgNpClient.Connect: Boolean;
|
|
var
|
|
dwError,
|
|
dwMode: DWORD;
|
|
sPName: String;
|
|
begin
|
|
Result := false;
|
|
|
|
// _Trace('Connect() .. 1');
|
|
if bConnected_ then
|
|
exit;
|
|
// _Trace('Connect() .. 2');
|
|
|
|
try
|
|
Disconnect;
|
|
|
|
sPName := '\\.\Pipe\' + sPipeName_;
|
|
hConnPipe_ := CreateFile(PChar(sPName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0);
|
|
if (hConnPipe_ = 0) or (hConnPipe_ = INVALID_HANDLE_VALUE) then
|
|
begin
|
|
_Trace('Fail .. Connect() .. CreateFile()', 100);
|
|
Disconnect;
|
|
exit;
|
|
end;
|
|
|
|
dwError := GetLastError;
|
|
case dwError of
|
|
NOERROR, ERROR_PIPE_BUSY : ;
|
|
else begin
|
|
_Trace('Fail .. Connect() .. Error=%d', [dwError], 9);
|
|
Disconnect;
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
if not WaitNamedPipe(PChar(sPName), 10000 { NMPWAIT_WAIT_FOREVER } ) then
|
|
begin
|
|
_Trace('Fail .. Connect() .. WaitNamedPipe()', 9);
|
|
Disconnect;
|
|
exit;
|
|
end;
|
|
|
|
dwMode := PIPE_READMODE_MESSAGE or PIPE_NOWAIT;
|
|
if not SetNamedPipeHandleState(hConnPipe_, dwMode, nil, nil) then
|
|
begin
|
|
_Trace('Fail .. Connect() .. SetNamedPipeHandleState()', 9);
|
|
Disconnect;
|
|
exit;
|
|
end;
|
|
// bConnected_ := true;
|
|
Result := true;
|
|
except
|
|
on E: Exception do
|
|
ETgNamedPipe.TraceException(Self, E, 'Fail .. Connect()', 4);
|
|
end;
|
|
end;
|
|
|
|
procedure TTgNpClient.Disconnect;
|
|
begin
|
|
// _Trace('Disconnect() ..');
|
|
try
|
|
bConnected_ := false;
|
|
if hConnPipe_ <> 0 then
|
|
begin
|
|
CloseHandle(hConnPipe_);
|
|
hConnPipe_ := 0;
|
|
end;
|
|
except
|
|
on E: Exception do
|
|
ETgException.TraceException(Self, E, 'Fail .. Disconnect()', 3);
|
|
end;
|
|
end;
|
|
|
|
function TTgNpClient.SendData(aSend: ISendPacket): Boolean;
|
|
var
|
|
pBuf: TBytes;
|
|
dwLen: DWORD;
|
|
begin
|
|
dwLen := aSend.ToBytes(pBuf);
|
|
Result := _SendData(hConnPipe_, pBuf, dwLen);
|
|
end;
|
|
|
|
function TTgNpClient.RcvData(var pBuf: TBytes): DWORD;
|
|
begin
|
|
Result := _RcvData(hConnPipe_, pBuf);
|
|
end;
|
|
|
|
end.
|