在
在世寻欢
Unregistered / Unconfirmed
GUEST, unregistred user!
先把代码贴出来吧：
[一]
unit WatchThread; //监控线程定义单元
interface
uses
Classes,SysUtils,StdCtrls,Windows,Dialogs,Main;
type
TWatchThread = class(TThread)
private
FIndex:BYTE; //程序中有用户定义的多个监控目录，没个目录启用一个线程，这是索引号
FPath
AnsiChar; //监控的目录路径
FHandle:THandle;
bKickHidden:Boolean; //是否忽略隐藏文件的变化
IgnoreFileList:TStrings; //忽略文件列表，当这些文件发生变化时，忽略之
lpBufferointer; //存储文件变化信息结构的内存块指针
pszTrack:string; //将要写入文件变化记录文本文件的字符串
pszDir:string; //目录名
protected
procedure BeginWatch();
procedure Execute; override;
procedure CheckFileInfo(lpFileInfoFileNotifyInformation); //分析
public
constructor Create(CreateSuspended:Boolean;WatchPathAnsiChar;AIndex:BYTE;bIgnoreHidden:Boolean;IgnoreFiles:TStrings);
destructor Destroy;override;
end;
implementation
procedure TWatchThread.CheckFileInfo(lpFileInfoFileNotifyInformation);
var
pszFileName,pszTemp:string;
begin
if lpFileinfo^.Action<>FILE_ACTION_MODIFIED then Exit; //不是文件内容修改事件
pszFileName:=pszDir+WideCharToString(@(lpFileInfo^.FileName[0]));
if Pos('DESKTOP.INI',UpperCase(pszFileName))>0 then Exit; //过滤名称为desktop.ini的无意义文件
if FileIsHidden(pszFileName) and bkickHidden then Exit;//过滤隐藏文件
if IgnoreFileList.IndexOf(pszFileName)>-1 then Exit; //过滤忽略文件列表中的文件
pszTemp:=FormatDateTime('c": "',Now)+Format('文件[%s]内容被修改',[pszFileName]);
if SameText(UpperCase(pszTrack),UpperCase(pszTemp)) then Exit; （*已经得到一次通知了（不知道为什么，监控的不是根目录时，一次变化会得到两次通知*）
pszTrack:=pszTemp;//保存通知字符串，以便跟下一次通知比较，看是否是同一次文件变化的重复通知
AppendTrackList(pszTrack,FIndex); //将变化写入对应的文件
end;
procedure TWatchThread.BeginWatch;
var
dwRetBytes: DWORD;//写入缓冲区的字节数
lpFileInfoFileNotifyInformation;//指针
dwOffset:Integer;//缓冲区中两个FileNotifyInformation间的字节位移
begin
GetMem(lpBuffer,nSize);//分配缓冲区空间，nSize为定义在Main.pas中的常量
ZeroMemory(lpBuffer,nSize);
FHandle := CreateFile(FPath,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
0);//打开监控目录，得到需要的句柄
dwRetBytes:=0;
while ReadDirectoryChanges(FHandle,lpBuffer,nSize,True,
FILE_NOTIFY_CHANGE_LAST_WRITE,
@dwRetBytes,nil,nil) and not Terminated do
begin
if dwRetBytes=0 then
begin
ZeroMemory(lpBuffer,nSize);
Continue;
end;//没有变化
lpFileInfo:=PFileNotifyInformation(lpBuffer);//获得第一个结构的指针
while True do
begin
CheckFileInfo(lpFileInfo);//分析该结构
dwOffset:=lpFileInfo^.NextEntryOffset;//下一个结构的字节数位移
if dwOffset>0 then
lpFileInfo:=PFileNotifyInformation(PAnsiChar(lpFileInfo)+dwOffset)//存在下一个结构，即发生了多个变化
else
begin
ZeroMemory(lpBuffer,nSize);
dwRetBytes:=0;
Break;//没有其他变化了，循环继续
end;
end;
end;
end;
constructor TWatchThread.Create(CreateSuspended: Boolean;
WatchPath: PAnsiChar; AIndex:BYTE;bIgnoreHidden:Boolean;IgnoreFiles:TStrings);
begin
inherited Create(CreateSuspended);
FPath:=WatchPath;
FIndex:=AIndex;
FreeOnTerminate:=True;
bKickHidden:=bIgnoreHidden;
IgnoreFileList:=TStringList.Create;
if IgnoreFiles.Count>0 then
IgnoreFileList.Assign(IgnoreFiles);
pszDir:=StrPas(FPath);
if pszDir[Length(pszDir)]<>'/' then
pszDir:=pszDir+'/';//因为结构中的路径是相对路径，所以要加上监控路径构成全路径再写入文件
end;
destructor TWatchThread.Destroy;
begin
FreeMem(lpBuffer,nSize);
inherited;
end;
procedure TWatchThread.Execute;
begin
inherited;
BeginWatch;
end;
end.
[二]
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShlObj,ActiveX, Menus, WinSkinData, StdCtrls, DB,DBGrids,
RzButton,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP,IdMessage, Buttons, ComCtrls, CheckLst, ExtCtrls,
ToolWin, ImgList, Grids, PBFolderDialog, SnCheckBox, SnEdit, SnButton,
RzEdit, RzShellDialogs, SnIPEdit, SnLabel,ShellAPI, TFlatListBoxUnit;
type TNOTIFYREGISTER = record
pidlPath : PItemIDList;
bWatchSubtree : Boolean;
end; //监控结构
type
PFileNotifyInformation=^TFileNotifyInformation;
TFileNotifyInformation=record
NextEntryOffsetWORD;
ActionWORD;
FileNameLengthWORD;
FileName: Array [0..0] of WideChar;
end;
type
TWatchState=(wsOpen,wsPause,wsNoWatchItem);//枚举，表示监控状态
type
PWatchItem=^TWatchItem;
TWatchItem=record //监控项的详细信息
ID:Integer;//编号
Folder,MailFrom,MailAdmin:string;//目录路径，邮件发件人和邮件管理员帐户
MailToList,IgnoreDirs:TStrings;//收件人列表和忽略文件列表
IgnoreHidden,WatchSubTree:Boolean;//是否忽略隐藏文件，是否监控子目录的布尔标志
FirstSendTime,SecondSendTime:TDateTime;//发送邮件的时间，一天2次。
end;
type TShellInfo=Record
pidlArr:array [0..1] of PItemIDList;
end;//接收通知信息结构
TItemState=(isBrowse,isEdit,isNew);//状态标志
type PShellInfo=^TShellInfo;
PNOTIFYREGISTER = ^TNOTIFYREGISTER;
PPItemIDList = ^PItemIDList;
type
TPrevOperationInfo=record
EventID:Cardinal;
PrevPath,CurPath:string;
end;//保存前一次通知信息的结构，也是因为一次操作引起两次通知的BUG，不知道什么原因
type
TFrmMain = class(TForm)
SkinCtrl: TSkinData;
WatchList: TCheckListBox;
LblEdtDir: TLabeledEdit;
LblEdtMailFrom: TLabeledEdit;
LblEdtMailAdmin: TLabeledEdit;
StaticText1: TStaticText;
lbMailTo: TListBox;
LblEdtFirstTime: TLabeledEdit;
LblEdtSecondTime: TLabeledEdit;
lbFilter: TListBox;
StaticText2: TStaticText;
tbFilter: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
OpenDlg: TOpenDialog;
ToolBar2: TToolBar;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
cbIgnoreHidden: TSnCheckBox;
cbWatchSubTree: TSnCheckBox;
btnOK: TSnButton;
btnCancel: TSnButton;
EdtMailAddr: TSnEdit;
btnBrowse: TSnButton;
cbAutoRun: TSnCheckBox;
cbHideOnRun: TSnCheckBox;
FolderDlg: TRzSelectFolderDialog;
ipMailServer: TSnIPEdit;
SnLabel1: TSnLabel;
btnChange: TSnButton;
IconMenu: TPopupMenu;
miClose: TMenuItem;
miSwitch: TMenuItem;
miShow: TMenuItem;
Timer1: TTimer;
procedure SetState(bFlag:Boolean);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WndProc(var message:TMessage);override;
procedure WatchListClick(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure EdtMailAddrChange(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure EdtMailAddrKeyPress(Sender: TObject; var Key: Char);
procedure btnCancelClick(Sender: TObject);
procedure btnChangeClick(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure miCloseClick(Sender: TObject);
procedure miSwitchClick(Sender: TObject);
procedure miShowClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
public
WatchItemList: array of TWatchItem;
private
bFirstShow: Boolean;
TrayStruct:TNotifyIconData;
pszMailServer:string;
IconMsgID:Cardinal;
fMailCtrl:TidSMTP;
ItemState:TItemState;
idTimer:UINT;
MailTimeList:TStrings;
NotifyMsgID:Cardinal;
lpStruct:array of TNOTIFYREGISTER;
NotifyCount: WORD;
hShell: THandle;
EventMask: Cardinal;
WatchState:TWatchState;
PrevOperationInfo: TPrevOperationInfo;
procedure OneParamEventHandler(EventID:Cardinal;Path:string);
procedure TwoParamEventHandler(EventID:Cardinal;pszPrevPath,pszCurPath:string);
procedure SendMail(FileList:TStrings);
procedure PrepareForNewItem;
procedure SHRegister();
procedure SHUnRegister();
procedure RemoveWatchItem(nIdx:BYTE);
procedure CreateTray;
procedure WMSysCommand(var message:TWMSysCommand);message WM_SYSCOMMAND;
end;
function FileIsHidden(Path:string):Boolean;
procedure AppendTrackList(pszTrack:string;ID:Integer);
procedure AppendLog(pszLog:string);
function SHChangeNotifyRegister(
fHandle : HWND;
dwFlags : Integer;
wEventMask : Cardinal; //通知WINDOWS想要得到通知的事件
uMsg : UINT; //通知消息ID
cItems : integer; //NOTIFYREGISTER数组的元素个数
lpItems : PNOTIFYREGISTER(*NOTIFYREGISTER数组指针*)) : HWND; stdcall;
function SHChangeNotifyDeregister(
hWnd : HWND) : boolean; stdcall;
function SHILCreateFromPath(Path: LPCWSTR;
PIDL: PPItemIDList;Attributes: PDWORD):
HResult; stdcall;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
const
nSize=10*(SizeOf(TFileNotifyInformation)+MAX_PATH);
var
FrmMain:TFrmMain;
implementation
uses
DM,IniFiles,Registry,WatchThread;
{$R *.dfm}
const
Shell32DLL = 'shell32.dll';
pszIconTip = '文件和目录监控';
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;
WM_NO_NOTIFYICON =0;
SHCNE_STARTUP = $0000;
pszRegItem='Software/Microsoft/Windows/CurrentVersion/Run';
pszRegValueName='FSWatcher';
var
ThrdList:array of TWatchThread;
function SHChangeNotifyRegister;
external Shell32DLL index 2;
function SHChangeNotifyDeregister;
external Shell32DLL index 4;
function SHILCreateFromPath;
external Shell32DLL index 28;
function AppIsInRunQuque():Boolean;
var
Reg:TRegistry;
ValueList:TStrings;
i:BYTE;
begin
Result:=False;
Reg:=TRegistry.Create;
with Reg do
try
RootKey:=HKEY_CURRENT_USER;
if not OpenKey(pszRegItem,True) then Exit;
ValueList:=TStringList.Create;
try
GetValueNames(ValueList);
if ValueList.Count=0 then Exit;
for i:=0 to ValueList.Count-1 do
if CompareStr(ReadString(ValueList),Application.ExeName)=0 then
begin
Result:=True;
Exit;
end;
finally
ValueList.Free;
end;
finally
Free;
end;
end;
function RegisterRun(bFlag:Boolean):Boolean;
var
Reg:TRegistry;
begin
Result:=False;
Reg:=TRegistry.Create;
with Reg do
try
RootKey:=HKEY_CURRENT_USER;
if not OpenKey(pszRegItem,True) then Exit;
try
if bFlag then
WriteString(pszRegValueName,Application.ExeName)
else
if ValueExists(pszRegValueName) then
DeleteValue(pszRegValueName);
Result:=True;
except
MessageBox(Application.Handle,'当前用户无权限添加启动项或被系统工具阻止！','信息',MB_OK+MB_ICONINFORMATION);
end;
CloseKey;
finally
Free;
end;
end;
procedure AppendLog(pszLog:string);
var
f:TextFile;
pszLogFileName:string;
begin
pszLogFileName:=ExtractFilePath(Application.ExeName)+'Log/mail.log';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'Log') then
MkDir(ExtractFilePath(Application.ExeName)+'Log');
if not FileExists(pszLogFileName) then
CreateFile(PAnsiChar(pszLogFileName),0,
0,nil,CREATE_NEW,0,0);
Assign(f,pszLogFileName);
Append(f);
WriteLn(f,pszLog);
Close(f);
end;
function ExtractMailAccount(MailAddress:string):string;
var
i:BYTE;
begin
i:=Pos('@',MailAddress);
Result:=Copy(MailAddress,1,i-1);
end;
function ConvertListToString(SrcList:TStrings;ConvertType:TConvertType):string;
var
i,j:BYTE;
pszTemp:string;
begin
Result:='';
if SrcList.Count=0 then Exit;
for i:=0 to SrcList.Count-1 do
begin
pszTemp:=SrcList;
Case ConvertType of
ctMailAddress:
begin
j:=Pos('@',pszTemp);
Result:=Result+Copy(pszTemp,1,j-1);
if i<SrcList.Count-1 then Result:=Result+',';
end;
ctPath:
begin
Result:=Result+pszTemp;
if i<SrcList.Count-1 then Result:=Result+',';
end;
end;
end;
end;
function FileIsHidden(Path:string):Boolean;
var
dwAttributesWORD;
begin
dwAttributes:=GetFileAttributes(PAnsiChar(Path));
Result:=(dwAttributes and FILE_ATTRIBUTE_HIDDEN)>0;
end;
function EqualTime(Time1,Time2:TDateTime):Boolean;
var
nHour1,nMin1,nSec1,nMSec1, nHour2,nMin2,nSec2,nMSec2:WORD;
begin
DecodeTime(Time1,nHour1,nMin1,nSec1,nMSec1);
DecodeTime(Time2,nHour2,nMin2,nSec2,nMSec2);
Result:=(nHour1=nHour2) and (nMin1=nMin2);
end;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
var
i:BYTE;
TimeList:TStrings;
begin
TimeList:=TStringList.Create;
TimeList.Clear;
for i:=0 to FrmMain.MailTimeList.Count-1 do
if (Integer(FrmMain.MailTimeList.Objects)=0) and EqualTime(Time,StrToTime(FrmMain.MailTimeList)) then
begin
TimeList.Add(FrmMain.MailTimeList);
FrmMain.MailTimeList.Objects:=TObject(1);
end;
if TimeList.Count=0 then Exit;
for i:=0 to TimeList.Count-1 do
FrmMain.SendMail(DM.DB.GetMailFiles(TimeList));
end;
procedure AppendTrackList(pszTrack:string;ID:Integer);
var
f:TextFile;
pszDir1,pszDir2:string;
begin
pszDir1:=ExtractFilePath(Application.ExeName)+'TrackHistory';
if not DirectoryExists(pszDir1) then
MkDir(pszDir1);
pszDir2:=pszDir1+'/'+IntToStr(ID);
if not DirectoryExists(pszDir2) then
MkDir(pszDir2);
if not FileExists(pszDir2+FormatDateTime('"/"ddddd".txt"',Now)) then
CreateFile(PAnsiChar(pszDir2+FormatDateTime('"/"ddddd".txt"',Now)),0,
0,nil,CREATE_NEW,0,0);
AssignFile(f,pszDir2+FormatDateTime('"/"ddddd".txt"',Now));
Append(f);
WriteLn(f,pszTrack);
Close(f);
end;
procedure TFrmMain.FormCreate(Sender: TObject);
var
Ini:TIniFile;
dwExStyleWORD;
begin
EventMask:=SHCNE_MKDIR or SHCNE_RENAMEFOLDER or SHCNE_RMDIR or SHCNE_CREATE or SHCNE_RENAMEITEM or SHCNE_DELETE;
IconMsgID:=WM_NO_NOTIFYICON;
DM.DB.GetWatchList(WatchList);
PrevOperationInfo.EventID:=SHCNE_STARTUP;
NotifyMsgID:=WM_USER+110;
SHRegister;
fMailCtrl:=TidSMTP.Create(nil);
MailTimeList:=TStringList.Create;
DM.DB.GetMailTime(MailTimeList);
idTimer:=SetTimer(0,1,40000,@TimerProc);
if idTimer=0 then Exit;
ToolButton8.Enabled:=False;
SetState(False);
ItemState:=isBrowse;
Ini:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'Config/System.ini');
try
pszMailServer:=Ini.ReadString('General','MailServer','192.168.1.240');
SetWindowText(ipMailServer.Handle,PAnsiChar(pszMailServer));
cbAutoRun.Checked:=AppIsInRunQuque;
if Ini.ReadBool('General','HideOnRun',True) then
begin
cbHideOnRun.Checked:=True;
IconMsgID:=RegisterWindowMessage('tray icon message');
CreateTray;
dwExStyle:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,dwExStyle+WS_EX_TOOLWINDOW);
end;
finally
Ini.Free;
end;
if WatchList.Count>0 then
begin
WatchList.ItemIndex:=0;
WatchListClick(nil);
end;
bFirstShow:=True;
end;
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SHUnRegister;
if Assigned(fMailCtrl) then
fMailCtrl.Free;
if Assigned(MailTimeList) then
MailTimeList.Free; if idTimer>0 then
KillTimer(0,idTimer);
SetLength(WatchItemList,0);
if IconMsgID<>WM_NO_NOTIFYICON then
Shell_NotifyIcon(NIM_DELETE,@TrayStruct);
end;
procedure TFrmMain.WndProc(var message: TMessage);
var
lpShellInfoShellInfo;
pszPrev,pszCurAnsiChar;
Pos:TPoint;
begin
inherited;
if message.Msg=IconMsgID then
begin
case message.LParam of
WM_RBUTTONDOWN:
begin
GetCursorPos(Pos);
if WatchState=wsOpen then miSwitch.Caption:='暂停监控[&P]'
else if WatchState=wsPause then miSwitch.Caption:='开启监控[&O]';
IconMenu.Popup(Pos.X,Pos.Y);
end;
WM_LBUTTONDBLCLK: ShowWindow(Handle,SW_SHOWNORMAL);
end;
Exit;
end;
if message.Msg<>NotifyMsgID then Exit;//Msg<>NotifyMsgID
lpShellInfo:=PShellInfo(message.WParam);
if lpShellInfo=nil then Exit;//lpShellInfo=nil
GetMem(pszPrev,MAX_PATH);
SHGetPathFromIDList(lpShellInfo^.pidlArr[0],pszPrev);
case message.LParam of
SHCNE_MKDIR,SHCNE_RMDIR,SHCNE_CREATE,SHCNE_DELETE:
OneParamEventHandler(message.LParam,StrPas(pszPrev));//消息中只包含单个有效路径信息
SHCNE_RENAMEFOLDER,SHCNE_RENAMEITEM: //消息中包含两个有效路径
begin
GetMem(pszCur,MAX_PATH);
SHGetPathFromIDList(lpShellInfo^.pidlArr[1],pszCur);
TwoParamEventHandler(message.LParam,StrPas(pszPrev),StrPas(pszCur));
end;
end;
end;
procedure TFrmMain.OneParamEventHandler(EventID: Cardinal; Path: string);
var
pszTrack:string;
i:Integer;
begin
if (PrevOperationInfo.EventID=EventID) and SameText(UpperCase(PrevOperationInfo.PrevPath),UpperCase(Path))
and (PrevOperationInfo.CurPath='') and (EventID<>SHCNE_UPDATEITEM) then
Exit
else
begin
PrevOperationInfo.EventID:=EventID;
PrevOperationInfo.PrevPath:=Path;
PrevOperationInfo.CurPath:='';
end;
case EventID of
SHCNE_CREATE:
pszTrack:=FormatDateTime('c": "',Now)+Format('创建文件[%s]于路径[%s]',[ExtractFileName(Path),ExtractFilePath(Path)]);
SHCNE_UPDATEITEM:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]内容被修改',[Path]);
SHCNE_DELETE:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]被删除',[Path]);
SHCNE_MKDIR:
pszTrack:=FormatDateTime('c": "',Now)+Format('创建文件夹[%s]',[Path]);
SHCNE_RMDIR:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件夹[%s]被删除',[Path]);
end;
for i:=0 to NotifyCount-1 do
if Pos(UpperCase(WatchItemList.Folder),UpperCase(Path))>0 then
begin
if (EventID=SHCNE_DELETE) or (EventID=SHCNE_RMDIR) then
else
if (WatchItemList.IgnoreHidden and FileIsHidden(Path)) or (WatchItemList.IgnoreDirs.IndexOf(Path)<>-1) then Exit;
AppendTrackList(pszTrack,WatchItemList.ID);
end;
end;
procedure TFrmMain.TwoParamEventHandler(EventID: Cardinal; pszPrevPath,
pszCurPath: string);
var
pszTrack:string;
i:Integer;
begin
if (PrevOperationInfo.EventID=EventID) and SameText(UpperCase(PrevOperationInfo.PrevPath),UpperCase(pszPrevPath))
and SameText(UpperCase(PrevOperationInfo.CurPath),UpperCase(pszCurPath)) then
Exit
else
begin
PrevOperationInfo.EventID:=EventID;
PrevOperationInfo.PrevPath:=pszPrevPath;
PrevOperationInfo.CurPath:=pszcurPath;
end;
case EventID of
SHCNE_RENAMEFOLDER:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件夹[%s]被重命名为：[%s]',[pszPrevPath,pszCurPath]);
SHCNE_RENAMEITEM:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]被重命名为：[%s]',[pszPrevPath,ExtractFileName(pszCurPath)]);
end;
for i:=0 to NotifyCount-1 do
if Pos(UpperCase(WatchItemList.Folder),UpperCase(pszPrevPath))>0 then
begin
if (WatchItemList.IgnoreHidden and FileIsHidden(pszCurPath)) or (WatchItemList.IgnoreDirs.IndexOf(pszPrevPath)<>-1) then Exit;
AppendTrackList(pszTrack,WatchItemList.ID);
end;
end;
procedure TFrmMain.SendMail(FileList:TStrings);
var
i,j:Integer;
MailList:TStrings;
MailMsg:TidMessage;
begin
MailList:=TStringList.Create;
MailMsg:=TidMessage.Create(fMailCtrl);
if FileList.Count=0 then Exit;
for i:=0 to FileList.Count do
begin
DM.DB.GetMailToList(Integer(FileList.Objects),MailList);
if MailList.Count=0 then Continue;
with fMailCtrl do
begin
Host:=pszMailServer;
UserName:='Watcher';
Password:='123456';
AuthenticationType:=atNone;
with MailMsg do
begin
From.Text:='Watcher@kaper.com';
From.Name:='目录监控';
Subject:='目录变动通知';
Body.LoadFromFile(FileList);
end;
end;
for j:=0 to MailList.Count-1 do
begin
MailMsg.Recipients.EMailAddresses:=MailList[j];
try
fMailCtrl.Connect(2000);
except
AppendLog(FormatDateTime('dddddd hh:mm "连接邮件服务器失败！"',Now));
Exit;
end;
try
fMailCtrl.Send(MailMsg);
AppendLog(FormatDateTime('dddddd hh:mm',now)+' 发送邮件到：'+MailList[j]);
finally
fMailCtrl.Disconnect;
end;
end;
if FileExists(ChangeFileExt(FileList,'snd1')) then
RenameFile(FileList, ChangeFileExt(FileList,'snd2'))
else
RenameFile(FileList, ChangeFileExt(FileList,'snd1'))
end;
end;
procedure TFrmMain.WatchListClick(Sender: TObject);
begin
with WatchItemList[WatchList.ItemIndex] do
begin
LblEdtDir.Text:=Folder;
LblEdtMailFrom.Text:=MailFrom;
LblEdtMailAdmin.Text:=MailAdmin;
lbMailTo.Clear;
if MailToList.Count>0 then
lbMailTo.Items.Assign(MailToList);
LblEdtFirstTime.Text:=FormatDateTime('hh:mm',FirstSendTime);
LblEdtSecondTime.Text:=FormatDateTime('hh:mm',SecondSendTime);
if IgnoreDirs.Count>0 then
lbFilter.Items.Assign(IgnoreDirs);
cbIgnoreHidden.Checked:=IgnoreHidden;
cbWatchSubTree.Checked:=WatchSubTree;
end;
end;
procedure TFrmMain.ToolButton4Click(Sender: TObject);
var
pidlBaseItemIDList;
begin
SHGetSpecialFolderLocation(Handle,CSIDL_DRIVES,pidlBase);
FolderDlg.BaseFolder.IdList:=pidlBase;
if FolderDlg.Execute then
if WatchList.Items.IndexOf(FolderDlg.SelectedPathName)=-1 then
begin
WatchList.ItemIndex:=-1;
PrepareForNewItem;
SetState(True);
LblEdtDir.Text:=FolderDlg.SelectedPathName;;
ItemState:=isNew;
end;
end;
procedure TFrmMain.ToolButton7Click(Sender: TObject);
begin
if not DirectoryExists(LblEdtDir.Text) then Exit;
FolderDlg.BaseFolder.PathName:=LblEdtDir.Text;
if FolderDlg.Execute then
if lbFilter.Items.IndexOf(FolderDlg.SelectedPathName)=-1 then
lbFilter.Items.Add(FolderDlg.SelectedPathName);
end;
procedure TFrmMain.ToolButton3Click(Sender: TObject);
begin
lbFilter.Clear;
end;
procedure TFrmMain.ToolButton2Click(Sender: TObject);
begin
if (lbFilter.Count=0) or (lbFilter.ItemIndex<0) then Exit;
lbFilter.Items.Delete(lbFilter.ItemIndex);
end;
procedure TFrmMain.ToolButton1Click(Sender: TObject);
begin
if not DirectoryExists(LblEdtDir.Text) then Exit;
OpenDlg.InitialDir:=LblEdtDir.Text;
if OpenDlg.Execute then
if (Pos(UpperCase(LblEdtDir.Text),UpperCase(ExtractFilePath(OpenDlg.FileName)))>0) and
(lbFilter.Items.IndexOf(OpenDlg.FileName)=-1) then
lbFilter.Items.Add(OpenDlg.FileName);
end;
procedure TFrmMain.PrepareForNewItem;
begin
LblEdtDir.Text:='';
LblEdtMailFrom.Text:='';
LblEdtMailAdmin.Text:='';
LblEdtFirstTime.Text:='';
LblEdtSecondTime.Text:='';
lbMailTo.Clear;
lbFilter.Clear;
EdtMailAddr.Text:='';
ToolButton8.Enabled:=False;
end;
procedure TFrmMain.EdtMailAddrChange(Sender: TObject);
var
pszTemp:string;
begin
pszTemp:=Trim(EdtMailAddr.Text);
ToolButton8.Enabled:=(Length(pszTemp)>0) and (Pos(' ',pszTemp)<1);
end;
procedure TFrmMain.ToolButton8Click(Sender: TObject);
begin
if lbMailTo.Items.IndexOf(EdtMailAddr.Text+'@kaper.com')=-1 then
lbMailTo.Items.Add(EdtMailAddr.Text+'@kaper.com');
EdtMailAddr.SetFocus;
EdtMailAddr.Text:='';
end;
procedure TFrmMain.ToolButton10Click(Sender: TObject);
begin
lbMailTo.DeleteSelected;
end;
procedure TFrmMain.ToolButton11Click(Sender: TObject);
begin
lbMailTo.Clear;
end;
procedure TFrmMain.SetState(bFlag: Boolean);
var
i:Integer;
begin
for i:=1 to 3 do
TToolButton(FindComponent('ToolButton'+IntToStr(i))).Enabled:=bFlag;
for i:=7 to 11 do
TToolButton(FindComponent('ToolButton'+IntToStr(i))).Enabled:=bFlag;
cbIgnoreHidden.Enabled:=bFlag;
cbWatchSubTree.Enabled:=bFlag;
btnOk.Enabled:=bFlag;
btnCancel.Enabled:=bFlag;
EdtMailAddr.Enabled:=bFlag;
LblEdtDir.ReadOnly:=not bFlag;
LblEdtMailFrom.ReadOnly:=not bFlag;
LblEdtMailAdmin.ReadOnly:=not bFlag;
LblEdtFirstTime.ReadOnly:=not bFlag;
LblEdtSecondTime.ReadOnly:=not bFlag;
ToolButton8.Enabled:=False;
end;
procedure TFrmMain.ToolButton12Click(Sender: TObject);
begin
SetState(True);
ItemState:=isEdit;
end;
procedure TFrmMain.btnOKClick(Sender: TObject);
var
NewID:Byte;
begin
case ItemState of
isEdit:
with WatchItemList[WatchList.ItemIndex] do
begin
try
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
except
MessageBox(Handle,'时间格式错误！','提示',MB_OK+MB_ICONEXCLAMATION);
Exit;
end;
WatchList.Items[WatchList.ItemIndex]:=LblEdtDir.Text;
Folder:=LblEdtDir.Text;
MailFrom:=LblEdtMailFrom.Text;
MailToList.Assign(lbMailTo.Items);
MailAdmin:=LblEdtMailAdmin.Text;
IgnoreDirs.Assign(lbFilter.Items);
IgnoreHidden:=cbIgnoreHidden.Checked;
WatchSubTree:=cbWatchSubTree.Checked;
DM.DB.RemoveWatchItem(Integer(WatchList.Items.Objects[WatchList.ItemIndex]));
DM.DB.NewWatchItem(Integer(WatchList.Items.Objects[WatchList.ItemIndex]),Folder,ExtractMailAccount(MailAdmin),ConvertListToString(MailToList,ctMailAddress),ExtractMailAccount(MailFrom),ConvertListToString(IgnoreDirs,ctPath),FirstSendTime,SecondSendTime,WatchSubTree,IgnoreHidden);
SetState(False);
end;
isNew:
begin
NewID:=DM.DB.GetMaxID+1;
SetLength(WatchItemList,Length(WatchItemList)+1);
with WatchItemList[Length(WatchItemList)-1] do
begin
try
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
except
MessageBox(Handle,'时间格式错误！','提示',MB_OK+MB_ICONEXCLAMATION);
SetLength(WatchItemList,Length(WatchItemList)-1);
Exit;
end;
ID:=NewID;
Folder:=LblEdtDir.Text;
MailFrom:=LblEdtMailFrom.Text;
MailToList:=TStringList.Create;
MailToList.Assign(lbMailto.Items);
MailAdmin:=LblEdtMailAdmin.Text;
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
IgnoreDirs:=TStringList.Create;
IgnoreDirs.Assign(lbFilter.Items);
IgnoreHidden:=cbIgnoreHidden.Checked;
WatchSubTree:=cbWatchSubTree.Checked;
DM.DB.NewWatchItem(ID,Folder,ExtractMailAccount(MailAdmin),ConvertListToString(MailToList,ctMailAddress),ExtractMailAccount(MailFrom),ConvertListToString(IgnoreDirs,ctPath),FirstSendTime,SecondSendTime,WatchSubTree,IgnoreHidden);
WatchList.AddItem(LblEdtDir.Text,TObject(NewID));
SetState(False);
end;
end;
end;
ItemState:=isBrowse;
SHRegister;
DM.DB.GetMailTime(MailTimeList);
end;
procedure TFrmMain.btnBrowseClick(Sender: TObject);
begin
if ItemState=isBrowse then Exit;
ToolButton4Click(nil);
end;
procedure TFrmMain.EdtMailAddrKeyPress(Sender: TObject; var Key: Char);
begin
if (Ord(Key)=13) and ToolButton8.Enabled then
ToolButton8Click(nil);
end;
procedure TFrmMain.btnCancelClick(Sender: TObject);
begin
SetState(False);
WatchListClick(nil);
end;
procedure TFrmMain.btnChangeClick(Sender: TObject);
var
Ini:TIniFile;
begin
Ini:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'Config/System.ini');
try
Ini.WriteString('General','MailServer',ipMailServer.Text);
Ini.WriteBool('General','HideOnRun',cbHideOnRun.Checked);
RegisterRun(cbAutoRun.Checked);
cbAutoRun.Checked:=AppIsInRunQuque;
finally
Ini.Free;
end;
end;
procedure TFrmMain.SHRegister;
var
i:BYTE;
begin
SHUnRegister;
NotifyCount:=Length(WatchItemList);
if NotifyCount=0 then Exit;
SetLength(lpStruct, NotifyCount);
SetLength(ThrdList,NotifyCount);
for i:=0 to NotifyCount-1 do
with lpStruct,WatchItemList do
begin
SHILCreateFromPath(PWideChar(WideString(Folder)),@pidlPath,nil);
bWatchSubTree:=WatchSubTree;
ThrdList:=TWatchThread.Create(False,PAnsiChar(Folder),ID,IgnoreHidden,IgnoreDirs);
end;
hShell:=SHChangeNotifyRegister(Handle, SHCNF_ACCEPT_INTERRUPTS+SHCNF_ACCEPT_NON_INTERRUPTS, EventMask,NotifyMsgID, NotifyCount,@lpStruct[0]);
WatchState:=wsOpen;
if hShell=0 then
begin
MessageBox(Handle,'注册监控系统服务失败！!','错误',MB_OK+MB_ICONERROR);
Application.Terminate;
WatchState:=wsPause;
end;
end;
procedure TFrmMain.SHUnRegister;
var
i:BYTE;
begin
if hShell>0 then
SHChangeNotifyDeregister(hShell);//hShell>0
hShell:=0;
if NotifyCount>0 then
for i := 0 to NotifyCount-1 do
begin
CoTaskMemFree(lpStruct.PidlPath);
ThrdList.Terminate;
end;
NotifyCount := 0;
SetLength(ThrdList,0);
WatchState:=wsPause;
end;
procedure TFrmMain.ToolButton5Click(Sender: TObject);
var
nIdx,ID:Integer;
begin
if MessageDlg('是否删除选定监控项？',mtConfirmation,[mbYes,mbNo],0)=idNo then Exit;
nIdx:=WatchList.ItemIndex;
if nIdx=-1 then Exit;
ID:=Integer(WatchList.Items.Objects[nIdx]);
DM.DB.RemoveWatchItem(ID);
WatchList.DeleteSelected;
RemoveWatchItem(nIdx);
SHRegister;
end;
procedure TFrmMain.RemoveWatchItem(nIdx: BYTE);
var
i:BYTE;
begin
if nIdx=NotifyCount-1 then
SetLength(WatchItemList,NotifyCount-1)
else
begin
for i:=nIdx to NotifyCount-2 do
WatchItemList:=WatchItemList[i+1];
SetLength(WatchItemList,NotifyCount-1);
end;
end;
procedure TFrmMain.ToolButton6Click(Sender: TObject);
begin
if MessageDlg('是否删除全部监控项？',mtConfirmation,[mbYes,mbNo],0)=idNo then Exit;
WatchList.Clear;
DM.DB.ClearWatchItem;
SHUnRegister;
end;
procedure TFrmMain.CreateTray;
begin
with TrayStruct do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle;
uID:=0;
hIcon:=Application.Icon.Handle;
uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
uCallBackMessage:=IconMsgID;
szTip:=pszIconTip;
end;
Shell_NotifyIcon(NIM_ADD,@TrayStruct);
end;
procedure TFrmMain.miCloseClick(Sender: TObject);
var
CloseAction:TCloseAction;
begin
FormClose(nil,CloseAction);
Application.Terminate;
end;
procedure TFrmMain.miSwitchClick(Sender: TObject);
begin
case WatchState of
wsOpen:
SHUnRegister;
wsPause:
SHRegister;
end;
end;
procedure TFrmMain.miShowClick(Sender: TObject);
begin
ShowWindow(Handle,SW_SHOWNORMAL);
BringToFront;
end;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if IconMsgID<>WM_NO_NOTIFYICON then
begin
CanClose:=False;
ShowWindow(Handle,SW_HIDE);
end;
end;
procedure TFrmMain.WMSysCommand(var message: TWMSysCommand);
begin
if (message.CmdType=SC_MINIMIZE) and (IconMsgID<>WM_NO_NOTIFYICON) then
ShowWindow(Handle,SW_HIDE)
else
DefaultHandler(message);
end;
procedure TFrmMain.FormShow(Sender: TObject);
begin
if bFirstShow and cbHideOnRun.Checked then
begin
bFirstShow:=False;
Timer1.Enabled:=True;
end;
end;
procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=False;
ShowWindow(Handle,SW_HIDE);
end;
end.
[三]
unit DM;
interface
uses
SysUtils,Classes, DB, ADODB,Forms,CheckLst,Dialogs,Windows;
type
TConvertType=(ctMailAddress,ctPath);
type
TDB = class(TDataModule)
aqCenter: TADOQuery;
acCenter: TADOConnection;
procedure GetMailTime(var TimeList:TStrings);
procedure GetWatchList(var CheckList:TCheckListBox);
function GetMailFiles(pszSendTime:string):TStrings;
procedure GetMailToList(ID:Integer;var MailList:TStrings);
procedure NewWatchItem(ID:BYTE;Dir,MailAdmin,MailToList,MailFrom,IgnoreDirList:string;
FirstTime,SecondTime:TDateTime;WatchSubTree,IgnoreHidden:Boolean);
procedure RemoveWatchItem(ID:BYTE);
procedure ClearWatchItem;
function GetMaxID:Byte;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DB: TDB;
implementation
uses Main;
{$R *.dfm}
{ TDB }
function Yestoday(Today:TDateTime):TDateTime;
var
Year,Month,Day:WORD;
begin
DecodeDate(Today,Year,Month,Day);
if Day>1 then Dec(Day)
else
case Month of
1:
Begin
Dec(Year);
Month:=12;
Day:=31;
end;
3:
if IsLeapYear(Year) then
begin
Month:=2;
Day:=29;
end
else
begin
Month:=2;
Day:=28;
end;
5,7,8,10,12:
begin
Dec(Month);
Day:=30;
end;
2,4,6,9,11:
begin
Dec(Month);
Day:=31;
end;
end;
Result:=EncodeDate(Year,Month,Day);
end;
function ConvertStrToStringList(pszSource:string;ConvertType:TConvertType):TStrings;
var
pszTemp:string;
i:WORD;
begin
pszTemp:=pszSource;
Result:=TStringList.Create;
Result.Clear;
if Length(Trim(pszSource))=0 then Exit;
repeat
i:=Pos(',',pszTemp);
if i=0 then
begin
case ConvertType of
ctMailAddress: Result.Add(pszTemp+'@kaper.com');
ctPath: Result.Add(pszTemp);
end;
Break;
end;
case ConvertType of
ctMailAddress: Result.Add(Copy(pszTemp,1,i-1)+'@kaper.com');
ctPath: Result.Add(Copy(pszTemp,1,i-1));
end;
pszTemp:=Copy(pszTemp,i+1,Length(pszTemp)-i);
until
i=0;
end;
procedure TDB.GetWatchList(var CheckList:TCheckListBox);
var
WatchItem:TWatchItem;
i:Integer;
begin
with aqCenter do
begin
SQL.Clear;
SQL.Add('Select ID,directory ,mailadmin,mailfrom ,maillist,firsttime,secondtime,ignorehidden,ignoredirs,watchsubtree From WatchList Order By ID ASC');
try
Open;
First;
DisableControls;
i:=0;
repeat
if DirectoryExists(Fields[1].AsString) then
begin
with WatchItem do
begin
ID:=Fields[0].AsInteger;
Folder:=Fields[1].AsString;
MailAdmin:=Fields[2].AsString+'@kaper.com';
MailFrom:=Fields[3].AsString+'@kaper.com';
MailToList:=ConvertStrToStringList(Fields[4].AsString,ctMailAddress);
FirstSendTime:=Fields[5].AsDateTime;
SecondSendTime:=Fields[6].AsDateTime;
IgnoreHidden:=Fields[7].AsBoolean;
WatchSubTree:=Fields[9].AsBoolean;
IgnoreDirs:=ConvertStrToStringList(Fields[8].AsString,ctPath);
end;
SetLength(FrmMain.WatchItemList,i+1);
FrmMain.WatchItemList:=WatchItem;
CheckList.AddItem(Fields[1].AsString,TObject(Fields[0].AsInteger));
Inc(i);
end;
Next;
until
Eof;
EnableControls;
except
Application.Terminate;
end;
end;
end;
function TDB.GetMailFiles(pszSendTime: string): TStrings;
var
pszFileName:string;
lpFileInfo:TWin32FindData;
FindHandle:THandle;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Distinct(ID) From WatchList Where firsttime=:ft or secondtime=:st');
with Parameters do
begin
ParamValues['ft']:=StrToTime(pszSendTime);
ParamValues['st']:=StrToTime(pszSendTime);
end;
Open;
First;
DisableControls;
Result:=TStringList.Create;
Result.Clear;
repeat
pszFileName:=ExtractFilePath(Application.ExeName)+'TrackHistory/'+Fields[0].AsString+'/'+'*.txt';
FindHandle:=FindFirstFile(PAnsiChar(pszFileName),lpFileInfo);
if FindHandle<>INVALID_HANDLE_VALUE then
begin
repeat
Result.AddObject(StrPas(@lpFileInfo.cFileName[0]),TObject(Fields[0].AsInteger));
until
not FindNextFile(FindHandle,lpFileInfo);
FindClose(FindHandle);
end;
{pszFileName:=ExtractFilePath(Application.ExeName)+'TrackHistory/'+Fields[0].AsString+'/'+FormatDateTime('ddddd".txt"',Date);
if FileExists(pszFileName) then
Result.AddObject(pszFileName,TObject(Fields[0].AsInteger));}
Next;
until
Eof;
end;
end;
procedure TDB.GetMailTime(var TimeList: TStrings);
begin
TimeList.Clear;
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Distinct(firsttime) From WatchList');
Open;
First;
DisableControls;
repeat
TimeList.Add(FormatDateTime('hh:mm:ss',Fields[0].AsDateTime));
Next;
until
Eof;
EnableControls;
Close;
SQL.Clear;
SQL.Add('Select Distinct(secondtime) From WatchList');
Open;
First;
DisableControls;
repeat
TimeList.AddObject(FormatDateTime('hh:mm:ss',Fields[0].AsDateTime),TObject(0));
Next;
until
Eof;
EnableControls;
end;
end;
procedure TDB.GetMailToList(ID: Integer;var MailList:TStrings);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select maillist From WatchList Where ID='+IntToStr(ID));
Open;
MailList:=ConvertStrToStringList(Fields[0].AsString,ctMailAddress);
end;
end;
function TDB.GetMaxID: Byte;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Max(ID) From WatchList');
Open;
Result:=Fields[0].AsInteger;
end;
end;
procedure TDB.NewWatchItem(ID: BYTE; Dir, MailAdmin, MailToList, MailFrom,
IgnoreDirList: string; FirstTime, SecondTime: TDateTime; WatchSubTree,
IgnoreHidden: Boolean);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Insert Into WatchList(id,directory,mailfrom,maillist,mailadmin,ignoredirs,firsttime,secondtime,ignorehidden,watchsubtree) ');
SQL.Add('ValuesID,ir,:MF,:MT,:MA,:IDir,:FT,:ST,:IH,:WST)');
with Parameters do
begin
ParamValues['ID']:=ID;
ParamValues['Dir']:=Dir;
ParamValues['MF']:=MailFrom;
ParamValues['MT']:=MailToList;
ParamValues['MA']:=MailAdmin;
ParamValues['IDir']:=IgnoreDirList;
ParamValues['FT']:=FirstTime;
ParamValues['ST']:=SecondTime;
ParamValues['IH']:=IgnoreHidden;
ParamValues['WST']:=WatchSubTree;
end;
ExecSQL;
end;
end;
procedure TDB.RemoveWatchItem(ID: BYTE);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Delete From WatchList Where ID='+IntToStr(ID));
ExecSQL;
end;
end;
procedure TDB.ClearWatchItem;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Delete From WatchList');
ExecSQL;
end;
end;
end.
[四]
unit Mail;
interface
uses
Classes,Windows,SysUtils,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP,IdMessage,Forms;
type TTimerProc=procedure(Hwnd:THandle;Msg,idEvent:UINT;dwTimeWORD);
type TMailThrd=class(TThread)
private
fMailCtrl:TidSMTP;
idTimer:UINT;
lpFNProc:TTimerProc;
procedure SendMail(FileList:TStrings);
public
MailTimeList:TStrings;
constructor Create(CreateSuspended:Boolean);
procedure Execute;override;
destructor Destroy;override;
end;
procedure TimerProc(Hwnd:THandle;uMsg,idEvent:UINT;dwTimeWORD);
var
MailThrd:TMailThrd;
implementation
{ MailThrd }
uses
DM,Main;
procedure TMailThrd.SendMail(FileList:TStrings);
var
i,j:Integer;
MailList:TStrings;
MailMsg:TidMessage;
begin
MailList:=TStringList.Create;
MailMsg:=TidMessage.Create(fMailCtrl);
for i:=0 to FileList.Count do
begin
DB.GetMailToList(Integer(FileList.Objects),MailList);
with fMailCtrl do
begin
Host:='192.168.1.240';
UserName:='Watcher';
Password:='123456';
AuthenticationType:=atNone;
with MailMsg do
begin
From.Text:='Watcher@kaper.com';
From.Name:='文件和目录监控';
Subject:='文件和目录操作通知';
Body.LoadFromFile(FileList);
end;
end;
for j:=0 to MailList.Count-1 do
begin
MailMsg.Recipients.EMailAddresses:=MailList[j]+'@kaper.com';
try
fMailCtrl.Connect(2000);
except
MessageBox(Handle,'连接邮件服务器失败！','错误',MB_OK+MB_ICONERROR);
Exit;
end;
try
fMailCtrl.Send(MailMsg);
finally
fMailCtrl.Disconnect;
end;
end;
end;
end;
function EqualTime(Time1,Time2:TDateTime):Boolean;
var
nHour1,nMin1,nSec1,nMSec1, nHour2,nMin2,nSec2,nMSec2:WORD;
begin
DecodeTime(Time1,nHour1,nMin1,nSec1,nMSec1);
DecodeTime(Time2,nHour2,nMin2,nSec2,nMSec2);
Result:=(nHour1=nHour2) and (nMin1=nMin2);
end;
constructor TMailThrd.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
fMailCtrl:=TidSMTP.Create(nil);
lpFNProc:=TimerProc;
MailTimeList:=TStringList.Create;
DB.GetMailTime(MailTimeList);
FreeOnTerminate:=True;
end;
destructor TMailThrd.Destroy;
begin
if Assigned(fMailCtrl) then
fMailCtrl.Free;
inherited;
if Assigned(MailTimeList) then
MailTimeList.Free;
if idTimer>0 then
KillTimer(0,idTimer);
end;
procedure TMailThrd.Execute;
begin
inherited;
idTimer:=SetTimer(0,1,30000,@lpFNProc);
if idTimer=0 then Exit;
end;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
var
i:BYTE;
begin
for i:=0 to MailThrd.MailTimeList.Count-1 do
if EqualTime(Time,StrToTime(MailThrd.MailTimeList)) then
begin
MailThrd.SendMail(DM.DB.GetMailFiles(MailThrd.MailTimeList));
Break;
end;
end;
end.
问题一：一次变化得到两次通知，不知道什么原因；
问题二：*.xls文件一打开就得到该文件被修改的通知，关闭时也是。
请求高手解答！
[一]
unit WatchThread; //监控线程定义单元
interface
uses
Classes,SysUtils,StdCtrls,Windows,Dialogs,Main;
type
TWatchThread = class(TThread)
private
FIndex:BYTE; //程序中有用户定义的多个监控目录，没个目录启用一个线程，这是索引号
FPath
AnsiChar; //监控的目录路径FHandle:THandle;
bKickHidden:Boolean; //是否忽略隐藏文件的变化
IgnoreFileList:TStrings; //忽略文件列表，当这些文件发生变化时，忽略之
lpBuffer
ointer; //存储文件变化信息结构的内存块指针pszTrack:string; //将要写入文件变化记录文本文件的字符串
pszDir:string; //目录名
protected
procedure BeginWatch();
procedure Execute; override;
procedure CheckFileInfo(lpFileInfo
FileNotifyInformation); //分析public
constructor Create(CreateSuspended:Boolean;WatchPath
AnsiChar;AIndex:BYTE;bIgnoreHidden:Boolean;IgnoreFiles:TStrings);destructor Destroy;override;
end;
implementation
procedure TWatchThread.CheckFileInfo(lpFileInfo
FileNotifyInformation);var
pszFileName,pszTemp:string;
begin
if lpFileinfo^.Action<>FILE_ACTION_MODIFIED then Exit; //不是文件内容修改事件
pszFileName:=pszDir+WideCharToString(@(lpFileInfo^.FileName[0]));
if Pos('DESKTOP.INI',UpperCase(pszFileName))>0 then Exit; //过滤名称为desktop.ini的无意义文件
if FileIsHidden(pszFileName) and bkickHidden then Exit;//过滤隐藏文件
if IgnoreFileList.IndexOf(pszFileName)>-1 then Exit; //过滤忽略文件列表中的文件
pszTemp:=FormatDateTime('c": "',Now)+Format('文件[%s]内容被修改',[pszFileName]);
if SameText(UpperCase(pszTrack),UpperCase(pszTemp)) then Exit; （*已经得到一次通知了（不知道为什么，监控的不是根目录时，一次变化会得到两次通知*）
pszTrack:=pszTemp;//保存通知字符串，以便跟下一次通知比较，看是否是同一次文件变化的重复通知
AppendTrackList(pszTrack,FIndex); //将变化写入对应的文件
end;
procedure TWatchThread.BeginWatch;
var
dwRetBytes: DWORD;//写入缓冲区的字节数
lpFileInfo
FileNotifyInformation;//指针dwOffset:Integer;//缓冲区中两个FileNotifyInformation间的字节位移
begin
GetMem(lpBuffer,nSize);//分配缓冲区空间，nSize为定义在Main.pas中的常量
ZeroMemory(lpBuffer,nSize);
FHandle := CreateFile(FPath,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE or FILE_SHARE_DELETE,
nil,
OPEN_EXISTING,
FILE_FLAG_BACKUP_SEMANTICS,
0);//打开监控目录，得到需要的句柄
dwRetBytes:=0;
while ReadDirectoryChanges(FHandle,lpBuffer,nSize,True,
FILE_NOTIFY_CHANGE_LAST_WRITE,
@dwRetBytes,nil,nil) and not Terminated do
begin
if dwRetBytes=0 then
begin
ZeroMemory(lpBuffer,nSize);
Continue;
end;//没有变化
lpFileInfo:=PFileNotifyInformation(lpBuffer);//获得第一个结构的指针
while True do
begin
CheckFileInfo(lpFileInfo);//分析该结构
dwOffset:=lpFileInfo^.NextEntryOffset;//下一个结构的字节数位移
if dwOffset>0 then
lpFileInfo:=PFileNotifyInformation(PAnsiChar(lpFileInfo)+dwOffset)//存在下一个结构，即发生了多个变化
else
begin
ZeroMemory(lpBuffer,nSize);
dwRetBytes:=0;
Break;//没有其他变化了，循环继续
end;
end;
end;
end;
constructor TWatchThread.Create(CreateSuspended: Boolean;
WatchPath: PAnsiChar; AIndex:BYTE;bIgnoreHidden:Boolean;IgnoreFiles:TStrings);
begin
inherited Create(CreateSuspended);
FPath:=WatchPath;
FIndex:=AIndex;
FreeOnTerminate:=True;
bKickHidden:=bIgnoreHidden;
IgnoreFileList:=TStringList.Create;
if IgnoreFiles.Count>0 then
IgnoreFileList.Assign(IgnoreFiles);
pszDir:=StrPas(FPath);
if pszDir[Length(pszDir)]<>'/' then
pszDir:=pszDir+'/';//因为结构中的路径是相对路径，所以要加上监控路径构成全路径再写入文件
end;
destructor TWatchThread.Destroy;
begin
FreeMem(lpBuffer,nSize);
inherited;
end;
procedure TWatchThread.Execute;
begin
inherited;
BeginWatch;
end;
end.
[二]
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs,ShlObj,ActiveX, Menus, WinSkinData, StdCtrls, DB,DBGrids,
RzButton,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP,IdMessage, Buttons, ComCtrls, CheckLst, ExtCtrls,
ToolWin, ImgList, Grids, PBFolderDialog, SnCheckBox, SnEdit, SnButton,
RzEdit, RzShellDialogs, SnIPEdit, SnLabel,ShellAPI, TFlatListBoxUnit;
type TNOTIFYREGISTER = record
pidlPath : PItemIDList;
bWatchSubtree : Boolean;
end; //监控结构
type
PFileNotifyInformation=^TFileNotifyInformation;
TFileNotifyInformation=record
NextEntryOffset
WORD;Action
WORD;FileNameLength
WORD;FileName: Array [0..0] of WideChar;
end;
type
TWatchState=(wsOpen,wsPause,wsNoWatchItem);//枚举，表示监控状态
type
PWatchItem=^TWatchItem;
TWatchItem=record //监控项的详细信息
ID:Integer;//编号
Folder,MailFrom,MailAdmin:string;//目录路径，邮件发件人和邮件管理员帐户
MailToList,IgnoreDirs:TStrings;//收件人列表和忽略文件列表
IgnoreHidden,WatchSubTree:Boolean;//是否忽略隐藏文件，是否监控子目录的布尔标志
FirstSendTime,SecondSendTime:TDateTime;//发送邮件的时间，一天2次。
end;
type TShellInfo=Record
pidlArr:array [0..1] of PItemIDList;
end;//接收通知信息结构
TItemState=(isBrowse,isEdit,isNew);//状态标志
type PShellInfo=^TShellInfo;
PNOTIFYREGISTER = ^TNOTIFYREGISTER;
PPItemIDList = ^PItemIDList;
type
TPrevOperationInfo=record
EventID:Cardinal;
PrevPath,CurPath:string;
end;//保存前一次通知信息的结构，也是因为一次操作引起两次通知的BUG，不知道什么原因
type
TFrmMain = class(TForm)
SkinCtrl: TSkinData;
WatchList: TCheckListBox;
LblEdtDir: TLabeledEdit;
LblEdtMailFrom: TLabeledEdit;
LblEdtMailAdmin: TLabeledEdit;
StaticText1: TStaticText;
lbMailTo: TListBox;
LblEdtFirstTime: TLabeledEdit;
LblEdtSecondTime: TLabeledEdit;
lbFilter: TListBox;
StaticText2: TStaticText;
tbFilter: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
OpenDlg: TOpenDialog;
ToolBar2: TToolBar;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
ToolButton12: TToolButton;
cbIgnoreHidden: TSnCheckBox;
cbWatchSubTree: TSnCheckBox;
btnOK: TSnButton;
btnCancel: TSnButton;
EdtMailAddr: TSnEdit;
btnBrowse: TSnButton;
cbAutoRun: TSnCheckBox;
cbHideOnRun: TSnCheckBox;
FolderDlg: TRzSelectFolderDialog;
ipMailServer: TSnIPEdit;
SnLabel1: TSnLabel;
btnChange: TSnButton;
IconMenu: TPopupMenu;
miClose: TMenuItem;
miSwitch: TMenuItem;
miShow: TMenuItem;
Timer1: TTimer;
procedure SetState(bFlag:Boolean);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure WndProc(var message:TMessage);override;
procedure WatchListClick(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure EdtMailAddrChange(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton10Click(Sender: TObject);
procedure ToolButton11Click(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure btnBrowseClick(Sender: TObject);
procedure EdtMailAddrKeyPress(Sender: TObject; var Key: Char);
procedure btnCancelClick(Sender: TObject);
procedure btnChangeClick(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure miCloseClick(Sender: TObject);
procedure miSwitchClick(Sender: TObject);
procedure miShowClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
public
WatchItemList: array of TWatchItem;
private
bFirstShow: Boolean;
TrayStruct:TNotifyIconData;
pszMailServer:string;
IconMsgID:Cardinal;
fMailCtrl:TidSMTP;
ItemState:TItemState;
idTimer:UINT;
MailTimeList:TStrings;
NotifyMsgID:Cardinal;
lpStruct:array of TNOTIFYREGISTER;
NotifyCount: WORD;
hShell: THandle;
EventMask: Cardinal;
WatchState:TWatchState;
PrevOperationInfo: TPrevOperationInfo;
procedure OneParamEventHandler(EventID:Cardinal;Path:string);
procedure TwoParamEventHandler(EventID:Cardinal;pszPrevPath,pszCurPath:string);
procedure SendMail(FileList:TStrings);
procedure PrepareForNewItem;
procedure SHRegister();
procedure SHUnRegister();
procedure RemoveWatchItem(nIdx:BYTE);
procedure CreateTray;
procedure WMSysCommand(var message:TWMSysCommand);message WM_SYSCOMMAND;
end;
function FileIsHidden(Path:string):Boolean;
procedure AppendTrackList(pszTrack:string;ID:Integer);
procedure AppendLog(pszLog:string);
function SHChangeNotifyRegister(
fHandle : HWND;
dwFlags : Integer;
wEventMask : Cardinal; //通知WINDOWS想要得到通知的事件
uMsg : UINT; //通知消息ID
cItems : integer; //NOTIFYREGISTER数组的元素个数
lpItems : PNOTIFYREGISTER(*NOTIFYREGISTER数组指针*)) : HWND; stdcall;
function SHChangeNotifyDeregister(
hWnd : HWND) : boolean; stdcall;
function SHILCreateFromPath(Path: LPCWSTR;
PIDL: PPItemIDList;Attributes: PDWORD):
HResult; stdcall;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
const
nSize=10*(SizeOf(TFileNotifyInformation)+MAX_PATH);
var
FrmMain:TFrmMain;
implementation
uses
DM,IniFiles,Registry,WatchThread;
{$R *.dfm}
const
Shell32DLL = 'shell32.dll';
pszIconTip = '文件和目录监控';
SHCNF_ACCEPT_INTERRUPTS = $0001;
SHCNF_ACCEPT_NON_INTERRUPTS = $0002;
SHCNF_NO_PROXY = $8000;
WM_NO_NOTIFYICON =0;
SHCNE_STARTUP = $0000;
pszRegItem='Software/Microsoft/Windows/CurrentVersion/Run';
pszRegValueName='FSWatcher';
var
ThrdList:array of TWatchThread;
function SHChangeNotifyRegister;
external Shell32DLL index 2;
function SHChangeNotifyDeregister;
external Shell32DLL index 4;
function SHILCreateFromPath;
external Shell32DLL index 28;
function AppIsInRunQuque():Boolean;
var
Reg:TRegistry;
ValueList:TStrings;
i:BYTE;
begin
Result:=False;
Reg:=TRegistry.Create;
with Reg do
try
RootKey:=HKEY_CURRENT_USER;
if not OpenKey(pszRegItem,True) then Exit;
ValueList:=TStringList.Create;
try
GetValueNames(ValueList);
if ValueList.Count=0 then Exit;
for i:=0 to ValueList.Count-1 do
if CompareStr(ReadString(ValueList),Application.ExeName)=0 then
begin
Result:=True;
Exit;
end;
finally
ValueList.Free;
end;
finally
Free;
end;
end;
function RegisterRun(bFlag:Boolean):Boolean;
var
Reg:TRegistry;
begin
Result:=False;
Reg:=TRegistry.Create;
with Reg do
try
RootKey:=HKEY_CURRENT_USER;
if not OpenKey(pszRegItem,True) then Exit;
try
if bFlag then
WriteString(pszRegValueName,Application.ExeName)
else
if ValueExists(pszRegValueName) then
DeleteValue(pszRegValueName);
Result:=True;
except
MessageBox(Application.Handle,'当前用户无权限添加启动项或被系统工具阻止！','信息',MB_OK+MB_ICONINFORMATION);
end;
CloseKey;
finally
Free;
end;
end;
procedure AppendLog(pszLog:string);
var
f:TextFile;
pszLogFileName:string;
begin
pszLogFileName:=ExtractFilePath(Application.ExeName)+'Log/mail.log';
if not DirectoryExists(ExtractFilePath(Application.ExeName)+'Log') then
MkDir(ExtractFilePath(Application.ExeName)+'Log');
if not FileExists(pszLogFileName) then
CreateFile(PAnsiChar(pszLogFileName),0,
0,nil,CREATE_NEW,0,0);
Assign(f,pszLogFileName);
Append(f);
WriteLn(f,pszLog);
Close(f);
end;
function ExtractMailAccount(MailAddress:string):string;
var
i:BYTE;
begin
i:=Pos('@',MailAddress);
Result:=Copy(MailAddress,1,i-1);
end;
function ConvertListToString(SrcList:TStrings;ConvertType:TConvertType):string;
var
i,j:BYTE;
pszTemp:string;
begin
Result:='';
if SrcList.Count=0 then Exit;
for i:=0 to SrcList.Count-1 do
begin
pszTemp:=SrcList;
Case ConvertType of
ctMailAddress:
begin
j:=Pos('@',pszTemp);
Result:=Result+Copy(pszTemp,1,j-1);
if i<SrcList.Count-1 then Result:=Result+',';
end;
ctPath:
begin
Result:=Result+pszTemp;
if i<SrcList.Count-1 then Result:=Result+',';
end;
end;
end;
end;
function FileIsHidden(Path:string):Boolean;
var
dwAttributes
WORD;begin
dwAttributes:=GetFileAttributes(PAnsiChar(Path));
Result:=(dwAttributes and FILE_ATTRIBUTE_HIDDEN)>0;
end;
function EqualTime(Time1,Time2:TDateTime):Boolean;
var
nHour1,nMin1,nSec1,nMSec1, nHour2,nMin2,nSec2,nMSec2:WORD;
begin
DecodeTime(Time1,nHour1,nMin1,nSec1,nMSec1);
DecodeTime(Time2,nHour2,nMin2,nSec2,nMSec2);
Result:=(nHour1=nHour2) and (nMin1=nMin2);
end;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
var
i:BYTE;
TimeList:TStrings;
begin
TimeList:=TStringList.Create;
TimeList.Clear;
for i:=0 to FrmMain.MailTimeList.Count-1 do
if (Integer(FrmMain.MailTimeList.Objects)=0) and EqualTime(Time,StrToTime(FrmMain.MailTimeList)) then
begin
TimeList.Add(FrmMain.MailTimeList);
FrmMain.MailTimeList.Objects:=TObject(1);
end;
if TimeList.Count=0 then Exit;
for i:=0 to TimeList.Count-1 do
FrmMain.SendMail(DM.DB.GetMailFiles(TimeList));
end;
procedure AppendTrackList(pszTrack:string;ID:Integer);
var
f:TextFile;
pszDir1,pszDir2:string;
begin
pszDir1:=ExtractFilePath(Application.ExeName)+'TrackHistory';
if not DirectoryExists(pszDir1) then
MkDir(pszDir1);
pszDir2:=pszDir1+'/'+IntToStr(ID);
if not DirectoryExists(pszDir2) then
MkDir(pszDir2);
if not FileExists(pszDir2+FormatDateTime('"/"ddddd".txt"',Now)) then
CreateFile(PAnsiChar(pszDir2+FormatDateTime('"/"ddddd".txt"',Now)),0,
0,nil,CREATE_NEW,0,0);
AssignFile(f,pszDir2+FormatDateTime('"/"ddddd".txt"',Now));
Append(f);
WriteLn(f,pszTrack);
Close(f);
end;
procedure TFrmMain.FormCreate(Sender: TObject);
var
Ini:TIniFile;
dwExStyle
WORD;begin
EventMask:=SHCNE_MKDIR or SHCNE_RENAMEFOLDER or SHCNE_RMDIR or SHCNE_CREATE or SHCNE_RENAMEITEM or SHCNE_DELETE;
IconMsgID:=WM_NO_NOTIFYICON;
DM.DB.GetWatchList(WatchList);
PrevOperationInfo.EventID:=SHCNE_STARTUP;
NotifyMsgID:=WM_USER+110;
SHRegister;
fMailCtrl:=TidSMTP.Create(nil);
MailTimeList:=TStringList.Create;
DM.DB.GetMailTime(MailTimeList);
idTimer:=SetTimer(0,1,40000,@TimerProc);
if idTimer=0 then Exit;
ToolButton8.Enabled:=False;
SetState(False);
ItemState:=isBrowse;
Ini:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'Config/System.ini');
try
pszMailServer:=Ini.ReadString('General','MailServer','192.168.1.240');
SetWindowText(ipMailServer.Handle,PAnsiChar(pszMailServer));
cbAutoRun.Checked:=AppIsInRunQuque;
if Ini.ReadBool('General','HideOnRun',True) then
begin
cbHideOnRun.Checked:=True;
IconMsgID:=RegisterWindowMessage('tray icon message');
CreateTray;
dwExStyle:=GetWindowLong(Application.Handle,GWL_EXSTYLE);
SetWindowLong(Application.Handle,GWL_EXSTYLE,dwExStyle+WS_EX_TOOLWINDOW);
end;
finally
Ini.Free;
end;
if WatchList.Count>0 then
begin
WatchList.ItemIndex:=0;
WatchListClick(nil);
end;
bFirstShow:=True;
end;
procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SHUnRegister;
if Assigned(fMailCtrl) then
fMailCtrl.Free;
if Assigned(MailTimeList) then
MailTimeList.Free; if idTimer>0 then
KillTimer(0,idTimer);
SetLength(WatchItemList,0);
if IconMsgID<>WM_NO_NOTIFYICON then
Shell_NotifyIcon(NIM_DELETE,@TrayStruct);
end;
procedure TFrmMain.WndProc(var message: TMessage);
var
lpShellInfo
ShellInfo;pszPrev,pszCur
AnsiChar;Pos:TPoint;
begin
inherited;
if message.Msg=IconMsgID then
begin
case message.LParam of
WM_RBUTTONDOWN:
begin
GetCursorPos(Pos);
if WatchState=wsOpen then miSwitch.Caption:='暂停监控[&P]'
else if WatchState=wsPause then miSwitch.Caption:='开启监控[&O]';
IconMenu.Popup(Pos.X,Pos.Y);
end;
WM_LBUTTONDBLCLK: ShowWindow(Handle,SW_SHOWNORMAL);
end;
Exit;
end;
if message.Msg<>NotifyMsgID then Exit;//Msg<>NotifyMsgID
lpShellInfo:=PShellInfo(message.WParam);
if lpShellInfo=nil then Exit;//lpShellInfo=nil
GetMem(pszPrev,MAX_PATH);
SHGetPathFromIDList(lpShellInfo^.pidlArr[0],pszPrev);
case message.LParam of
SHCNE_MKDIR,SHCNE_RMDIR,SHCNE_CREATE,SHCNE_DELETE:
OneParamEventHandler(message.LParam,StrPas(pszPrev));//消息中只包含单个有效路径信息
SHCNE_RENAMEFOLDER,SHCNE_RENAMEITEM: //消息中包含两个有效路径
begin
GetMem(pszCur,MAX_PATH);
SHGetPathFromIDList(lpShellInfo^.pidlArr[1],pszCur);
TwoParamEventHandler(message.LParam,StrPas(pszPrev),StrPas(pszCur));
end;
end;
end;
procedure TFrmMain.OneParamEventHandler(EventID: Cardinal; Path: string);
var
pszTrack:string;
i:Integer;
begin
if (PrevOperationInfo.EventID=EventID) and SameText(UpperCase(PrevOperationInfo.PrevPath),UpperCase(Path))
and (PrevOperationInfo.CurPath='') and (EventID<>SHCNE_UPDATEITEM) then
Exit
else
begin
PrevOperationInfo.EventID:=EventID;
PrevOperationInfo.PrevPath:=Path;
PrevOperationInfo.CurPath:='';
end;
case EventID of
SHCNE_CREATE:
pszTrack:=FormatDateTime('c": "',Now)+Format('创建文件[%s]于路径[%s]',[ExtractFileName(Path),ExtractFilePath(Path)]);
SHCNE_UPDATEITEM:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]内容被修改',[Path]);
SHCNE_DELETE:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]被删除',[Path]);
SHCNE_MKDIR:
pszTrack:=FormatDateTime('c": "',Now)+Format('创建文件夹[%s]',[Path]);
SHCNE_RMDIR:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件夹[%s]被删除',[Path]);
end;
for i:=0 to NotifyCount-1 do
if Pos(UpperCase(WatchItemList.Folder),UpperCase(Path))>0 then
begin
if (EventID=SHCNE_DELETE) or (EventID=SHCNE_RMDIR) then
else
if (WatchItemList.IgnoreHidden and FileIsHidden(Path)) or (WatchItemList.IgnoreDirs.IndexOf(Path)<>-1) then Exit;
AppendTrackList(pszTrack,WatchItemList.ID);
end;
end;
procedure TFrmMain.TwoParamEventHandler(EventID: Cardinal; pszPrevPath,
pszCurPath: string);
var
pszTrack:string;
i:Integer;
begin
if (PrevOperationInfo.EventID=EventID) and SameText(UpperCase(PrevOperationInfo.PrevPath),UpperCase(pszPrevPath))
and SameText(UpperCase(PrevOperationInfo.CurPath),UpperCase(pszCurPath)) then
Exit
else
begin
PrevOperationInfo.EventID:=EventID;
PrevOperationInfo.PrevPath:=pszPrevPath;
PrevOperationInfo.CurPath:=pszcurPath;
end;
case EventID of
SHCNE_RENAMEFOLDER:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件夹[%s]被重命名为：[%s]',[pszPrevPath,pszCurPath]);
SHCNE_RENAMEITEM:
pszTrack:=FormatDateTime('c": "',Now)+Format('文件[%s]被重命名为：[%s]',[pszPrevPath,ExtractFileName(pszCurPath)]);
end;
for i:=0 to NotifyCount-1 do
if Pos(UpperCase(WatchItemList.Folder),UpperCase(pszPrevPath))>0 then
begin
if (WatchItemList.IgnoreHidden and FileIsHidden(pszCurPath)) or (WatchItemList.IgnoreDirs.IndexOf(pszPrevPath)<>-1) then Exit;
AppendTrackList(pszTrack,WatchItemList.ID);
end;
end;
procedure TFrmMain.SendMail(FileList:TStrings);
var
i,j:Integer;
MailList:TStrings;
MailMsg:TidMessage;
begin
MailList:=TStringList.Create;
MailMsg:=TidMessage.Create(fMailCtrl);
if FileList.Count=0 then Exit;
for i:=0 to FileList.Count do
begin
DM.DB.GetMailToList(Integer(FileList.Objects),MailList);
if MailList.Count=0 then Continue;
with fMailCtrl do
begin
Host:=pszMailServer;
UserName:='Watcher';
Password:='123456';
AuthenticationType:=atNone;
with MailMsg do
begin
From.Text:='Watcher@kaper.com';
From.Name:='目录监控';
Subject:='目录变动通知';
Body.LoadFromFile(FileList);
end;
end;
for j:=0 to MailList.Count-1 do
begin
MailMsg.Recipients.EMailAddresses:=MailList[j];
try
fMailCtrl.Connect(2000);
except
AppendLog(FormatDateTime('dddddd hh:mm "连接邮件服务器失败！"',Now));
Exit;
end;
try
fMailCtrl.Send(MailMsg);
AppendLog(FormatDateTime('dddddd hh:mm',now)+' 发送邮件到：'+MailList[j]);
finally
fMailCtrl.Disconnect;
end;
end;
if FileExists(ChangeFileExt(FileList,'snd1')) then
RenameFile(FileList, ChangeFileExt(FileList,'snd2'))
else
RenameFile(FileList, ChangeFileExt(FileList,'snd1'))
end;
end;
procedure TFrmMain.WatchListClick(Sender: TObject);
begin
with WatchItemList[WatchList.ItemIndex] do
begin
LblEdtDir.Text:=Folder;
LblEdtMailFrom.Text:=MailFrom;
LblEdtMailAdmin.Text:=MailAdmin;
lbMailTo.Clear;
if MailToList.Count>0 then
lbMailTo.Items.Assign(MailToList);
LblEdtFirstTime.Text:=FormatDateTime('hh:mm',FirstSendTime);
LblEdtSecondTime.Text:=FormatDateTime('hh:mm',SecondSendTime);
if IgnoreDirs.Count>0 then
lbFilter.Items.Assign(IgnoreDirs);
cbIgnoreHidden.Checked:=IgnoreHidden;
cbWatchSubTree.Checked:=WatchSubTree;
end;
end;
procedure TFrmMain.ToolButton4Click(Sender: TObject);
var
pidlBase
ItemIDList;begin
SHGetSpecialFolderLocation(Handle,CSIDL_DRIVES,pidlBase);
FolderDlg.BaseFolder.IdList:=pidlBase;
if FolderDlg.Execute then
if WatchList.Items.IndexOf(FolderDlg.SelectedPathName)=-1 then
begin
WatchList.ItemIndex:=-1;
PrepareForNewItem;
SetState(True);
LblEdtDir.Text:=FolderDlg.SelectedPathName;;
ItemState:=isNew;
end;
end;
procedure TFrmMain.ToolButton7Click(Sender: TObject);
begin
if not DirectoryExists(LblEdtDir.Text) then Exit;
FolderDlg.BaseFolder.PathName:=LblEdtDir.Text;
if FolderDlg.Execute then
if lbFilter.Items.IndexOf(FolderDlg.SelectedPathName)=-1 then
lbFilter.Items.Add(FolderDlg.SelectedPathName);
end;
procedure TFrmMain.ToolButton3Click(Sender: TObject);
begin
lbFilter.Clear;
end;
procedure TFrmMain.ToolButton2Click(Sender: TObject);
begin
if (lbFilter.Count=0) or (lbFilter.ItemIndex<0) then Exit;
lbFilter.Items.Delete(lbFilter.ItemIndex);
end;
procedure TFrmMain.ToolButton1Click(Sender: TObject);
begin
if not DirectoryExists(LblEdtDir.Text) then Exit;
OpenDlg.InitialDir:=LblEdtDir.Text;
if OpenDlg.Execute then
if (Pos(UpperCase(LblEdtDir.Text),UpperCase(ExtractFilePath(OpenDlg.FileName)))>0) and
(lbFilter.Items.IndexOf(OpenDlg.FileName)=-1) then
lbFilter.Items.Add(OpenDlg.FileName);
end;
procedure TFrmMain.PrepareForNewItem;
begin
LblEdtDir.Text:='';
LblEdtMailFrom.Text:='';
LblEdtMailAdmin.Text:='';
LblEdtFirstTime.Text:='';
LblEdtSecondTime.Text:='';
lbMailTo.Clear;
lbFilter.Clear;
EdtMailAddr.Text:='';
ToolButton8.Enabled:=False;
end;
procedure TFrmMain.EdtMailAddrChange(Sender: TObject);
var
pszTemp:string;
begin
pszTemp:=Trim(EdtMailAddr.Text);
ToolButton8.Enabled:=(Length(pszTemp)>0) and (Pos(' ',pszTemp)<1);
end;
procedure TFrmMain.ToolButton8Click(Sender: TObject);
begin
if lbMailTo.Items.IndexOf(EdtMailAddr.Text+'@kaper.com')=-1 then
lbMailTo.Items.Add(EdtMailAddr.Text+'@kaper.com');
EdtMailAddr.SetFocus;
EdtMailAddr.Text:='';
end;
procedure TFrmMain.ToolButton10Click(Sender: TObject);
begin
lbMailTo.DeleteSelected;
end;
procedure TFrmMain.ToolButton11Click(Sender: TObject);
begin
lbMailTo.Clear;
end;
procedure TFrmMain.SetState(bFlag: Boolean);
var
i:Integer;
begin
for i:=1 to 3 do
TToolButton(FindComponent('ToolButton'+IntToStr(i))).Enabled:=bFlag;
for i:=7 to 11 do
TToolButton(FindComponent('ToolButton'+IntToStr(i))).Enabled:=bFlag;
cbIgnoreHidden.Enabled:=bFlag;
cbWatchSubTree.Enabled:=bFlag;
btnOk.Enabled:=bFlag;
btnCancel.Enabled:=bFlag;
EdtMailAddr.Enabled:=bFlag;
LblEdtDir.ReadOnly:=not bFlag;
LblEdtMailFrom.ReadOnly:=not bFlag;
LblEdtMailAdmin.ReadOnly:=not bFlag;
LblEdtFirstTime.ReadOnly:=not bFlag;
LblEdtSecondTime.ReadOnly:=not bFlag;
ToolButton8.Enabled:=False;
end;
procedure TFrmMain.ToolButton12Click(Sender: TObject);
begin
SetState(True);
ItemState:=isEdit;
end;
procedure TFrmMain.btnOKClick(Sender: TObject);
var
NewID:Byte;
begin
case ItemState of
isEdit:
with WatchItemList[WatchList.ItemIndex] do
begin
try
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
except
MessageBox(Handle,'时间格式错误！','提示',MB_OK+MB_ICONEXCLAMATION);
Exit;
end;
WatchList.Items[WatchList.ItemIndex]:=LblEdtDir.Text;
Folder:=LblEdtDir.Text;
MailFrom:=LblEdtMailFrom.Text;
MailToList.Assign(lbMailTo.Items);
MailAdmin:=LblEdtMailAdmin.Text;
IgnoreDirs.Assign(lbFilter.Items);
IgnoreHidden:=cbIgnoreHidden.Checked;
WatchSubTree:=cbWatchSubTree.Checked;
DM.DB.RemoveWatchItem(Integer(WatchList.Items.Objects[WatchList.ItemIndex]));
DM.DB.NewWatchItem(Integer(WatchList.Items.Objects[WatchList.ItemIndex]),Folder,ExtractMailAccount(MailAdmin),ConvertListToString(MailToList,ctMailAddress),ExtractMailAccount(MailFrom),ConvertListToString(IgnoreDirs,ctPath),FirstSendTime,SecondSendTime,WatchSubTree,IgnoreHidden);
SetState(False);
end;
isNew:
begin
NewID:=DM.DB.GetMaxID+1;
SetLength(WatchItemList,Length(WatchItemList)+1);
with WatchItemList[Length(WatchItemList)-1] do
begin
try
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
except
MessageBox(Handle,'时间格式错误！','提示',MB_OK+MB_ICONEXCLAMATION);
SetLength(WatchItemList,Length(WatchItemList)-1);
Exit;
end;
ID:=NewID;
Folder:=LblEdtDir.Text;
MailFrom:=LblEdtMailFrom.Text;
MailToList:=TStringList.Create;
MailToList.Assign(lbMailto.Items);
MailAdmin:=LblEdtMailAdmin.Text;
FirstSendTime:=StrToTime(LblEdtFirstTime.Text);
SecondSendTime:=StrToTime(LblEdtSecondTime.Text);
IgnoreDirs:=TStringList.Create;
IgnoreDirs.Assign(lbFilter.Items);
IgnoreHidden:=cbIgnoreHidden.Checked;
WatchSubTree:=cbWatchSubTree.Checked;
DM.DB.NewWatchItem(ID,Folder,ExtractMailAccount(MailAdmin),ConvertListToString(MailToList,ctMailAddress),ExtractMailAccount(MailFrom),ConvertListToString(IgnoreDirs,ctPath),FirstSendTime,SecondSendTime,WatchSubTree,IgnoreHidden);
WatchList.AddItem(LblEdtDir.Text,TObject(NewID));
SetState(False);
end;
end;
end;
ItemState:=isBrowse;
SHRegister;
DM.DB.GetMailTime(MailTimeList);
end;
procedure TFrmMain.btnBrowseClick(Sender: TObject);
begin
if ItemState=isBrowse then Exit;
ToolButton4Click(nil);
end;
procedure TFrmMain.EdtMailAddrKeyPress(Sender: TObject; var Key: Char);
begin
if (Ord(Key)=13) and ToolButton8.Enabled then
ToolButton8Click(nil);
end;
procedure TFrmMain.btnCancelClick(Sender: TObject);
begin
SetState(False);
WatchListClick(nil);
end;
procedure TFrmMain.btnChangeClick(Sender: TObject);
var
Ini:TIniFile;
begin
Ini:=TiniFile.Create(ExtractFilePath(Application.ExeName)+'Config/System.ini');
try
Ini.WriteString('General','MailServer',ipMailServer.Text);
Ini.WriteBool('General','HideOnRun',cbHideOnRun.Checked);
RegisterRun(cbAutoRun.Checked);
cbAutoRun.Checked:=AppIsInRunQuque;
finally
Ini.Free;
end;
end;
procedure TFrmMain.SHRegister;
var
i:BYTE;
begin
SHUnRegister;
NotifyCount:=Length(WatchItemList);
if NotifyCount=0 then Exit;
SetLength(lpStruct, NotifyCount);
SetLength(ThrdList,NotifyCount);
for i:=0 to NotifyCount-1 do
with lpStruct,WatchItemList do
begin
SHILCreateFromPath(PWideChar(WideString(Folder)),@pidlPath,nil);
bWatchSubTree:=WatchSubTree;
ThrdList:=TWatchThread.Create(False,PAnsiChar(Folder),ID,IgnoreHidden,IgnoreDirs);
end;
hShell:=SHChangeNotifyRegister(Handle, SHCNF_ACCEPT_INTERRUPTS+SHCNF_ACCEPT_NON_INTERRUPTS, EventMask,NotifyMsgID, NotifyCount,@lpStruct[0]);
WatchState:=wsOpen;
if hShell=0 then
begin
MessageBox(Handle,'注册监控系统服务失败！!','错误',MB_OK+MB_ICONERROR);
Application.Terminate;
WatchState:=wsPause;
end;
end;
procedure TFrmMain.SHUnRegister;
var
i:BYTE;
begin
if hShell>0 then
SHChangeNotifyDeregister(hShell);//hShell>0
hShell:=0;
if NotifyCount>0 then
for i := 0 to NotifyCount-1 do
begin
CoTaskMemFree(lpStruct.PidlPath);
ThrdList.Terminate;
end;
NotifyCount := 0;
SetLength(ThrdList,0);
WatchState:=wsPause;
end;
procedure TFrmMain.ToolButton5Click(Sender: TObject);
var
nIdx,ID:Integer;
begin
if MessageDlg('是否删除选定监控项？',mtConfirmation,[mbYes,mbNo],0)=idNo then Exit;
nIdx:=WatchList.ItemIndex;
if nIdx=-1 then Exit;
ID:=Integer(WatchList.Items.Objects[nIdx]);
DM.DB.RemoveWatchItem(ID);
WatchList.DeleteSelected;
RemoveWatchItem(nIdx);
SHRegister;
end;
procedure TFrmMain.RemoveWatchItem(nIdx: BYTE);
var
i:BYTE;
begin
if nIdx=NotifyCount-1 then
SetLength(WatchItemList,NotifyCount-1)
else
begin
for i:=nIdx to NotifyCount-2 do
WatchItemList:=WatchItemList[i+1];
SetLength(WatchItemList,NotifyCount-1);
end;
end;
procedure TFrmMain.ToolButton6Click(Sender: TObject);
begin
if MessageDlg('是否删除全部监控项？',mtConfirmation,[mbYes,mbNo],0)=idNo then Exit;
WatchList.Clear;
DM.DB.ClearWatchItem;
SHUnRegister;
end;
procedure TFrmMain.CreateTray;
begin
with TrayStruct do
begin
cbSize:=SizeOf(TNotifyIconData);
Wnd:=Handle;
uID:=0;
hIcon:=Application.Icon.Handle;
uFlags:=NIF_ICON or NIF_TIP or NIF_MESSAGE;
uCallBackMessage:=IconMsgID;
szTip:=pszIconTip;
end;
Shell_NotifyIcon(NIM_ADD,@TrayStruct);
end;
procedure TFrmMain.miCloseClick(Sender: TObject);
var
CloseAction:TCloseAction;
begin
FormClose(nil,CloseAction);
Application.Terminate;
end;
procedure TFrmMain.miSwitchClick(Sender: TObject);
begin
case WatchState of
wsOpen:
SHUnRegister;
wsPause:
SHRegister;
end;
end;
procedure TFrmMain.miShowClick(Sender: TObject);
begin
ShowWindow(Handle,SW_SHOWNORMAL);
BringToFront;
end;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
if IconMsgID<>WM_NO_NOTIFYICON then
begin
CanClose:=False;
ShowWindow(Handle,SW_HIDE);
end;
end;
procedure TFrmMain.WMSysCommand(var message: TWMSysCommand);
begin
if (message.CmdType=SC_MINIMIZE) and (IconMsgID<>WM_NO_NOTIFYICON) then
ShowWindow(Handle,SW_HIDE)
else
DefaultHandler(message);
end;
procedure TFrmMain.FormShow(Sender: TObject);
begin
if bFirstShow and cbHideOnRun.Checked then
begin
bFirstShow:=False;
Timer1.Enabled:=True;
end;
end;
procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled:=False;
ShowWindow(Handle,SW_HIDE);
end;
end.
[三]
unit DM;
interface
uses
SysUtils,Classes, DB, ADODB,Forms,CheckLst,Dialogs,Windows;
type
TConvertType=(ctMailAddress,ctPath);
type
TDB = class(TDataModule)
aqCenter: TADOQuery;
acCenter: TADOConnection;
procedure GetMailTime(var TimeList:TStrings);
procedure GetWatchList(var CheckList:TCheckListBox);
function GetMailFiles(pszSendTime:string):TStrings;
procedure GetMailToList(ID:Integer;var MailList:TStrings);
procedure NewWatchItem(ID:BYTE;Dir,MailAdmin,MailToList,MailFrom,IgnoreDirList:string;
FirstTime,SecondTime:TDateTime;WatchSubTree,IgnoreHidden:Boolean);
procedure RemoveWatchItem(ID:BYTE);
procedure ClearWatchItem;
function GetMaxID:Byte;
private
{ Private declarations }
public
{ Public declarations }
end;
var
DB: TDB;
implementation
uses Main;
{$R *.dfm}
{ TDB }
function Yestoday(Today:TDateTime):TDateTime;
var
Year,Month,Day:WORD;
begin
DecodeDate(Today,Year,Month,Day);
if Day>1 then Dec(Day)
else
case Month of
1:
Begin
Dec(Year);
Month:=12;
Day:=31;
end;
3:
if IsLeapYear(Year) then
begin
Month:=2;
Day:=29;
end
else
begin
Month:=2;
Day:=28;
end;
5,7,8,10,12:
begin
Dec(Month);
Day:=30;
end;
2,4,6,9,11:
begin
Dec(Month);
Day:=31;
end;
end;
Result:=EncodeDate(Year,Month,Day);
end;
function ConvertStrToStringList(pszSource:string;ConvertType:TConvertType):TStrings;
var
pszTemp:string;
i:WORD;
begin
pszTemp:=pszSource;
Result:=TStringList.Create;
Result.Clear;
if Length(Trim(pszSource))=0 then Exit;
repeat
i:=Pos(',',pszTemp);
if i=0 then
begin
case ConvertType of
ctMailAddress: Result.Add(pszTemp+'@kaper.com');
ctPath: Result.Add(pszTemp);
end;
Break;
end;
case ConvertType of
ctMailAddress: Result.Add(Copy(pszTemp,1,i-1)+'@kaper.com');
ctPath: Result.Add(Copy(pszTemp,1,i-1));
end;
pszTemp:=Copy(pszTemp,i+1,Length(pszTemp)-i);
until
i=0;
end;
procedure TDB.GetWatchList(var CheckList:TCheckListBox);
var
WatchItem:TWatchItem;
i:Integer;
begin
with aqCenter do
begin
SQL.Clear;
SQL.Add('Select ID,directory ,mailadmin,mailfrom ,maillist,firsttime,secondtime,ignorehidden,ignoredirs,watchsubtree From WatchList Order By ID ASC');
try
Open;
First;
DisableControls;
i:=0;
repeat
if DirectoryExists(Fields[1].AsString) then
begin
with WatchItem do
begin
ID:=Fields[0].AsInteger;
Folder:=Fields[1].AsString;
MailAdmin:=Fields[2].AsString+'@kaper.com';
MailFrom:=Fields[3].AsString+'@kaper.com';
MailToList:=ConvertStrToStringList(Fields[4].AsString,ctMailAddress);
FirstSendTime:=Fields[5].AsDateTime;
SecondSendTime:=Fields[6].AsDateTime;
IgnoreHidden:=Fields[7].AsBoolean;
WatchSubTree:=Fields[9].AsBoolean;
IgnoreDirs:=ConvertStrToStringList(Fields[8].AsString,ctPath);
end;
SetLength(FrmMain.WatchItemList,i+1);
FrmMain.WatchItemList:=WatchItem;
CheckList.AddItem(Fields[1].AsString,TObject(Fields[0].AsInteger));
Inc(i);
end;
Next;
until
Eof;
EnableControls;
except
Application.Terminate;
end;
end;
end;
function TDB.GetMailFiles(pszSendTime: string): TStrings;
var
pszFileName:string;
lpFileInfo:TWin32FindData;
FindHandle:THandle;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Distinct(ID) From WatchList Where firsttime=:ft or secondtime=:st');
with Parameters do
begin
ParamValues['ft']:=StrToTime(pszSendTime);
ParamValues['st']:=StrToTime(pszSendTime);
end;
Open;
First;
DisableControls;
Result:=TStringList.Create;
Result.Clear;
repeat
pszFileName:=ExtractFilePath(Application.ExeName)+'TrackHistory/'+Fields[0].AsString+'/'+'*.txt';
FindHandle:=FindFirstFile(PAnsiChar(pszFileName),lpFileInfo);
if FindHandle<>INVALID_HANDLE_VALUE then
begin
repeat
Result.AddObject(StrPas(@lpFileInfo.cFileName[0]),TObject(Fields[0].AsInteger));
until
not FindNextFile(FindHandle,lpFileInfo);
FindClose(FindHandle);
end;
{pszFileName:=ExtractFilePath(Application.ExeName)+'TrackHistory/'+Fields[0].AsString+'/'+FormatDateTime('ddddd".txt"',Date);
if FileExists(pszFileName) then
Result.AddObject(pszFileName,TObject(Fields[0].AsInteger));}
Next;
until
Eof;
end;
end;
procedure TDB.GetMailTime(var TimeList: TStrings);
begin
TimeList.Clear;
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Distinct(firsttime) From WatchList');
Open;
First;
DisableControls;
repeat
TimeList.Add(FormatDateTime('hh:mm:ss',Fields[0].AsDateTime));
Next;
until
Eof;
EnableControls;
Close;
SQL.Clear;
SQL.Add('Select Distinct(secondtime) From WatchList');
Open;
First;
DisableControls;
repeat
TimeList.AddObject(FormatDateTime('hh:mm:ss',Fields[0].AsDateTime),TObject(0));
Next;
until
Eof;
EnableControls;
end;
end;
procedure TDB.GetMailToList(ID: Integer;var MailList:TStrings);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select maillist From WatchList Where ID='+IntToStr(ID));
Open;
MailList:=ConvertStrToStringList(Fields[0].AsString,ctMailAddress);
end;
end;
function TDB.GetMaxID: Byte;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Select Max(ID) From WatchList');
Open;
Result:=Fields[0].AsInteger;
end;
end;
procedure TDB.NewWatchItem(ID: BYTE; Dir, MailAdmin, MailToList, MailFrom,
IgnoreDirList: string; FirstTime, SecondTime: TDateTime; WatchSubTree,
IgnoreHidden: Boolean);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Insert Into WatchList(id,directory,mailfrom,maillist,mailadmin,ignoredirs,firsttime,secondtime,ignorehidden,watchsubtree) ');
SQL.Add('Values
ID,ir,:MF,:MT,:MA,:IDir,:FT,:ST,:IH,:WST)');with Parameters do
begin
ParamValues['ID']:=ID;
ParamValues['Dir']:=Dir;
ParamValues['MF']:=MailFrom;
ParamValues['MT']:=MailToList;
ParamValues['MA']:=MailAdmin;
ParamValues['IDir']:=IgnoreDirList;
ParamValues['FT']:=FirstTime;
ParamValues['ST']:=SecondTime;
ParamValues['IH']:=IgnoreHidden;
ParamValues['WST']:=WatchSubTree;
end;
ExecSQL;
end;
end;
procedure TDB.RemoveWatchItem(ID: BYTE);
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Delete From WatchList Where ID='+IntToStr(ID));
ExecSQL;
end;
end;
procedure TDB.ClearWatchItem;
begin
with aqCenter do
begin
Close;
SQL.Clear;
SQL.Add('Delete From WatchList');
ExecSQL;
end;
end;
end.
[四]
unit Mail;
interface
uses
Classes,Windows,SysUtils,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
IdMessageClient, IdSMTP,IdMessage,Forms;
type TTimerProc=procedure(Hwnd:THandle;Msg,idEvent:UINT;dwTime
WORD);type TMailThrd=class(TThread)
private
fMailCtrl:TidSMTP;
idTimer:UINT;
lpFNProc:TTimerProc;
procedure SendMail(FileList:TStrings);
public
MailTimeList:TStrings;
constructor Create(CreateSuspended:Boolean);
procedure Execute;override;
destructor Destroy;override;
end;
procedure TimerProc(Hwnd:THandle;uMsg,idEvent:UINT;dwTime
WORD);var
MailThrd:TMailThrd;
implementation
{ MailThrd }
uses
DM,Main;
procedure TMailThrd.SendMail(FileList:TStrings);
var
i,j:Integer;
MailList:TStrings;
MailMsg:TidMessage;
begin
MailList:=TStringList.Create;
MailMsg:=TidMessage.Create(fMailCtrl);
for i:=0 to FileList.Count do
begin
DB.GetMailToList(Integer(FileList.Objects),MailList);
with fMailCtrl do
begin
Host:='192.168.1.240';
UserName:='Watcher';
Password:='123456';
AuthenticationType:=atNone;
with MailMsg do
begin
From.Text:='Watcher@kaper.com';
From.Name:='文件和目录监控';
Subject:='文件和目录操作通知';
Body.LoadFromFile(FileList);
end;
end;
for j:=0 to MailList.Count-1 do
begin
MailMsg.Recipients.EMailAddresses:=MailList[j]+'@kaper.com';
try
fMailCtrl.Connect(2000);
except
MessageBox(Handle,'连接邮件服务器失败！','错误',MB_OK+MB_ICONERROR);
Exit;
end;
try
fMailCtrl.Send(MailMsg);
finally
fMailCtrl.Disconnect;
end;
end;
end;
end;
function EqualTime(Time1,Time2:TDateTime):Boolean;
var
nHour1,nMin1,nSec1,nMSec1, nHour2,nMin2,nSec2,nMSec2:WORD;
begin
DecodeTime(Time1,nHour1,nMin1,nSec1,nMSec1);
DecodeTime(Time2,nHour2,nMin2,nSec2,nMSec2);
Result:=(nHour1=nHour2) and (nMin1=nMin2);
end;
constructor TMailThrd.Create(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
fMailCtrl:=TidSMTP.Create(nil);
lpFNProc:=TimerProc;
MailTimeList:=TStringList.Create;
DB.GetMailTime(MailTimeList);
FreeOnTerminate:=True;
end;
destructor TMailThrd.Destroy;
begin
if Assigned(fMailCtrl) then
fMailCtrl.Free;
inherited;
if Assigned(MailTimeList) then
MailTimeList.Free;
if idTimer>0 then
KillTimer(0,idTimer);
end;
procedure TMailThrd.Execute;
begin
inherited;
idTimer:=SetTimer(0,1,30000,@lpFNProc);
if idTimer=0 then Exit;
end;
procedure TimerProc(Hwnd: THandle; uMsg, idEvent: UINT;
dwTime: DWORD);
var
i:BYTE;
begin
for i:=0 to MailThrd.MailTimeList.Count-1 do
if EqualTime(Time,StrToTime(MailThrd.MailTimeList)) then
begin
MailThrd.SendMail(DM.DB.GetMailFiles(MailThrd.MailTimeList));
Break;
end;
end;
end.
问题一：一次变化得到两次通知，不知道什么原因；
问题二：*.xls文件一打开就得到该文件被修改的通知，关闭时也是。
请求高手解答！