149 lines
3.5 KiB
Plaintext
149 lines
3.5 KiB
Plaintext
{*******************************************************}
|
||
{ }
|
||
{ OutlookMonClient }
|
||
{ }
|
||
{ Copyright (C) 2023 kku }
|
||
{ }
|
||
{*******************************************************}
|
||
|
||
unit OutlookMonClient;
|
||
|
||
interface
|
||
|
||
uses
|
||
Tocsg.ClientBase, System.SysUtils, System.Classes, Tocsg.Packet,
|
||
Winapi.Windows, Tocsg.Win32, Tocsg.Obj, System.Generics.Collections,
|
||
GlobalOutAddInDefine;
|
||
|
||
type
|
||
TOutlookMonClient = class(TTgClientBase)
|
||
private
|
||
dwExecuteTick_: DWORD;
|
||
bTerminated_: Boolean;
|
||
// CltMtx_: TTgMutex;
|
||
protected
|
||
function GetConnected: Boolean; override;
|
||
procedure ConnectedEvent; override;
|
||
procedure DisconnectedEvent; override;
|
||
procedure ProcessRcvPacket(aRcv: IRcvPacket); override;
|
||
public
|
||
MailPo: TOutlookAddInPo;
|
||
Constructor Create;
|
||
Destructor Destroy; override;
|
||
end;
|
||
|
||
var
|
||
gClient: TOutlookMonClient = nil;
|
||
|
||
implementation
|
||
|
||
uses
|
||
DOutMonMain,
|
||
Tocsg.Exception, Tocsg.Path, Tocsg.WndUtil, Tocsg.Strings,
|
||
Tocsg.Process, Tocsg.Shell, superobject, Tocsg.Registry, Tocsg.Json;
|
||
|
||
{ TOutlookMonClient }
|
||
|
||
Constructor TOutlookMonClient.Create;
|
||
begin
|
||
Inherited Create('', 0);
|
||
ASSERT(gClient = nil);
|
||
gClient := Self;
|
||
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 TOutlookMonClient.Destroy;
|
||
begin
|
||
bTerminated_ := true;
|
||
gClient := nil;
|
||
// FreeAndNil(CltMtx_);
|
||
Inherited;
|
||
end;
|
||
|
||
function TOutlookMonClient.GetConnected: Boolean;
|
||
|
||
procedure TryConnection;
|
||
var
|
||
hFind, hIpc: HWND;
|
||
begin
|
||
hIpc := StrToInt64Def(GetRegValueAsString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'Outlook'), 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 TOutlookMonClient.ConnectedEvent;
|
||
var
|
||
Send: ISendPacket;
|
||
begin
|
||
try
|
||
Inherited;
|
||
SetSendPauseState(false);
|
||
_Trace('Connected.');
|
||
|
||
Send := TTgPacket.Create(OAI_MAILSECU_POLICY);
|
||
Send.O['PO'] := TTgJson.ValueToJsonObject<TOutlookAddInPo>(MailPo);
|
||
SendPacket(Send);
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. ConnectedEvent()');
|
||
end;
|
||
end;
|
||
|
||
procedure TOutlookMonClient.DisconnectedEvent;
|
||
begin
|
||
try
|
||
Inherited;
|
||
QSendPacket_.Clear;
|
||
|
||
_Trace('Disconnected');
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. DisconnectedEvent()');
|
||
end;
|
||
end;
|
||
|
||
procedure TOutlookMonClient.ProcessRcvPacket(aRcv: IRcvPacket);
|
||
begin
|
||
try
|
||
case aRcv.Command of
|
||
0 : ;
|
||
OAI_MAILITEM_RCV_DATA,
|
||
OAI_MAILITEM_SEND_DATA :
|
||
begin
|
||
if gMain <> nil then
|
||
SendMessage(gMain.Handle, WM_NOTIFY_SEND_DATA, aRcv.Command, NativeInt(aRcv));
|
||
end;
|
||
end;
|
||
except
|
||
on E: Exception do
|
||
ETgException.TraceException(Self, E, 'Fail .. ProcessRcvPacket()');
|
||
end;
|
||
end;
|
||
|
||
end.
|