BSOne.SFC/eCrmHE/EXE_eCrmHomeEdition/Service/BsFileMonKvCttSchClient.pas

173 lines
4.1 KiB
Plaintext
Raw Permalink Blame History

{*******************************************************}
{ }
{ 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 // <20>ּ<EFBFBD> 10<31>ʿ<EFBFBD> <20>ѹ<EFBFBD><D1B9><EFBFBD> <20><><EFBFBD><EFBFBD> <20>ǵ<EFBFBD><C7B5><EFBFBD><EFBFBD><EFBFBD>
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<TCttSchOpt>(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.