313 lines
8.6 KiB
Plaintext
313 lines
8.6 KiB
Plaintext
{*******************************************************}
|
||
{ }
|
||
{ BS1OutlookAddInClient }
|
||
{ }
|
||
{ Copyright (C) 2023 kku }
|
||
{ }
|
||
{*******************************************************}
|
||
|
||
unit BS1OutlookAddInClient;
|
||
|
||
interface
|
||
|
||
uses
|
||
Tocsg.ClientBase, System.SysUtils, System.Classes, Tocsg.Packet,
|
||
Winapi.Windows, Tocsg.Win32, Tocsg.Obj, System.Generics.Collections,
|
||
GlobalOutAddInDefine, ManagerPattern;
|
||
|
||
type
|
||
TBS1OutlookAddInClient = class(TTgClientBase)
|
||
private
|
||
dwExecuteTick_: DWORD;
|
||
bTerminated_: Boolean;
|
||
// CltMtx_: TTgMutex;
|
||
MailPo_: TOutlookAddInPo;
|
||
hRcvHwnd_: HWND;
|
||
MgPtn_: TManagerPattern;
|
||
protected
|
||
function GetConnected: Boolean; override;
|
||
procedure ConnectedEvent; override;
|
||
procedure DisconnectedEvent; override;
|
||
procedure ProcessRcvPacket(aRcv: IRcvPacket); override;
|
||
public
|
||
Constructor Create;
|
||
Destructor Destroy; override;
|
||
|
||
procedure SetPatternList(sPatternOpt: String; var aList: TPatternEntList);
|
||
procedure SetRuleToPtrnList(sKwdPtrn: String; var aList: TPatternEntList);
|
||
|
||
property MailPo: TOutlookAddInPo read MailPo_;
|
||
property RcvHwnd: HWND read hRcvHwnd_;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Exception, Tocsg.Path, Tocsg.WndUtil, Tocsg.Strings,
|
||
Tocsg.Process, Tocsg.Shell, superobject, Tocsg.Registry, Tocsg.Json,
|
||
Tocsg.Safe, CttSchDefine, GlobalDefine;
|
||
|
||
{ TBS1OutlookAddInClient }
|
||
|
||
Constructor TBS1OutlookAddInClient.Create;
|
||
begin
|
||
Inherited Create('', 0);
|
||
bTerminated_ := false;
|
||
dwExecuteTick_ := 0;
|
||
ZeroMemory(@MailPo_, SizeOf(MailPo_));
|
||
|
||
// CltMtx_ := TTgMutex.Create('Global\SL20230214k');
|
||
//{$IFDEF DEBUG}
|
||
// ASSERT(CltMtx_.MutexState = msCreateOk);
|
||
//{$ELSE}
|
||
// if CltMtx_.MutexState <> msCreateOk then
|
||
// _Trace('Fail .. Create() .. CreateMutex()');
|
||
//{$ENDIF}
|
||
end;
|
||
|
||
Destructor TBS1OutlookAddInClient.Destroy;
|
||
begin
|
||
bTerminated_ := true;
|
||
if MgPtn_ <> nil then
|
||
FreeAndNil(MgPtn_);
|
||
// FreeAndNil(CltMtx_);
|
||
Inherited;
|
||
end;
|
||
|
||
function TBS1OutlookAddInClient.GetConnected: Boolean;
|
||
|
||
procedure TryConnection;
|
||
var
|
||
hFind, hIpc: HWND;
|
||
begin
|
||
hIpc := StrToInt64Def(GetRegValueAsString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'OutMon'), 0);
|
||
if hIpc <> 0 then
|
||
ConnectWnd(hIpc);
|
||
end;
|
||
|
||
var
|
||
sParam: String;
|
||
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;
|
||
TryConnection;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TBS1OutlookAddInClient.ConnectedEvent;
|
||
begin
|
||
try
|
||
Inherited;
|
||
SetSendPauseState(false);
|
||
_Trace('Connected.');
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()');
|
||
end;
|
||
end;
|
||
|
||
procedure TBS1OutlookAddInClient.DisconnectedEvent;
|
||
begin
|
||
try
|
||
Inherited;
|
||
QSendPacket_.Clear;
|
||
|
||
ZeroMemory(@MailPo_, SizeOf(MailPo_));
|
||
if MgPtn_ <> nil then
|
||
FreeAndNil(MgPtn_);
|
||
_Trace('Disconnected');
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()');
|
||
end;
|
||
end;
|
||
|
||
// ManagerService.pas <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 23_0503 10:45:56 kku
|
||
procedure TBS1OutlookAddInClient.SetPatternList(sPatternOpt: String; var aList: TPatternEntList);
|
||
var
|
||
O: ISuperObject;
|
||
PtrnEnt, NewEnt: TPatternEnt;
|
||
StrList: TStringList;
|
||
i, nPos: Integer;
|
||
iter: TSuperObjectIter;
|
||
sName: String;
|
||
begin
|
||
try
|
||
aList.Clear;
|
||
if sPatternOpt = '' then
|
||
exit;
|
||
|
||
sPatternOpt := StringReplace(sPatternOpt, ';', '|', [rfReplaceAll]);
|
||
sPatternOpt := StringReplace(sPatternOpt, #13#10, '|', [rfReplaceAll]);
|
||
|
||
O := SO(sPatternOpt);
|
||
if O <> nil then
|
||
begin
|
||
if ObjectFindFirst(O, iter) then
|
||
begin
|
||
Repeat
|
||
if iter.key = 'scanoption' then
|
||
begin
|
||
Guard(StrList, TStringList.Create);
|
||
SplitString(O.S['scanoption'], '|', StrList);
|
||
for i := 0 to StrList.Count - 1 do
|
||
begin
|
||
PtrnEnt := MgPtn_.GetPatternEntByName(StrList[i]);
|
||
if PtrnEnt <> nil then
|
||
begin
|
||
NewEnt := TPatternEnt.Create(MgPtn_, nil);
|
||
NewEnt.AddName(MgPtn_.LangId, CttCodeToStr(StrList[i]));
|
||
NewEnt.PatternList.Add(PtrnEnt.GetSearchText);
|
||
aList.Add(NewEnt);
|
||
end;
|
||
end;
|
||
end else begin
|
||
sName := iter.key;
|
||
if sName.StartsWith('custom__') then
|
||
begin
|
||
Delete(sName, 1, 8);
|
||
// todo : Ű<><C5B0><EFBFBD><EFBFBD>, <20><><EFBFBD>Ͽ<EFBFBD> <20>´<EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʿ<EFBFBD>?
|
||
nPos := Pos('__keyword', sName);
|
||
if nPos = 0 then
|
||
nPos := Pos('__pattern', sName);
|
||
|
||
if nPos > 0 then
|
||
begin
|
||
sName := Copy(sName, 1, nPos - 1);
|
||
PtrnEnt := aList.GetPtrnEntByName(sName);
|
||
if PtrnEnt = nil then
|
||
begin
|
||
PtrnEnt := TPatternEnt.Create(MgPtn_, nil);
|
||
PtrnEnt.AddName(MgPtn_.LangId, sName);
|
||
aList.Add(PtrnEnt);
|
||
end;
|
||
PtrnEnt.PatternList.Add(iter.val.AsString);
|
||
end;
|
||
end;
|
||
end;
|
||
Until not ObjectFindNext(iter);
|
||
ObjectFindClose(iter);
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. SetPatternList()');
|
||
end;
|
||
end;
|
||
|
||
procedure TBS1OutlookAddInClient.SetRuleToPtrnList(sKwdPtrn: String; var aList: TPatternEntList);
|
||
var
|
||
i: Integer;
|
||
PtrnEnt: TPatternEnt;
|
||
begin
|
||
aList.Clear;
|
||
|
||
if sKwdPtrn <> '' then
|
||
begin
|
||
var CusList: TStringList;
|
||
Guard(CusList, TStringList.Create);
|
||
SplitString(sKwdPtrn, '**', CusList);
|
||
|
||
var InfoList: TStringList;
|
||
Guard(InfoList, TStringList.Create);
|
||
|
||
for i := 0 to CusList.Count - 1 do
|
||
begin
|
||
SplitString(CusList[i], '::', InfoList);
|
||
if InfoList.Count > 4 then
|
||
begin
|
||
PtrnEnt := TPatternEnt.Create(MgPtn_, nil, nil, StrToIntDef(InfoList[2], 1));
|
||
PtrnEnt.RType := ManagerPattern.TRuleType(StrToIntDef(InfoList[3], 0));
|
||
PtrnEnt.IsAnd := InfoList[4] = 'T';
|
||
PtrnEnt.AddName(MgPtn_.LangId, InfoList[0]);
|
||
PtrnEnt.PatternList.Add(InfoList[1]);
|
||
aList.Add(PtrnEnt);
|
||
end;
|
||
end;
|
||
|
||
// var nPos: Integer := 0;
|
||
// var nCnt: Integer := 0;
|
||
// var sPtrnName: String := '';
|
||
// var sPtrnEnt: String := '';
|
||
// var sPtrnVal: String := '';
|
||
// for i := 0 to CusList.Count - 1 do
|
||
// begin
|
||
// sPtrnEnt := CusList[i];
|
||
// nPos := Pos('::', sPtrnEnt);
|
||
// if nPos > 0 then
|
||
// begin
|
||
// sPtrnName := Copy(sPtrnEnt, 1, nPos - 1);
|
||
// Delete(sPtrnEnt, 1, nPos + 1);
|
||
// nPos := Pos('|*|', sPtrnEnt);
|
||
// if nPos > 0 then
|
||
// begin
|
||
// sPtrnVal := Copy(sPtrnEnt, 1, nPos - 1);
|
||
// Delete(sPtrnEnt, 1, nPos + 2);
|
||
// nCnt := StrToIntDef(sPtrnEnt, 1);
|
||
// end else begin
|
||
// sPtrnVal := sPtrnEnt;
|
||
// nCnt := 1;
|
||
// end;
|
||
//
|
||
// PtrnEnt := TPatternEnt.Create(MgPtn_, nil, nil, nCnt);
|
||
// PtrnEnt.AddName(MgPtn_.LangId, sPtrnName);
|
||
// PtrnEnt.PatternList.Add(sPtrnVal);
|
||
// aList.Add(PtrnEnt);
|
||
// end;
|
||
// end;
|
||
end;
|
||
end;
|
||
|
||
procedure TBS1OutlookAddInClient.ProcessRcvPacket(aRcv: IRcvPacket);
|
||
|
||
procedure process_OAI_MAILSECU_POLICY;
|
||
var
|
||
StrList: TStringList;
|
||
i: Integer;
|
||
begin
|
||
MailPo_ := TTgJson.GetDataAsType<TOutlookAddInPo>(aRcv.O['PO']);
|
||
hRcvHwnd_ := aRcv.I['RcvHwnd'];
|
||
|
||
if (MailPo_.bMailCttSch or (MailPo_.AttachAB.Kind <> abkNone)) and
|
||
FileExists(MailPo_.sCttSchPtrnPath) then
|
||
begin
|
||
if MgPtn_ = nil then
|
||
begin
|
||
MgPtn_ := TManagerPattern.Create(MailPo_.sCttSchPtrnPath);
|
||
MgPtn_.LangId := 1; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end;
|
||
|
||
// if PatternEntList_ = nil then
|
||
// PatternEntList_ := TPatternEntList.Create(false);
|
||
//
|
||
// if MailPo_.sPatterns <> '' then
|
||
// begin
|
||
// if MailPo_.sPatterns.Contains('scanoption') then
|
||
// SetPatternList(MailPo_.sPatterns, PatternEntList_)
|
||
// else
|
||
// SetRuleToPtrnList(MailPo_.sPatterns, PatternEntList_);
|
||
// end else
|
||
// MgPtn_.GetUsePatternEnt(PatternEntList_);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
try
|
||
case aRcv.Command of
|
||
0 : ;
|
||
OAI_MAILSECU_POLICY : process_OAI_MAILSECU_POLICY;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket(), Cmd=%d', [aRcv.Command]);
|
||
end;
|
||
end;
|
||
|
||
end.
|