BSOne.SFC/Tocsg.Module/AppCtrl/EXE_AppCtrl/AppCtrlServer.pas

{*******************************************************}
{                                                       }
{       AppCtrlServer                                   }
{                                                       }
{       Copyright (C) 2023 kku                          }
{                                                       }
{*******************************************************}

unit AppCtrlServer;

interface

uses
  Tocsg.ClientBase, System.SysUtils, System.Classes, WinApi.Windows, Tocsg.Packet,
  Winapi.Messages, Tocsg.Process.IPC, System.Generics.Collections,
  AppCtrlDefine;

const
  WM_NOTIFY_CONNECT_MODULE = WM_USER + 5938;

type
  PCMEnt = ^TCMEnt;
  TCMEnt = record // Connect Module
    hPipe: THandle;
    dwPid: DWORD;
    sPName,
    sPPath: String;
  end;
  TDcCMEnt = TDictionary<THandle,PCMEnt>;

  TEvtSendCtrlOpt = procedure(pEnt: PCMEnt) of object;
  TAppCtrlServer = class(TTgClientBase)
  private
    hRcvWnd_: HWND;
    evSendCtrlOpt_: TEvtSendCtrlOpt;
    procedure OnCMEntNotify(Sender: TObject; const Item: PCMEnt; Action: TCollectionNotification);
  protected
    DcCMEnt_: TDcCMEnt;
    dwLastSaveTick_: DWORD;
    procedure OnNpDisconnected(Sender: TTgNpBase; hPipe: THandle);
    function HasCMEnt(hPipe: THandle): Boolean;
    procedure ConnectedEvent; override;
    procedure DisconnectedEvent; override;
    procedure ProcessRcvPacket(aRcv: IRcvPacket); override;
  public
    Constructor Create(hRcvWnd: HWND);
    Destructor Destroy; override;

    function CountEnt: Integer;

    function ActiveNp(sPipeName: String; bNpServer: Boolean): Boolean; override;

    property OnSendCtrlOpt: TEvtSendCtrlOpt write evSendCtrlOpt_;
  end;

implementation

uses
  Tocsg.Exception, superobject, GlobalDefine, Tocsg.Path, Tocsg.Json;

{ TAppCtrlServer }

Constructor TAppCtrlServer.Create(hRcvWnd: HWND);
begin
  Inherited Create('', -1);
  hRcvWnd_ := hRcvWnd;
  evSendCtrlOpt_ := nil;
  dwLastSaveTick_ := 0;
  DcCMEnt_ := TDcCMEnt.Create;
  DcCMEnt_.OnValueNotify := OnCMEntNotify;
end;

Destructor TAppCtrlServer.Destroy;
begin
  FreeAndNIl(DcCMEnt_);
  Inherited;
end;

procedure TAppCtrlServer.OnCMEntNotify(Sender: TObject; const Item: PCMEnt; Action: TCollectionNotification);
begin
  if Action = cnRemoved then
    Dispose(Item);
end;

procedure TAppCtrlServer.OnNpDisconnected(Sender: TTgNpBase; hPipe: THandle);
begin
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
  if hRcvWnd_ <> 0 then
    SendMessage(hRcvWnd_, WM_NOTIFY_CONNECT_MODULE, 0, hPipe);

  Lock;
  try
    if DcCMEnt_.ContainsKey(hPipe) then
      DcCMEnt_.Remove(hPipe);
  finally
    Unlock;
  end;
end;

function TAppCtrlServer.HasCMEnt(hPipe: THandle): Boolean;
begin
  Lock;
  try
    Result := DcCMEnt_.ContainsKey(hPipe);
  finally
    Unlock;
  end;
end;

function TAppCtrlServer.CountEnt: Integer;
begin
  Lock;
  try
    Result := DcCMEnt_.Count;
  finally
    Unlock;
  end;
end;

function TAppCtrlServer.ActiveNp(sPipeName: String; bNpServer: Boolean): Boolean;
begin
  Result := Inherited;
  if bNpServer and Result and (NpIpc_ <> nil) then
    NpIpc_.OnDisconnected := OnNpDisconnected;
end;

procedure TAppCtrlServer.ConnectedEvent;
var
  Send: ISendPacket;
begin
  try
//    Inherited;
//    SetSendPauseState(false);
    _Trace('Connected.');
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()');
  end;
end;

procedure TAppCtrlServer.DisconnectedEvent;
begin
  try
//    Inherited;
    QSendPacket_.Clear;

    _Trace('Disconnected');
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()');
  end;
end;

procedure TAppCtrlServer.ProcessRcvPacket(aRcv: IRcvPacket);
var
  Send: ISendPacket;

  procedure process_ACC_TEST_LOG;
  begin
    _Trace(aRcv.S['Msg']);

//    Send := TTgPacket.Create(aRcv);
//    Send.S['Msg'] := aRcv.S['Msg'] + ' <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>';
//    SendPacket(Send);
  end;

  procedure process_ACC_APP_INFO;
  var
    pEnt: PCMEnt;
    sPath: String;
  begin
    if HasCMEnt(aRcv.Toss) then
    begin
      _Trace('Fail .. process_ACC_APP_INFO() .. Already PipeInfo');
      exit;
    end;

    New(pEnt);
    pEnt.hPipe := aRcv.Toss;
    pEnt.dwPid := aRcv.I['PID'];
    sPath := aRcv.S['Path'];
    pEnt.sPName := ExtractFileName(sPath);
    pEnt.sPPath := ExtractFilePath(sPath);

    Lock;
    try
      DcCMEnt_.Add(pEnt.hPipe, pEnt);
    finally
      Unlock;
    end;

    if hRcvWnd_ <> 0 then
      SendMessage(hRcvWnd_, WM_NOTIFY_CONNECT_MODULE, 1, NativeInt(pEnt));

//    Send := TTgPacket.Create(ACC_SET_POLICY);
//    Send.Toss := aRcv.Toss;
//    Send.O['Opt'] := TTgJson.ValueToJsonObject<TAppCtrlOpt>(AppCtrlOpt_);
//    SendPacket(Send);

    if Assigned(evSendCtrlOpt_) then
      evSendCtrlOpt_(pEnt);
  end;

begin
  try
    case aRcv.Command of
      ACC_TEST_LOG : process_ACC_TEST_LOG;
      ACC_APP_INFO : process_ACC_APP_INFO;
      ACC_SET_POLICY : ;
    end;
  except
    on E: Exception do
      ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [aRcv.Command]);
  end;
end;

end.