BSOne.SFC/eCrmHE/DLL_BS1OutlookAddIn/BS1OutlookAddIn_IMPL.pas

1269 lines
38 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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)
adxOutlookAppEvents: TadxOutlookAppEvents;
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;
// ManagerService.pas에 똑같은거 있음. 변경 시 참고
function GetFileToSha1Str_BS1(sPath: String; bFastHash: Boolean): String;
var
dtCreate, dtModify, dtAccess: TDateTime;
begin
if bFastHash then
begin
if not GetFileDateTime_Local(sPath, dtCreate, dtModify, dtAccess) then
begin
dtCreate := 0;
dtModify := 0;
dtAccess := 0;
end;
sPath := FormatDateTime('yymmddhhnnss+', dtModify) + IntToStr(GetFileSize_path(sPath));
Result := ConvStrToSha1W(sPath);
end else
Result := GetFileToSha1Str(sPath);
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;
var DelList: TStringList;
Guard(DelList, TStringList.Create);
var bDoBlock: Boolean := MailPo.AttachAB.Kind = abkBlock;
if bDoBlock and (MailPo.nBlockSizeMB > 0) then
begin
// 첨부파일 크기 확인, 차단
sAttachs := GetAttachments(Item, dwSize, MailPo.sCollectAttachPath);
if sAttachs <> '' then
begin
var FileList: TStringList;
Guard(FileList, TStringList.Create);
SplitString(sAttachs, '|', FileList);
var llBlockSize: LONGLONG := LONGLONG(MailPo.nBlockSizeMB) * 1048576;
for n := 0 to FileList.Count - 1 do
begin
if llBlockSize <= GetFileSize_path(MailPo.sCollectAttachPath + FileList[n]) then
begin
DelList.Add(FileList[i]);
O := SO;
O.S['FName'] := FileList[n];
if MailPo.AttachAB.bCollectTxt then
O.S['Data'] := ExtrTextFromFile(MailPo.sCollectAttachPath + FileList[n], MailPo.sCollectAttachPath);;
O.I['Hits'] := -100;
if MailPo.AttachAB.Kind = abkBlock then
begin
var sHash: String := GetFileToSha1Str_BS1(MailPo.sCollectAttachPath + FileList[n], MailPo.bFastHash);
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 else bDoBlock := false; // 낄끔하진 않지만 이렇게 처리, 내용 검색 없을때 여기서 걸러진거 차단되지 않도록 조치 26_0120 15:18:44 kku&
end;
end;
end;
if MailPo.AttachAB.ContentFilter.bActive and
(MailPo.AttachAB.ContentFilter.sPatterns <> '') then
begin
if sAttachs = '' then
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);
var sExtrTxt: String := '';
for n := 0 to FileList.Count - 1 do
begin
if DelList.IndexOf(FileList[i]) <> -1 then
continue;
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_BS1(MailPo.sCollectAttachPath + FileList[n], MailPo.bFastHash);
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
if sAttachs = '' then
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;
if DelList.IndexOf(sFName) <> -1 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 bDoBlock then
begin
var sHash: String := GetFileToSha1Str_BS1(MailPo.sCollectAttachPath + FileList[n], MailPo.bFastHash);
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;
// 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.