{*******************************************************}
{                                                       }
{       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.