BSOne.SFC/Tocsg.Module/OutlookMon/DOutMonMain.pas

457 lines
13 KiB
Plaintext
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit DOutMonMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, OutlookMonClient,
Vcl.Buttons, Vcl.ExtCtrls, Vcl.Menus, Tocsg.Controls, VirtualTrees;
const
WM_NOTIFY_SEND_DATA = WM_USER + 8547;
type
TMailKind = (mkRcv, mkSend);
PMailItem = ^TMailItem;
TMailItem = record
Kind: TMailKind;
sSubject,
sSender,
sFolder,
sTo, sCC, sBCC,
sBody, sAttachs: String;
dwAttachSize: DWORD;
dtRcv: TDateTime;
end;
TDlgOutMonMain = class(TForm)
pnTop: TPanel;
MainMenu: TMainMenu;
miSecu: TMenuItem;
miAddIn: TMenuItem;
miAddInReg: TMenuItem;
miAddInUnreg: TMenuItem;
miActive: TMenuItem;
N5: TMenuItem;
miDeactivce: TMenuItem;
N6: TMenuItem;
miExit: TMenuItem;
chCollectSendMail: TCheckBox;
chMailCttSch: TCheckBox;
chCollectAttach: TCheckBox;
edCollectAttachPath: TEdit;
chAttachLimit: TCheckBox;
edAttachLimit: TEdit;
CheckBox6: TCheckBox;
chCollectRcvMail: TCheckBox;
btnSetPatterns: TSpeedButton;
vtList: TVirtualStringTree;
mmInfo: TMemo;
Splitter1: TSplitter;
popFun: TPopupMenu;
N1: TMenuItem;
cbCttSchProc: TComboBox;
Label1: TLabel;
lbState: TLabel;
tState: TTimer;
procedure miExitClick(Sender: TObject);
procedure btnSetPatternsClick(Sender: TObject);
procedure miSecuClick(Sender: TObject);
procedure miActiveClick(Sender: TObject);
procedure miDeactivceClick(Sender: TObject);
procedure vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure vtListFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vtListGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
var HintText: string);
procedure vtListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vtListFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex);
procedure N1Click(Sender: TObject);
procedure tStateTimer(Sender: TObject);
procedure miAddInRegClick(Sender: TObject);
procedure miAddInUnregClick(Sender: TObject);
private
{ Private declarations }
MgCtrls_: TManagerInputControlsData;
Client_: TOutlookMonClient;
procedure SetOptEnabled(bVal: Boolean);
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure process_WM_NOTIFY_SEND_DATA(var msg: TMessage); Message WM_NOTIFY_SEND_DATA;
procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND;
end;
var
DlgOutMonMain: TDlgOutMonMain;
gMain: TDlgOutMonMain = nil;
implementation
uses
Tocsg.Packet, Tocsg.Registry, Tocsg.Path, Tocsg.Safe, DSelectPattern, Define,
GlobalOutAddInDefine, Tocsg.Convert, Tocsg.VTUtil, Tocsg.Process, Tocsg.Shell;
{$R *.dfm}
Constructor TDlgOutMonMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
ASSERT(gMain = nil);
gMain := Self;
Caption := APP_TITLE;
MgCtrls_ := TManagerInputControlsData.Create(CutFileExt(GetRunExePath) + '.ini');
MgCtrls_.RegInputCtrl(chCollectSendMail);
MgCtrls_.RegInputCtrl(chCollectRcvMail);
MgCtrls_.RegInputCtrl(cbCttSchProc);
MgCtrls_.RegInputCtrl(chCollectAttach);
MgCtrls_.RegInputCtrl(chAttachLimit);
MgCtrls_.RegInputCtrl(edCollectAttachPath);
MgCtrls_.RegInputCtrl(edAttachLimit);
MgCtrls_.Load;
Client_ := TOutlookMonClient.Create;
mmInfo.Clear;
tState.Enabled := true;
end;
Destructor TDlgOutMonMain.Destroy;
begin
gMain := nil;
Client_.DeactiveW2W;
FreeAndNil(Client_);
FreeAndNil(MgCtrls_);
Inherited;
end;
procedure TDlgOutMonMain.SetOptEnabled(bVal: Boolean);
begin
chCollectSendMail.Enabled := bVal;
chMailCttSch.Enabled := bVal;
cbCttSchProc.Enabled := bVal;
chCollectAttach.Enabled := bVal;
btnSetPatterns.Enabled := bVal;
edCollectAttachPath.Enabled := bVal;
chAttachLimit.Enabled := bVal;
edAttachLimit.Enabled := bVal;
chCollectRcvMail.Enabled := bVal;
end;
procedure TDlgOutMonMain.tStateTimer(Sender: TObject);
begin
if Client_.Connected then
begin
lbState.Caption := 'Outlook <20><><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD>)';
lbState.Font.Color := clBlue;
end else
if Client_.GetSelfWnd <> 0 then
begin
lbState.Caption := 'Outlook <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..';
lbState.Font.Color := clGreen;
end else
if not ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
lbState.Caption := '<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD> <20>̼<EFBFBD>ġ';
lbState.Font.Color := clGray;
end else begin
lbState.Caption := '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>..';
lbState.Font.Color := clBlack;
end;
end;
procedure TDlgOutMonMain.btnSetPatternsClick(Sender: TObject);
var
dlg: TDlgSelectPattern;
begin
Guard(dlg, TDlgSelectPattern.Create(Self));
dlg.ShowModal;
end;
procedure TDlgOutMonMain.miActiveClick(Sender: TObject);
begin
if Client_.GetSelfWnd = 0 then
begin
if not ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD> <20>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>ġ<EFBFBD>Ǿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'+#13+#10+
'[<5B>޴<EFBFBD> > <20><><EFBFBD><EFBFBD> > Outlook <20>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD> > <20><>ġ]<5D><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD>ּ<EFBFBD><D6BC><EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
with Client_.MailPo do
begin
bCollectRcvMail := chCollectRcvMail.Checked;
bCollectSendMail := chCollectSendMail.Checked;
bMailCttSch := chMailCttSch.Checked;
bCollectAttach := chCollectAttach.Checked;
bBlockAttSize := chAttachLimit.Checked;
llAttachLimit := StrToInt64Def(edAttachLimit.Text, 0) * 1048576;
case cbCttSchProc.ItemIndex of
0 : MailCttSchProc := mcspMask;
1 : MailCttSchProc := mcspClear
end;
sCttSchPtrnPath := GetRunExePathDir + 'ptnsch.dat';
sCollectAttachPath := edCollectAttachPath.Text;
if bMailCttSch and (sCollectAttachPath <> '') and not ForceDirectories(sCollectAttachPath) then
sCollectAttachPath := '';
end;
MgCtrls_.Save;
SetOptEnabled(false);
if Client_.ActiveW2W then
SetRegValueString(HKEY_CURRENT_USER, 'Software\BS1Addin', 'OutMon', IntToStr(Client_.GetSelfWnd), true);
end;
end;
procedure TDlgOutMonMain.miAddInRegClick(Sender: TObject);
var
sPath: String;
begin
if ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>̹<EFBFBD> <20><>ġ<EFBFBD>Ǿ<EFBFBD> <20>ֽ<EFBFBD><D6BD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
if GetProcessPidByName('OUTLOOK.EXE') <> 0 then
begin
MessageBox(Handle, PChar('Outlook<6F><6B> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD> <20>ֽ<EFBFBD><D6BD>ϴ<EFBFBD>.'+#13+#10+
'Outlook<6F><6B> <20><><EFBFBD><EFBFBD> <20><> <20>ٽ<EFBFBD> <20>õ<EFBFBD><C3B5><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
sPath := GetRunExePathDir;
if DirectoryExists(GetProgramFilesDir + 'Microsoft Office') then
begin
// 32bit ȯ<><C8AF><EFBFBD>̱<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> "C:\Program Files (x86)\Microsoft Office"<22><> <20><><EFBFBD><EFBFBD> <20>ؾ<EFBFBD><D8BE><EFBFBD>
sPath := sPath + 'Bs1out.dll';
end else
sPath := sPath + 'Bs1out64.dll';
if not FileExists(sPath) then
begin
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD> DLL<4C><4C> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
ExecutePath_hide('regsvr32.exe', Format('/i /s "%s"', [sPath]));
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>ġ <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgOutMonMain.miAddInUnregClick(Sender: TObject);
var
sPath: String;
begin
if not ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>ġ<EFBFBD>Ǿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
if GetProcessPidByName('OUTLOOK.EXE') <> 0 then
begin
MessageBox(Handle, PChar('Outlook<6F><6B> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD> <20>ֽ<EFBFBD><D6BD>ϴ<EFBFBD>.'+#13+#10+
'Outlook<6F><6B> <20><><EFBFBD><EFBFBD> <20><> <20>ٽ<EFBFBD> <20>õ<EFBFBD><C3B5><EFBFBD><EFBFBD>ֽʽÿ<CABD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
if MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
Client_.DeactiveW2W;
SetOptEnabled(true);
sPath := GetRunExePathDir;
if DirectoryExists(GetProgramFilesDir + 'Microsoft Office') then
begin
// 32bit ȯ<><C8AF><EFBFBD>̱<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> "C:\Program Files (x86)\Microsoft Office"<22><> <20><><EFBFBD><EFBFBD> <20>ؾ<EFBFBD><D8BE><EFBFBD>
sPath := sPath + 'Bs1out.dll';
end else
sPath := sPath + 'Bs1out64.dll';
if not FileExists(sPath) then
begin
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD> DLL<4C><4C> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
ExecutePath_hide('regsvr32.exe', Format('/u /s "%s"', [sPath]));
MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ǿ<EFBFBD><C7BE><EFBFBD><EFBFBD>ϴ<EFBFBD>.'), PChar(Caption), MB_ICONINFORMATION or MB_OK);
end;
procedure TDlgOutMonMain.miDeactivceClick(Sender: TObject);
begin
if Client_.GetSelfWnd <> 0 then
begin
if MessageBox(Handle, PChar('Outlook <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
Client_.DeactiveW2W;
end;
SetOptEnabled(true);
end;
procedure TDlgOutMonMain.miExitClick(Sender: TObject);
begin
if ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey) then
begin
if MessageBox(Handle, PChar('<27>÷<EFBFBD><C3B7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.'+#13+#10+'<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONWARNING or MB_YESNO) = IDNO then exit;
end else
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
Close;
end;
procedure TDlgOutMonMain.miSecuClick(Sender: TObject);
begin
miActive.Enabled := not (Client_.GetSelfWnd <> 0); // Client_.Connected;
miDeactivce.Enabled := not miActive.Enabled;
miActive.Checked := not miActive.Enabled;
miAddInReg.Enabled := not ExistsKey(HKEY_CLASSES_ROOT, REG_BS1OutlookAddInKey);
miAddInUnreg.Enabled := not miAddInReg.Enabled;
miAddInReg.Checked := not miAddInReg.Enabled;
end;
procedure TDlgOutMonMain.N1Click(Sender: TObject);
begin
if MessageBox(Handle, PChar('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʱ<EFBFBD>ȭ <20>Ͻðڽ<C3B0><DABD>ϱ<EFBFBD>?'),
PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then exit;
VT_Clear(vtList);
mmInfo.Clear;
end;
procedure TDlgOutMonMain.vtListFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
pData: PMailItem;
begin
if Node = nil then
exit;
pData := Sender.GetNodeData(Node);
mmInfo.Clear;
mmInfo.Lines.Add(Format('<27><><EFBFBD><EFBFBD> : %s', [pData.sSubject]));
mmInfo.Lines.Add(Format('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> : %s', [pData.sSender]));
mmInfo.Lines.Add(Format('<27>޴<EFBFBD> <20><><EFBFBD><EFBFBD> : %s', [pData.sTo]));
mmInfo.Lines.Add(Format('<27><><EFBFBD><EFBFBD> : %s', [pData.sCC]));
mmInfo.Lines.Add(Format('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> : %s', [pData.sBCC]));
mmInfo.Lines.Add(Format('<27><><EFBFBD><EFBFBD> <20>ð<EFBFBD> : %s', [DateTimeToStr(pData.dtRcv)]));
if pData.sAttachs <> '' then
mmInfo.Lines.Add(Format('÷<><C3B7> <20><><EFBFBD><EFBFBD> : %s (<28><>ü ũ<><C5A9> : %s)', [pData.sAttachs, ByteSizeToStr(pData.dwAttachSize)]));
mmInfo.Lines.Add('');
mmInfo.Lines.Add(pData.sBody);
mmInfo.SelStart := 0;
mmInfo.Perform(EM_SCROLLCARET, 0, 0);
end;
procedure TDlgOutMonMain.vtListFreeNode(Sender: TBaseVirtualTree;
Node: PVirtualNode);
var
pData: PMailItem;
begin
pData := Sender.GetNodeData(Node);
Finalize(pData^);
end;
procedure TDlgOutMonMain.vtListGetHint(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex;
var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: string);
begin
HintText := vtList.Text[Node, Column];
end;
procedure TDlgOutMonMain.vtListGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TMailItem);
end;
procedure TDlgOutMonMain.vtListGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: string);
var
pData: PMailItem;
begin
pData := Sender.GetNodeData(Node);
case Column of
0 : CellText := IntToStr(Node.Index + 1);
1 :
begin
if pData.Kind = mkRcv then
begin
if pData.sFolder = '' then
CellText := '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>'
else
CellText := Format('<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> (%s)', [pData.sFolder]);
end else
CellText := '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>';
end;
2 : CellText := pData.sSender;
3 : CellText := pData.sTo;
4 : CellText := pData.sCC;
5 : CellText := pData.sBCC;
6 : CellText := pData.sSubject;
7 : CellText := pData.sAttachs;
8 : CellText := ByteSizeToStr(pData.dwAttachSize);
9 : CellText := DateTimeToStr(pData.dtRcv);
end;
end;
procedure TDlgOutMonMain.process_WM_NOTIFY_SEND_DATA(var msg: TMessage);
var
Rcv: IRcvPacket;
pData: PMailItem;
begin
Rcv := IRcvPacket(msg.LParam);
vtList.BeginUpdate;
try
pData := VT_AddChildData(vtList);
pData.Kind := mkRcv;
with Rcv do
begin
pData.sSubject := S['Subject'];
pData.sSender := S['Sender'];
pData.sTo := S['To'];
pData.sCC := S['CC'];
pData.sBCC := S['BCC'];
pData.sBody := S['Body'];
pData.sAttachs := S['Attachments'];
pData.dwAttachSize := I['Size'];
pData.sFolder := S['Folder'];
pData.dtRcv := StrToDateTimeDef(S['ReceivedTime'], 0);
end;
case msg.WParam of
OAI_MAILITEM_RCV_DATA : pData.Kind := mkRcv;
OAI_MAILITEM_SEND_DATA : pData.Kind := mkSend;
end;
finally
vtList.EndUpdate;
end;
end;
procedure TDlgOutMonMain.process_WM_SYSCOMMAND(var msg: TWMSysCommand);
begin
if msg.CmdType = SC_CLOSE then
begin
miExit.Click;
exit;
end;
Inherited;
end;
end.