{*******************************************************} { } { BsFileMonKvCttSchClient } { } { Copyright (C) 2023 kku } { } {*******************************************************} unit BsFileMonKvCttSchClient; interface uses Tocsg.ClientBase, System.SysUtils, System.Classes, Tocsg.Packet, Winapi.Windows, Tocsg.Win32, CttSchDefine; type TBsFileMonKvCttSchClient = class(TTgClientBase) private dwExecuteTick_: DWORD; bTerminated_: Boolean; sKvPath_: String; Mtx_: TTgMutex; FileScanOpt_: TFileScanOpt; protected function GetConnected: Boolean; override; procedure ConnectedEvent; override; procedure DisconnectedEvent; override; procedure ProcessRcvPacket(aRcv: IRcvPacket); override; public Constructor Create(aFileScanOpt: TFileScanOpt); Destructor Destroy; override; end; var gKvKwdSch: TBsFileMonKvCttSchClient = nil; implementation uses Tocsg.Exception, Tocsg.Strings, Tocsg.WndUtil, Tocsg.Path, superobject, Tocsg.Json, Tocsg.Shell; { TBsFileMonKvCttSchClient } Constructor TBsFileMonKvCttSchClient.Create(aFileScanOpt: TFileScanOpt); begin Inherited Create('', 0); ASSERT(gKvKwdSch = nil); gKvClient := Self; dwExecuteTick_ := 0; bTerminated_ := false; FileScanOpt_ := aFileScanOpt; sKvPath_ := GetRunExePathDir + EXE_KVCTTSCH; Mtx_ := TTgMutex.Create('Global\BsFileMonKv' + IntToStr(GetTickCount)); end; Destructor TBsFileMonKvCttSchClient.Destroy; begin gKvKwdSch := nil; FreeAndNil(Mtx_); bTerminated_ := true; Inherited; end; function TBsFileMonKvCttSchClient.GetConnected: Boolean; {$IFDEF DEBUG} procedure ConnectDebugCore; var hFind, hIpc: HWND; begin hFind := FindWindow('TDlgKvCttSchMain', nil); if hFind <> 0 then begin hIpc := StrToInt64Def(ExtrNumStr(GetWindowCaption(hFind)), 0); if hIpc <> 0 then ConnectWnd(hIpc); end; end; {$ENDIF} var sParam: String; O: ISuperObject; begin Result := Inherited; if not Result and not bTerminated_ and (W2W_ <> nil) then begin if (GetTickCount - dwExecuteTick_) > 10000 then // ÃÖ¼Ò 10ÃÊ¿¡ Çѹø¸¸ ½ÇÇà µÇµµ·ÏÇÔ begin dwExecuteTick_ := GetTickCount; {$IFDEF DEBUG} if DebugHook <> 0 then begin ConnectDebugCore; exit; end; {$ELSE} if not FileExists(sKvPath_) then begin _Trace('Fail .. GetConnected() .. Not found "kv-exe"'); exit; end; if GetSelfWnd = 0 then begin _Trace('Fail .. GetConnected() .. GetSelfWnd()'); exit; end; O := SO; O.I['CSTT'] := Integer(csttSchConnect); O.S['Mtx'] := Mtx_.MutexName; O.I['Tasker'] := GetSelfWnd; O.O['Opt'] := TTgJson.ValueToJsonObject(FileScanOpt_.CttSchOpt); sParam := GetRunExePathDir + '$bfkso.dat'; if SaveJsonObjToFile(O, sParam) then begin ExecutePath(sKvPath_, Format('-p "%s"', [sParam])); end; {$ENDIF} end; end; end; procedure TBsFileMonKvCttSchClient.ConnectedEvent; begin try Inherited; SetSendPauseState(false); _Trace('Connected.'); except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()'); end; end; procedure TBsFileMonKvCttSchClient.DisconnectedEvent; begin try Inherited; QSendPacket_.Clear; _Trace('Disconnected'); except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()'); end; end; procedure TBsFileMonKvCttSchClient.ProcessRcvPacket(aRcv: IRcvPacket); procedure process_KVC_RESPONSE_KEYWORD_SEARCH; begin _Trace('Found Path="%s"', [aRcv.S['Path']]); end; begin try case aRcv.Command of KVC_RESPONSE_KEYWORD_SEARCH : process_KVC_RESPONSE_KEYWORD_SEARCH; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket()'); end; end; end.