1209 lines
35 KiB
Plaintext
1209 lines
35 KiB
Plaintext
unit BS1OutlookAddIn_IMPL;
|
||
|
||
interface
|
||
|
||
uses
|
||
SysUtils, ComObj, ComServ, ActiveX, Variants, Outlook2000, Office2000, adxAddIn, BS1OutlookAddIn_TLB,
|
||
System.Classes, adxHostAppEvents, StdVcl, System.Generics.Collections;
|
||
|
||
const
|
||
// DASL schema names
|
||
PR_BODY_DASL = 'http://schemas.microsoft.com/mapi/proptag/0x1000001F'; // Unicode String
|
||
PR_HTML_DASL = 'http://schemas.microsoft.com/mapi/proptag/0x10130102'; // BYTE[]
|
||
PR_RTF_COMP_DASL = 'http://schemas.microsoft.com/mapi/proptag/0x10090102'; // BYTE[]
|
||
|
||
// Outlook.OlObjectClass
|
||
olMail = 43;
|
||
|
||
type
|
||
TCoBS1OutlookAddIn = class(TadxAddin, ICoBS1OutlookAddIn)
|
||
end;
|
||
|
||
TAddInModule = class(TadxCOMAddInModule)
|
||
procedure adxOutlookAppEventsItemSend(ASender: TObject;
|
||
const Item: IDispatch; var Cancel: WordBool);
|
||
procedure adxCOMAddInModuleAddInInitialize(Sender: TObject);
|
||
procedure adxCOMAddInModuleAddInFinalize(Sender: TObject);
|
||
procedure adxCOMAddInModuleAddInBeginShutdown(Sender: TObject);
|
||
procedure adxCOMAddInModuleAddInStartupComplete(Sender: TObject);
|
||
private
|
||
sVer_: String;
|
||
function GetIsFolderTracked: Boolean;
|
||
procedure SetIsFolderTracked(const bVal: Boolean);
|
||
procedure ItemsAdd(ASender: TObject; const Item: IDispatch);
|
||
protected
|
||
ItemsEventList_: TList<TItems>;
|
||
procedure OnEvtItemNotify(Sender: TObject; const Item: TItems; Action: TCollectionNotification);
|
||
public
|
||
// ItemsEvents: TItems;
|
||
property IsFolderTracked: boolean read GetIsFolderTracked write SetIsFolderTracked;
|
||
end;
|
||
|
||
implementation
|
||
|
||
uses
|
||
Tocsg.Trace, BS1OutlookAddInClient, Tocsg.Registry, Winapi.Windows,
|
||
Tocsg.Safe, Tocsg.Packet, GlobalOutAddInDefine, Tocsg.Strings,
|
||
Tocsg.Files, Tocsg.PCRE, ManagerPattern, CttSchDefine, GlobalDefine,
|
||
superobject, Tocsg.Json, Tocsg.Process, Tocsg.Convert, Tocsg.Hash,
|
||
Winapi.Messages, DefineHelper, Tocsg.Path;
|
||
|
||
{$R *.dfm}
|
||
|
||
var
|
||
_Client: TBS1OutlookAddInClient = nil;
|
||
|
||
function GetSubject(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).Subject;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetBody(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).Body;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetHTMLBody(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).HTMLBody;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetRtfBody(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).RTNFFody;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
//function GetEmailBody(aItem: IDispatch): string;
|
||
//var
|
||
// BodyFormat: OlBodyFormat;
|
||
//begin
|
||
// Result := '';
|
||
// try
|
||
// BodyFormat := aItem.BodyFormat;
|
||
//
|
||
// case BodyFormat of
|
||
// olFormatPlain:
|
||
// Result := aItem.Body; // 일반 텍스트
|
||
// olFormatHTML:
|
||
// Result := aItem.HTMLBody; // HTML 형식
|
||
// olFormatRichText:
|
||
// Result := aItem.RTNFFody; // Rich Text
|
||
// else
|
||
// Result := aItem.Body; // 기본
|
||
// end;
|
||
//
|
||
// except
|
||
// on E: Exception do
|
||
// begin
|
||
// // 대체 방법 시도
|
||
// Result := TryAlternativeBodyAccess(aItem);
|
||
// end;
|
||
// end;
|
||
//end;
|
||
|
||
function GetSenderEmail(aItem: IDispatch): WideString;
|
||
var
|
||
vItem, vAccount: OleVariant;
|
||
const
|
||
PR_SMTP_ADDRESS = 'http://schemas.microsoft.com/mapi/proptag/0x39FE001E';
|
||
begin
|
||
Result := '';
|
||
try
|
||
vItem := aItem;
|
||
|
||
// 1. SendUsingAccount 확인 (가장 확실함)
|
||
vAccount := vItem.SendUsingAccount;
|
||
if not VarIsClear(vAccount) then
|
||
begin
|
||
// Account의 CurrentUser에서 SMTP 추출
|
||
try
|
||
Result := vAccount.CurrentUser.Address;
|
||
// 만약 여기서도 /o= 가 나온다면 PropertyAccessor 사용
|
||
if (Result <> '') and (Result[1] = '/') then
|
||
Result := vAccount.CurrentUser.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS);
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
// 2. 실패 시 Application.Session.CurrentUser 확인
|
||
if Result = '' then
|
||
begin
|
||
try
|
||
Result := vItem.Application.Session.CurrentUser.Address;
|
||
if (Result <> '') and (Result[1] = '/') then
|
||
Result := vItem.Application.Session.CurrentUser.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS);
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
// 3. 마지막 수단: 처음 시도했던 방식들
|
||
if Result = '' then Result := vItem.SenderEmailAddress;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetToSMTP(aItem: IDispatch): WideString;
|
||
var
|
||
vItem, vRecips, vRecipient, vExUser: OleVariant;
|
||
i: Integer;
|
||
SmtpAddr: String;
|
||
const
|
||
// PropertyAccessor용 SMTP 태그
|
||
PR_SMTP_ADDRESS = 'http://schemas.microsoft.com/mapi/proptag/0x39FE001E';
|
||
begin
|
||
Result := '';
|
||
try
|
||
vItem := aItem;
|
||
vRecips := vItem.Recipients;
|
||
|
||
for i := 1 to vRecips.Count do
|
||
begin
|
||
vRecipient := vRecips.Item(i);
|
||
SmtpAddr := '';
|
||
|
||
try
|
||
// 1. 우선 AddressEntryUserType을 확인하여 Exchange 계정인지 체크
|
||
// 0: olExchangeUserAddressEntry, 5: olExchangeRemoteUserAddressEntry
|
||
if (vRecipient.AddressEntry.AddressEntryUserType = 0) or
|
||
(vRecipient.AddressEntry.AddressEntryUserType = 5) then
|
||
begin
|
||
vExUser := vRecipient.AddressEntry.GetExchangeUser;
|
||
if not VarIsClear(vExUser) then
|
||
SmtpAddr := vExUser.PrimarySmtpAddress;
|
||
end;
|
||
|
||
// 2. 위 방법으로 실패했거나 일반 계정인 경우 PropertyAccessor 시도
|
||
if SmtpAddr = '' then
|
||
SmtpAddr := vRecipient.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS);
|
||
|
||
// 3. 마지막 수단으로 일반 Address 속성 사용
|
||
if SmtpAddr = '' then
|
||
SmtpAddr := vRecipient.Address;
|
||
|
||
except
|
||
// 예외 발생 시 안전하게 기본 Address라도 가져옴
|
||
SmtpAddr := vRecipient.Address;
|
||
end;
|
||
|
||
// 여러 명일 경우 세미콜론(;)으로 구분하여 결합
|
||
if SmtpAddr <> '' then
|
||
begin
|
||
if Result <> '' then Result := Result + '; ';
|
||
Result := Result + SmtpAddr;
|
||
end;
|
||
end;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetTo(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).To;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetCC(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).CC;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetBCC(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).BCC;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetRecipients(aItem: IDispatch): WideString;
|
||
var
|
||
i: Integer;
|
||
Recipients, Recipient : OleVariant;
|
||
sSum: String;
|
||
begin
|
||
try
|
||
sSum := '';
|
||
Recipients := OleVariant(aItem).Recipients;
|
||
for i := 1 to Recipients.Count do
|
||
begin
|
||
Recipient := Recipients.Item(i);
|
||
// SumString(sSum, Format('%s (%s)', [Recipient.Name, Recipient.Address]), '; ');
|
||
// 수신 이메일만 보이도록 수정 24_0430 13:56:39 kku
|
||
SumString(sSum, Recipient.Address, '; ');
|
||
end;
|
||
Result := sSum;
|
||
|
||
if (Result <> '') and (Result[1] = '/') then
|
||
Result := GetToSMTP(aItem);
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetSenderEmailAddress(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).SenderEmailAddress;
|
||
if (Result <> '') and (Result[1] = '/') then
|
||
Result := GetSenderEmail(aItem);
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetSender(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
// Result := OleVariant(aItem).Sender;
|
||
// if (Result <> '') and (Result[1] = '/') then
|
||
Result := 'GetSender';//GetSenderSMTP(aItem);
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetReceivedTime(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).ReceivedTime;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetCreationTime(aItem: IDispatch): WideString;
|
||
begin
|
||
try
|
||
Result := OleVariant(aItem).CreationTime;
|
||
except
|
||
Result := '';
|
||
end;
|
||
end;
|
||
|
||
function GetAttachments(aItem: IDispatch; var dwSize: DWORD; const sCollectDir: String = ''): String;
|
||
var
|
||
i: Integer;
|
||
sDir,
|
||
sFName: String;
|
||
begin
|
||
dwSize := 0;
|
||
Result := '';
|
||
try
|
||
if sCollectDir <> '' then
|
||
DeleteDir(sCollectDir);
|
||
|
||
for i := 1 to OleVariant(aItem).Attachments.Count do
|
||
begin
|
||
sFName := OleVariant(aItem).Attachments[i].FileName;
|
||
if sFName <> '' then
|
||
begin
|
||
sFName := GetValidFileName(sFName, '#');
|
||
SumString(Result, sFName, '|');
|
||
Inc(dwSize, DWORD(OleVariant(aItem).Attachments[i].Size));
|
||
|
||
try
|
||
if sCollectDir <> '' then
|
||
begin
|
||
sDir := IncludeTrailingPathDelimiter(sCollectDir);
|
||
// var sSubject: String := GetSubject(aItem);
|
||
// if sSubject = '' then
|
||
// continue;
|
||
// var dt: TDateTime := StrToDateTimeDef(GetReceivedTime(aItem), 0);
|
||
// if dt = 0 then
|
||
// continue;
|
||
// sDir := sDir + FormatDateTime('yyddmmhhnnss-', dt) + GetValidFileName(sSubject) + '\';
|
||
if ForceDirectories(sDir) then
|
||
begin
|
||
OleVariant(aItem).Attachments[i].SaveAsFile(sDir + sFName);
|
||
end;
|
||
end;
|
||
except
|
||
|
||
end;
|
||
end;
|
||
end;
|
||
except
|
||
|
||
end;
|
||
end;
|
||
|
||
function ClearAttachments(aItem: IDispatch; llLimitSize: LONGLONG = 0): String;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := '';
|
||
try
|
||
for i := OleVariant(aItem).Attachments.Count downto 1 do
|
||
begin
|
||
try
|
||
if llLimitSize < OleVariant(aItem).Attachments[i].Size then
|
||
OleVariant(aItem).Attachments.Remove(i);
|
||
except
|
||
|
||
end;
|
||
end;
|
||
except
|
||
|
||
end;
|
||
end;
|
||
|
||
function RemoveAttachmentByName(aItem: IDispatch; sFName: String): String;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := '';
|
||
try
|
||
for i := OleVariant(aItem).Attachments.Count downto 1 do
|
||
begin
|
||
try
|
||
if CompareText(OleVariant(aItem).Attachments[i].FileName, sFName) = 0 then
|
||
OleVariant(aItem).Attachments.Remove(i);
|
||
except
|
||
|
||
end;
|
||
end;
|
||
except
|
||
|
||
end;
|
||
end;
|
||
|
||
{ TAddInModule }
|
||
|
||
procedure TAddInModule.OnEvtItemNotify(Sender: TObject; const Item: TItems; Action: TCollectionNotification);
|
||
begin
|
||
if Action = cnRemoved then
|
||
begin
|
||
Item.Disconnect;
|
||
Item.Free;
|
||
end;
|
||
end;
|
||
|
||
function TAddInModule.GetIsFolderTracked: Boolean;
|
||
begin
|
||
// if Assigned(ItemsEvents) then
|
||
if ItemsEventList_ <> nil then
|
||
Result := ItemsEventList_.Count > 0 // Assigned(ItemsEvents.DefaultInterface)
|
||
else
|
||
Result := false;
|
||
end;
|
||
|
||
procedure TAddInModule.SetIsFolderTracked(const bVal: Boolean);
|
||
var
|
||
DelFld, OutFld, CalFld,
|
||
CntFld, SendFld, TaskFld: MAPIFolder;
|
||
|
||
procedure ConnectFolder(aFolder: MAPIFolder);
|
||
var
|
||
item: TItems;
|
||
i: Integer;
|
||
begin
|
||
if (aFolder.EntryID = DelFld.EntryID) or (aFolder.EntryID = OutFld.EntryID) or (aFolder.EntryID = CalFld.EntryID) or
|
||
(aFolder.EntryID = CntFld.EntryID) or (aFolder.EntryID = SendFld.EntryID) or (aFolder.EntryID = TaskFld.EntryID) then
|
||
exit;
|
||
|
||
item := TItems.Create(Self);
|
||
item.OnItemAdd := ItemsAdd;
|
||
item.ConnectTo(aFolder.Items);
|
||
ItemsEventList_.Add(item);
|
||
|
||
if aFolder.Folders.Count > 0 then
|
||
begin
|
||
for i := 1 to aFolder.Folders.Count do
|
||
ConnectFolder(aFolder.Folders.Item(i));
|
||
end;
|
||
end;
|
||
|
||
var
|
||
Folders: _Folders;
|
||
i: Integer;
|
||
begin
|
||
if ItemsEventList_ <> nil then
|
||
begin
|
||
if not bVal then
|
||
begin
|
||
FreeAndNil(ItemsEventList_);
|
||
// ItemsEvents.Disconnect;
|
||
// ItemsEvents.Free;
|
||
// ItemsEvents := nil;
|
||
end;
|
||
end else
|
||
if bVal then
|
||
begin
|
||
try
|
||
ItemsEventList_ := TList<TItems>.Create;
|
||
|
||
DelFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderDeletedItems);
|
||
OutFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderOutbox);
|
||
CntFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderContacts);
|
||
SendFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderSentMail);
|
||
TaskFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderTasks);
|
||
CalFld := Self.OutlookApp.GetNamespace('MAPI').GetDefaultFolder(olFolderCalendar);
|
||
|
||
Folders := Self.OutlookApp.GetNamespace('MAPI').Folders;
|
||
for i := 1 to Folders.Count do
|
||
ConnectFolder(Folders.Item(i));
|
||
except
|
||
// ..
|
||
end;
|
||
|
||
// ItemsEvents := TItems.Create(Self);
|
||
// ItemsEvents.OnItemAdd := ItemsAdd;
|
||
// ItemsEvents.ConnectTo(
|
||
// Self.OutlookApp.GetNamespace('MAPI').
|
||
// GetDefaultFolder(olFolderInbox).Items);
|
||
end;
|
||
end;
|
||
|
||
procedure TAddInModule.ItemsAdd(ASender: TObject; const Item: IDispatch);
|
||
var
|
||
StrList: TStringList;
|
||
Send: ISendPacket;
|
||
dwSize: DWORD;
|
||
begin
|
||
if (_Client <> nil) and _Client.Connected and _Client.MailPo.bCollectRcvMail then
|
||
begin
|
||
Send := TTgPacket.Create(OAI_MAILITEM_RCV_DATA);
|
||
Send.S['Subject'] := GetSubject(Item);
|
||
Send.S['Body'] := GetBody(Item);
|
||
Send.S['Sender'] := GetSenderEmailAddress(Item);
|
||
Send.S['To'] := GetTo(Item);
|
||
Send.S['CC'] := GetCC(Item);
|
||
Send.S['BCC'] := GetBCC(Item);
|
||
Send.S['ReceivedTime'] := GetReceivedTime(Item);
|
||
Send.S['Attachments'] := GetAttachments(Item, dwSize);
|
||
Send.I['Size'] := dwSize;
|
||
try
|
||
Send.S['Folder'] := OleVariant(Item).Parent.Name;
|
||
except
|
||
|
||
end;
|
||
_Client.SendPacket(Send);
|
||
|
||
// Guard(StrList, TStringList.Create);
|
||
// StrList.Add(Format('Subject : %s', [GetSubject(Item)]));
|
||
// OleVariant(Item).Subject := '바보';
|
||
// StrList.Add(Format('Body : %s', [GetBody(Item)]));
|
||
// StrList.Add(Format('Sender : %s', [GetSenderEmailAddress(Item)]));
|
||
// StrList.Add(Format('To : %s', [GetTo(Item)]));
|
||
// StrList.Add(Format('CC : %s', [GetCC(Item)]));
|
||
// StrList.Add(Format('BCC : %s', [GetBCC(Item)]));
|
||
// StrList.Add(Format('ReceivedTime : %s', [GetReceivedTime(Item)]));
|
||
// ClearAttachments(Item);
|
||
// StrList.Add(Format('Attachments : %s', [GetAttachments(Item, dwSize)]));
|
||
// StrList.Add(Format('Size : %d', [dwSize]));
|
||
|
||
end;
|
||
end;
|
||
|
||
procedure TAddInModule.adxCOMAddInModuleAddInBeginShutdown(Sender: TObject);
|
||
begin
|
||
IsFolderTracked := false;
|
||
end;
|
||
|
||
procedure TAddInModule.adxCOMAddInModuleAddInFinalize(Sender: TObject);
|
||
begin
|
||
if _Client <> nil then
|
||
FreeAndNil(_Client);
|
||
end;
|
||
|
||
procedure TAddInModule.adxCOMAddInModuleAddInInitialize(Sender: TObject);
|
||
begin
|
||
if _Client = nil then
|
||
begin
|
||
SetRegValueString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'Version', VER_OUTLOOK_ADDIN, true);
|
||
|
||
_Client := TBS1OutlookAddInClient.Create;
|
||
if _Client.ActiveW2W then
|
||
SetRegValueString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'Outlook', IntToStr(_Client.GetSelfWnd), true);
|
||
end;
|
||
end;
|
||
|
||
procedure TAddInModule.adxCOMAddInModuleAddInStartupComplete(Sender: TObject);
|
||
begin
|
||
sVer_ := Copy(Self.OutlookApp.Version, 1, 4);
|
||
IsFolderTracked := true;
|
||
end;
|
||
|
||
function ExtrTextFromFile(sPath, sTempPath: String): String;
|
||
|
||
function ExtrTxtData(sSrcPath, sDestPath: String): Boolean;
|
||
var
|
||
sExe,
|
||
sParam: String;
|
||
O: ISuperObject;
|
||
Opt: TCttSimpleOpt;
|
||
nTry: Integer;
|
||
Label
|
||
LB_Retry;
|
||
begin
|
||
Result := false;
|
||
try
|
||
if not FileExists(sSrcPath) then
|
||
exit;
|
||
|
||
sExe := _Client.MailPo.sRunDir + EXE_KVCTTSCH;
|
||
if not FileExists(sExe) then
|
||
exit;
|
||
|
||
Opt.sSrcPath := sSrcPath;
|
||
Opt.sDestPath := sDestPath;
|
||
Opt.sAssocInfo := '';
|
||
|
||
sParam := sTempPath + '$kvcs.dat';
|
||
O := SO;
|
||
O.I['CSTT'] := Integer(csttExtrSimple);
|
||
O.O['SOpt'] := TTgJson.ValueToJsonObject<TCttSimpleOpt>(Opt);
|
||
|
||
nTry := 0;
|
||
LB_Retry :
|
||
if SaveJsonObjToFile(O, sParam) then
|
||
begin
|
||
if ExecuteAppWaitUntilTerminate(sExe, Format('-p "%s"', [sParam]), SW_HIDE, 20000) then
|
||
begin
|
||
if not FileExists(sDestPath) then
|
||
begin
|
||
Inc(nTry);
|
||
if nTry < 5 then
|
||
begin
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. ExecuteModule', 4);
|
||
Sleep(500);
|
||
goto LB_Retry;
|
||
end;
|
||
end;
|
||
Result := true;
|
||
end else
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. 1', 4);
|
||
end else
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. 2', 4);
|
||
except
|
||
// on E: Exception do
|
||
// ETgException.TraceException(E, 'Fail .. ExtrTextFromFile() .. ExtrTxtData()');
|
||
end;
|
||
end;
|
||
|
||
var
|
||
sDestPath: String;
|
||
StrList: TStringList;
|
||
begin
|
||
Result := '';
|
||
if _Client = nil then
|
||
exit;
|
||
|
||
sDestPath := sTempPath; // 'C:\taskToCSG\eCrmHE\OUT_Debug - Win64\Task\';
|
||
if ForceDirectories(sDestPath) then
|
||
begin
|
||
sDestPath := sDestPath + ExtractFileName(sPath) + '.$kv';
|
||
if ExtrTxtData(sPath, sDestPath) then
|
||
begin
|
||
Guard(StrList, TStringList.Create);
|
||
try
|
||
StrList.LoadFromFile(sDestPath, TEncoding.UTF8);
|
||
Result := StrList.Text;
|
||
except
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. 3', 4);
|
||
// ..
|
||
end;
|
||
|
||
{$IFDEF DEBUG}
|
||
if Result = '' then
|
||
begin
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. empty', 4);
|
||
exit;
|
||
end;
|
||
{$ENDIF}
|
||
DeleteFile(PChar(sDestPath));
|
||
|
||
// TTgTrace.T('ExtrTextFromFile() .. Length = %d', [Length(Result)], 4);
|
||
end;
|
||
end else
|
||
TTgTrace.T('Fail .. ExtrTextFromFile() .. not found', 4);
|
||
end;
|
||
|
||
procedure LogToReg(sVName, sLog: String); inline;
|
||
begin
|
||
// SetRegValueString(HKEY_CURRENT_USER, 'SOFTWARE\eCrmHomeEdition', sVName, sLog, true);
|
||
end;
|
||
|
||
function VarArrayAsBytes(const V: Variant): TBytes;
|
||
var SA: PSafeArray; Lo, Hi, Len: Integer; P: Pointer;
|
||
begin
|
||
if (VarType(V) and varArray) = 0 then Exit(nil);
|
||
SA := PSafeArray(TVarData(V).VArray);
|
||
SafeArrayGetLBound(SA, 1, Lo);
|
||
SafeArrayGetUBound(SA, 1, Hi);
|
||
Len := Hi - Lo + 1;
|
||
SetLength(Result, Len);
|
||
SafeArrayAccessData(SA, P);
|
||
try
|
||
Move(P^, Result[0], Len);
|
||
finally
|
||
SafeArrayUnaccessData(SA);
|
||
end;
|
||
end;
|
||
|
||
function GetBodyFromWordEditor(const AItem: IDispatch): String;
|
||
var
|
||
Mail: OleVariant;
|
||
Insp: OleVariant; // Outlook.Inspector
|
||
WordDoc: OleVariant; // Word._Document
|
||
begin
|
||
Result := '';
|
||
Mail := AItem;
|
||
|
||
// 편집기 핸들 얻기
|
||
Insp := Mail.GetInspector; // 에러시 try/except
|
||
// Word 문서 핸들
|
||
WordDoc := Insp.WordEditor; // _Document
|
||
|
||
// 순수 텍스트 (줄바꿈/서식 제거됨)
|
||
Result := VarToStrDef(WordDoc.Content.Text, '');
|
||
end;
|
||
|
||
function SendCopyData(hRcv: HWND; nCmd: Integer; sData: String): LRESULT;
|
||
var
|
||
CopyData: TCopyDataStruct;
|
||
dwResult: DWORD;
|
||
begin
|
||
try
|
||
if hRcv = 0 then
|
||
begin
|
||
Result := 0;
|
||
exit;
|
||
end;
|
||
|
||
ZeroMemory(@CopyData, SizeOf(CopyData));
|
||
CopyData.dwData := nCmd;
|
||
CopyData.cbData := (Length(sData) + 1) * 2;
|
||
CopyData.lpData := PChar(sData);
|
||
dwResult := 0;
|
||
Result := SendMessage(hRcv, WM_COPYDATA, 0, NativeInt(@CopyData));
|
||
// if SendMessageTimeout(hRcv, WM_COPYDATA, 0, NativeInt(@CopyData), SMTO_NORMAL, 3000, @dwResult) <> 0 then
|
||
// Result := dwResult;
|
||
except
|
||
// ...
|
||
end;
|
||
end;
|
||
|
||
procedure TAddInModule.adxOutlookAppEventsItemSend(ASender: TObject;
|
||
const Item: IDispatch; var Cancel: WordBool);
|
||
var
|
||
StrList: TStringList;
|
||
Send: ISendPacket;
|
||
dwSize: DWORD;
|
||
sResult,
|
||
sSubFounds,
|
||
sBodyFounds,
|
||
sSubFoundsEx,
|
||
sBodyFoundsEx,
|
||
sText: String;
|
||
i, c, nHits, nOrCnt, nAndCnt, nFind, n: Integer;
|
||
MailPo: TOutlookAddInPo;
|
||
hRcvHwnd: HWND;
|
||
bBlock, bMask: Boolean;
|
||
PatternEntList: TPatternEntList;
|
||
begin
|
||
bBlock := false;
|
||
bMask := false;
|
||
sSubFounds := '';
|
||
sBodyFounds := '';
|
||
sSubFoundsEx := '';
|
||
sBodyFoundsEx := '';
|
||
|
||
Send := nil;
|
||
MailPo := _Client.MailPo;
|
||
hRcvHwnd := _Client.RcvHwnd;
|
||
if (_Client <> nil) and _Client.Connected then
|
||
begin
|
||
if MailPo.bCollectSendMail then
|
||
begin
|
||
// 아웃룩 원문 처리
|
||
if MailPo.bMailCttSch and (_Client.MailPo.sPatterns <> '') then
|
||
begin
|
||
Guard(PatternEntList, TPatternEntList.Create);
|
||
if _Client.MailPo.sPatterns.Contains('scanoption') then
|
||
_Client.SetPatternList(_Client.MailPo.sPatterns, PatternEntList)
|
||
else
|
||
_Client.SetRuleToPtrnList(_Client.MailPo.sPatterns, PatternEntList);
|
||
|
||
// 제목 처리
|
||
case MailPo.MailCttSchPos of
|
||
mcsoSubject,
|
||
mcsoBoth : sText := GetSubject(Item);
|
||
else sText := '';
|
||
end;
|
||
|
||
if sText <> '' then
|
||
begin
|
||
nOrCnt := 0;
|
||
nAndCnt := 0;
|
||
nFind := 0;
|
||
Guard(StrList, TStringList.Create);
|
||
for i := 0 to PatternEntList.Count - 1 do
|
||
begin
|
||
nHits := TTgPcre.GetMatchValues(sText, PatternEntList[i].GetSearchText, sResult);
|
||
if nHits > 0 then
|
||
begin
|
||
if PatternEntList[i].IfCount > nHits then
|
||
continue;
|
||
|
||
if PatternEntList[i].IsAnd then
|
||
Inc(nAndCnt)
|
||
else
|
||
Inc(nOrCnt);
|
||
|
||
SumString(sSubFounds, Format('%s(%d)', [PatternEntList[i].Name, nHits]), ', ');
|
||
SumString(sSubFoundsEx, Format('%s|%s|%d', [PatternEntList[i].Name, sResult, nHits]), RESULT_SEPARATOR);
|
||
Inc(nFind);
|
||
|
||
if MailPo.MailCttSchProc = mcspMask then
|
||
begin
|
||
SplitString(sResult, ',', StrList, false, true);
|
||
for c := 0 to StrList.Count - 1 do
|
||
sText := StringReplace(sText, StrList[c], '&' + PatternEntList[i].Name + '&', [rfReplaceAll]);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
begin
|
||
if PatternEntList.AndCount > 0 then
|
||
begin
|
||
// AND 갯수가 다르다면 X
|
||
if nAndCnt <> PatternEntList.AndCount then
|
||
begin
|
||
nFind := 0;
|
||
sSubFounds := '';
|
||
sSubFoundsEx := '';
|
||
end;
|
||
|
||
// OR가 조건으로 있는데 검출된 OR가 없다면 X
|
||
if (PatternEntList.AndCount <> PatternEntList.Count) and (nOrCnt = 0) then
|
||
begin
|
||
nFind := 0;
|
||
sSubFounds := '';
|
||
sSubFoundsEx := '';
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
case MailPo.MailCttSchProc of
|
||
mcspUnknown : ;
|
||
mcspClear :
|
||
begin
|
||
ClearAttachments(Item);
|
||
bBlock := true;
|
||
try
|
||
OleVariant(Item).Subject := '[Security] Subject Block'; // '[보안] 제목 차단';
|
||
except
|
||
// ....
|
||
end;
|
||
end;
|
||
mcspMask :
|
||
begin
|
||
bMask := true;
|
||
try
|
||
OleVariant(Item).Subject := sText;
|
||
except
|
||
// ....
|
||
end;
|
||
end;
|
||
end;
|
||
end else
|
||
begin
|
||
sSubFounds := '';
|
||
sSubFoundsEx := '';
|
||
end;
|
||
end;
|
||
|
||
// 본문 처리
|
||
case MailPo.MailCttSchPos of
|
||
mcsoBody,
|
||
mcsoBoth :
|
||
begin
|
||
sText := GetHTMLBody(Item);
|
||
if sText = '' then
|
||
sText := GetRtfBody(Item);
|
||
if sText = '' then
|
||
sText := GetBodyFromWordEditor(Item);
|
||
end;
|
||
else sText := '';
|
||
end;
|
||
|
||
if sText <> '' then
|
||
begin
|
||
nOrCnt := 0;
|
||
nAndCnt := 0;
|
||
nFind := 0;
|
||
Guard(StrList, TStringList.Create);
|
||
for i := 0 to PatternEntList.Count - 1 do
|
||
begin
|
||
nHits := TTgPcre.GetMatchValues(sText, PatternEntList[i].GetSearchText, sResult);
|
||
if nHits > 0 then
|
||
begin
|
||
if PatternEntList[i].IfCount > nHits then
|
||
continue;
|
||
|
||
if PatternEntList[i].IsAnd then
|
||
Inc(nAndCnt)
|
||
else
|
||
Inc(nOrCnt);
|
||
|
||
SumString(sBodyFounds, Format('%s(%d)', [PatternEntList[i].Name, nHits]), ', ');
|
||
SumString(sBodyFoundsEx, Format('%s|%s|%d', [PatternEntList[i].Name, sResult, nHits]), RESULT_SEPARATOR);
|
||
Inc(nFind);
|
||
|
||
if MailPo.MailCttSchProc = mcspMask then
|
||
begin
|
||
SplitString(sResult, ',', StrList, false, true);
|
||
for c := 0 to StrList.Count - 1 do
|
||
sText := StringReplace(sText, StrList[c], '&' + PatternEntList[i].Name + '&', [rfReplaceAll]);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
begin
|
||
if PatternEntList.AndCount > 0 then
|
||
begin
|
||
// AND 갯수가 다르다면 X
|
||
if nAndCnt <> PatternEntList.AndCount then
|
||
begin
|
||
nFind := 0;
|
||
sBodyFounds := '';
|
||
sBodyFoundsEx := '';
|
||
end;
|
||
|
||
// OR가 조건으로 있는데 검출된 OR가 없다면 X
|
||
if (PatternEntList.AndCount <> PatternEntList.Count) and (nOrCnt = 0) then
|
||
begin
|
||
nFind := 0;
|
||
sBodyFounds := '';
|
||
sBodyFoundsEx := '';
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
case MailPo.MailCttSchProc of
|
||
mcspUnknown : ;
|
||
mcspClear :
|
||
begin
|
||
ClearAttachments(Item);
|
||
bBlock := true;
|
||
try
|
||
sText := '개인정보가 검출되어 차단되었습니다.' + #13#10#13#10 +
|
||
'Personal information has been detected and blocked.' + #13#10#13#10 +
|
||
'個人情報が検出され、ブロックされました。' + #13#10#13#10 +
|
||
'检测到个人信息，已被阻止。';
|
||
OleVariant(Item).Body := sText;
|
||
except
|
||
// ....
|
||
end;
|
||
end;
|
||
mcspMask :
|
||
begin
|
||
bMask := true;
|
||
try
|
||
OleVariant(Item).HTMLBody := sText;
|
||
except
|
||
// ....
|
||
end;
|
||
end;
|
||
end;
|
||
end else
|
||
begin
|
||
sBodyFounds := '';
|
||
sBodyFoundsEx := '';
|
||
end;
|
||
end;
|
||
end else
|
||
if MailPo.MailCttSchProc = mcspClear then
|
||
begin
|
||
ClearAttachments(Item);
|
||
bBlock := true;
|
||
try
|
||
sText := '보안 정책으로 메일 발송이 차단되었습니다.' + #13#10#13#10 +
|
||
'Email sending was blocked by security policy.' + #13#10#13#10 +
|
||
'セキュリティポリシーによりメール送信がブロックされました。' + #13#10#13#10 +
|
||
'由于安全策略，邮件发送已被阻止。';
|
||
OleVariant(Item).Body := sText;
|
||
except
|
||
// ....
|
||
end;
|
||
end;
|
||
|
||
// var f: Integer := OleVariant(Item).BodyFormat;
|
||
// case f of
|
||
// 0 : LogToReg('Out-BodyFormat', 'Unspecified');
|
||
// 1 : LogToReg('Out-BodyFormat', 'Plain Text');
|
||
// 2 : LogToReg('Out-BodyFormat', 'HTML');
|
||
// 3 : LogToReg('Out-BodyFormat', 'RTF (Rich Text)');
|
||
// end;
|
||
// LogToReg('Out-ItemClass', IntToStr(OleVariant(Item).Class));
|
||
|
||
Send := TTgPacket.Create(OAI_MAILITEM_SEND_DATA);
|
||
Send.S['Subject'] := GetSubject(Item);
|
||
|
||
sText := GetBody(Item);
|
||
if sText = '' then
|
||
begin
|
||
sText := GetHTMLBody(Item);
|
||
if sText = '' then
|
||
sText := GetRtfBody(Item);
|
||
if sText = '' then
|
||
sText := GetBodyFromWordEditor(Item);
|
||
end;
|
||
LogToReg('Out-Body', sText);
|
||
Send.S['Body'] := sText;
|
||
Send.S['Sender'] := GetSenderEmailAddress(Item);
|
||
Send.S['To'] := GetTo(Item);
|
||
Send.S['CC'] := GetCC(Item);
|
||
Send.S['BCC'] := GetBCC(Item);
|
||
Send.S['ReceivedTime'] := GetReceivedTime(Item);
|
||
Send.S['Rcvs'] := GetRecipients(Item);
|
||
|
||
Send.I['Size'] := dwSize;
|
||
if bBlock then
|
||
Send.B['Block'] := true;
|
||
if bMask then
|
||
Send.B['Mask'] := true;
|
||
if (sSubFounds <> '') or (sBodyFounds <> '') then
|
||
begin
|
||
SumString(sSubFounds, sBodyFounds, ', ');
|
||
Send.S['Founds'] := sSubFounds;
|
||
end;
|
||
if (sSubFoundsEx <> '') or (sBodyFoundsEx <> '') then
|
||
begin
|
||
SumString(sSubFoundsEx, sBodyFoundsEx, RESULT_SEPARATOR);
|
||
Send.S['FoundsEx'] := sSubFoundsEx;
|
||
end;
|
||
end;
|
||
|
||
LogToReg('Out0', 'abc');
|
||
// 첨부파일 감지, 처리 24_0726 10:16:13 kku
|
||
if (MailPo.AttachAB.Kind <> abkNone) and
|
||
(MailPo.sCollectAttachPath <> '') and
|
||
ForceDirectories(MailPo.sCollectAttachPath) then
|
||
begin
|
||
if Send = nil then
|
||
begin
|
||
Send := TTgPacket.Create(OAI_MAILITEM_SEND_DATA);
|
||
Send.S['Subject'] := GetSubject(Item);
|
||
sText := GetBody(Item);
|
||
if sText = '' then
|
||
sText := GetHTMLBody(Item);
|
||
Send.S['Body'] := sText;
|
||
Send.S['Sender'] := GetSenderEmailAddress(Item);
|
||
Send.S['To'] := GetTo(Item);
|
||
Send.S['CC'] := GetCC(Item);
|
||
Send.S['BCC'] := GetBCC(Item);
|
||
Send.S['ReceivedTime'] := GetReceivedTime(Item);
|
||
Send.S['Rcvs'] := GetRecipients(Item);
|
||
end;
|
||
|
||
var sAttachs: String := '';
|
||
var OA: ISuperObject := TSuperObject.Create(stArray);
|
||
var O: ISuperObject;
|
||
|
||
if MailPo.AttachAB.ContentFilter.bActive and
|
||
(MailPo.AttachAB.ContentFilter.sPatterns <> '') then
|
||
begin
|
||
sAttachs := GetAttachments(Item, dwSize, MailPo.sCollectAttachPath);
|
||
if sAttachs <> '' then
|
||
begin
|
||
Guard(PatternEntList, TPatternEntList.Create);
|
||
_Client.SetRuleToPtrnList(MailPo.AttachAB.ContentFilter.sPatterns, PatternEntList);
|
||
|
||
var FileList: TStringList;
|
||
Guard(FileList, TStringList.Create);
|
||
SplitString(sAttachs, '|', FileList);
|
||
|
||
Guard(StrList, TStringList.Create);
|
||
|
||
var sExtrTxt: String := '';
|
||
for n := 0 to FileList.Count - 1 do
|
||
begin
|
||
sExtrTxt := ExtrTextFromFile(MailPo.sCollectAttachPath + FileList[n], MailPo.sCollectAttachPath);
|
||
if sExtrTxt <> '' then
|
||
begin
|
||
nOrCnt := 0;
|
||
nAndCnt := 0;
|
||
nFind := 0;
|
||
|
||
sSubFoundsEx := '';
|
||
|
||
for i := 0 to PatternEntList.Count - 1 do
|
||
begin
|
||
nHits := TTgPcre.GetMatchValues(sExtrTxt, PatternEntList[i].GetSearchText, sResult);
|
||
if nHits > 0 then
|
||
begin
|
||
if PatternEntList[i].IfCount > nHits then
|
||
continue;
|
||
|
||
if PatternEntList[i].IsAnd then
|
||
Inc(nAndCnt)
|
||
else
|
||
Inc(nOrCnt);
|
||
|
||
SumString(sSubFoundsEx, Format('%s|%s|%d', [PatternEntList[i].Name, sResult, nHits]), RESULT_SEPARATOR);
|
||
Inc(nFind);
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
begin
|
||
if PatternEntList.AndCount > 0 then
|
||
begin
|
||
// AND 갯수가 다르다면 X
|
||
if nAndCnt <> PatternEntList.AndCount then
|
||
begin
|
||
nFind := 0;
|
||
sSubFoundsEx := '';
|
||
end;
|
||
|
||
// OR가 조건으로 있는데 검출된 OR가 없다면 X
|
||
if (PatternEntList.AndCount <> PatternEntList.Count) and (nOrCnt = 0) then
|
||
begin
|
||
nFind := 0;
|
||
sSubFoundsEx := '';
|
||
end;
|
||
end;
|
||
|
||
if nFind > 0 then
|
||
begin
|
||
O := SO;
|
||
O.S['FName'] := FileList[n];
|
||
if MailPo.AttachAB.bCollectTxt then
|
||
O.S['Data'] := sExtrTxt;
|
||
O.I['Hits'] := nFind;
|
||
O.S['FoundEx'] := sSubFoundsEx;
|
||
|
||
if MailPo.AttachAB.Kind = abkBlock then
|
||
begin
|
||
var sHash: String := GetFileToSha1Str(MailPo.sCollectAttachPath + FileList[n]);
|
||
if SendCopyData(hRcvHwnd, HPCMD_APPROVAL_FILE, FileList[n] + '|' + sHash) <> 300 then
|
||
begin
|
||
RemoveAttachmentByName(Item, FileList[n]);
|
||
O.B['Block'] := true;
|
||
O.S['Hash'] := sHash;
|
||
end;
|
||
end;
|
||
|
||
OA.AsArray.Add(O);
|
||
end;
|
||
end else begin
|
||
sSubFoundsEx := '';
|
||
end;
|
||
end;
|
||
end;
|
||
LogToReg('Out6', 'abc');
|
||
end;
|
||
end else begin
|
||
sAttachs := GetAttachments(Item, dwSize, MailPo.sCollectAttachPath);
|
||
if sAttachs <> '' then
|
||
begin
|
||
var FileList: TStringList;
|
||
var sFName: String;
|
||
Guard(FileList, TStringList.Create);
|
||
SplitString(sAttachs, '|', FileList);
|
||
|
||
for n := 0 to FileList.Count - 1 do
|
||
begin
|
||
sFName := FileList[n];
|
||
if sFName = '' then
|
||
continue;
|
||
|
||
// 서명등 본문에 들어가는 이미지를 식별해서 예외 25_1203 10:49:17 kku
|
||
// 음... HPCMD_APPROVAL_FILE 일단 여기서 처리하도록 함
|
||
// if sFName.ToLower.StartsWith('image0') and (GetFileExt(sFName).ToUpper = 'PNG') then
|
||
// continue;
|
||
|
||
O := SO;
|
||
O.S['FName'] := sFName;
|
||
if MailPo.AttachAB.bCollectTxt then
|
||
O.S['Data'] := ExtrTextFromFile(MailPo.sCollectAttachPath + FileList[n], MailPo.sCollectAttachPath);
|
||
|
||
if MailPo.AttachAB.Kind = abkBlock then
|
||
begin
|
||
var sHash: String := GetFileToSha1Str(MailPo.sCollectAttachPath + FileList[n]);
|
||
if SendCopyData(hRcvHwnd, HPCMD_APPROVAL_FILE, FileList[n] + '|' + sHash) <> 300 then
|
||
begin
|
||
RemoveAttachmentByName(Item, FileList[n]);
|
||
O.B['Block'] := true;
|
||
O.S['Hash'] := GetFileToSha1Str(MailPo.sCollectAttachPath + FileList[n]);
|
||
end;
|
||
end;
|
||
// O.B['Block'] := MailPo.AttachAB.Kind = abkBlock;
|
||
|
||
OA.AsArray.Add(O);
|
||
end;
|
||
end;
|
||
|
||
// if MailPo.AttachAB.Kind = abkBlock then
|
||
// ClearAttachments(Item, 1);
|
||
end;
|
||
|
||
O := SO;
|
||
O.S['AttList'] := sAttachs;
|
||
O.S['AttatchDir'] := MailPo.sCollectAttachPath;
|
||
if OA.AsArray.Length > 0 then
|
||
O.O['AttFounds'] := OA;
|
||
|
||
Send.O['AFile'] := O;
|
||
end;
|
||
|
||
if Send <> nil then
|
||
_Client.SendPacket(Send);
|
||
end;
|
||
|
||
{
|
||
Guard(StrList, TStringList.Create);
|
||
// OleVariant(Item).HTMLBody := ReplaceStr(OleVariant(Item).HTMLBody, 'test', '바보');
|
||
StrList.Add(Format('Subject : %s', [GetSubject(Item)]));
|
||
StrList.Add(Format('Body : %s', [GetBody(Item)]));
|
||
StrList.Add(Format('Sender : %s', [GetSenderEmailAddress(Item)]));
|
||
StrList.Add(Format('To : %s', [GetTo(Item)]));
|
||
StrList.Add(Format('CC : %s', [GetCC(Item)]));
|
||
StrList.Add(Format('BCC : %s', [GetBCC(Item)]));
|
||
StrList.Add(Format('ReceivedTime : %s', [GetReceivedTime(Item)]));
|
||
// ClearAttachments;
|
||
StrList.Add(Format('Attachments : %s', [GetAttachments(Item, dwSize)]));
|
||
StrList.Add(Format('Size : %d', [dwSize]));
|
||
// OleVariant(Item).SaveAs('C:\Users\kku\Desktop\1\1.msg', olMSG);
|
||
// OleVariant(Item).SaveAs('C:\Users\kku\Desktop\1\2.html', olHTML);
|
||
// OleVariant(Item).BCC := 'kjkim@tocsg.co.kr'; // 전송 시 오류남, 다시 전송하면 잘됨
|
||
}
|
||
end;
|
||
|
||
initialization
|
||
TadxFactory.Create(ComServer, TCoBS1OutlookAddIn, CLASS_CoBS1OutlookAddIn, TAddInModule);
|
||
|
||
end.
|