{*******************************************************} { } { 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; bCapBlock: Boolean; end; TDcCMEnt = TDictionary; TEvtSendCtrlOpt = procedure(pEnt: PCMEnt) of object; TAppCtrlServer = class(TTgClientBase) private hRcvWnd_: HWND; evSendCtrlOpt_: TEvtSendCtrlOpt; // AppCtrlOpt_: TAppCtrlOpt; 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; function GetCMEntEnumrator: TEnumerator; function GetCMEEntByPID(dwPid: DWORD): PCMEnt; property OnSendCtrlOpt: TEvtSendCtrlOpt write evSendCtrlOpt_; end; implementation uses Tocsg.Exception, superobject, GlobalDefine, Tocsg.Path, Tocsg.Json, Tocsg.Safe; { TAppCtrlServer } Constructor TAppCtrlServer.Create(hRcvWnd: HWND); begin Inherited Create('', -1); evSendCtrlOpt_ := nil; hRcvWnd_ := hRcvWnd; 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 // 연결 모듈 종료 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; function TAppCtrlServer.GetCMEntEnumrator: TEnumerator; begin Lock; try Result := DcCMEnt_.Values.GetEnumerator; finally Unlock; end; end; function TAppCtrlServer.GetCMEEntByPID(dwPid: DWORD): PCMEnt; var enum: TEnumerator; begin Result := nil; try Guard(enum, GetCMEntEnumrator); while enum.MoveNext do begin if enum.Current.dwPid = dwPid then begin Result := enum.Current; exit; end; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. GetCMEEntByPID()'); end; 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'] + ' 하하하'; // 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); ZeroMemory(pEnt, SizeOf(TCMEnt)); 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)); _Trace('Connected.. PName=%s, PID=%d', [pEnt.sPName, pEnt.dwPid], 3); if Assigned(evSendCtrlOpt_) then evSendCtrlOpt_(pEnt); end; procedure process_ACC_NOTI_MSG; begin if hRcvWnd_ <> 0 then begin // if aRcv then SendMessage(hRcvWnd_, WM_NOTIFY_HOOKDATA, 0, NativeInt(aRcv)); // _Trace('process_ACC_NOTI_MSG() .. Path=%s', [aRcv.S['FPath']], 9); end; end; begin try case aRcv.Command of ACC_TEST_LOG : process_ACC_TEST_LOG; ACC_APP_INFO : process_ACC_APP_INFO; ACC_SET_POLICY : ; ACC_NOTI_MSG : process_ACC_NOTI_MSG; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [aRcv.Command]); end; end; end.