请教用delphi做系统监控程序的方法 也就是程序监控本机进行某个文件(目录,驱动器等等越多越好)进行各种操作比如新增删除移动等等都要被记录下来的程序急!帮帮小弟!! 解决方案 » 免费领取超大流量手机卡,每月29元包185G流量+100分钟通话, 中国电信官方发货 unit unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, shlobj, Activex, StdCtrls;const SHCNE_RENAMEITEM = $1; SHCNE_CREATE = $2; SHCNE_DELETE = $4; SHCNE_MKDIR = $8; SHCNE_RMDIR = $10; SHCNE_MEDIAINSERTED = $20; SHCNE_MEDIAREMOVED = $40; SHCNE_DRIVEREMOVED = $80; SHCNE_DRIVEADD = $100; SHCNE_NETSHARE = $200; SHCNE_NETUNSHARE = $400; SHCNE_ATTRIBUTES = $800; SHCNE_UPDATEDIR = $1000; SHCNE_UPDATEITEM = $2000; SHCNE_SERVERDISCONNECT = $4000; SHCNE_UPDATEIMAGE = $8000; SHCNE_DRIVEADDGUI = $10000; SHCNE_RENAMEFOLDER = $20000; SHCNE_FREESPACE = $40000; SHCNE_ASSOCCHANGED = $8000000; SHCNE_DISKEVENTS = $2381F; SHCNE_GLOBALEVENTS = $C0581E0; SHCNE_ALLEVENTS = $7FFFFFFF; SHCNE_INTERRUPT = $80000000; SHCNF_IDLIST = 0; // LPITEMIDLIST SHCNF_PATHA = $1; // path name SHCNF_PRINTERA = $2; // printer friendly name SHCNF_DWORD = $3; // DWORD SHCNF_PATHW = $5; // path name SHCNF_PRINTERW = $6; // printer friendly name SHCNF_TYPE = $FF; SHCNF_FLUSH = $1000; SHCNF_FLUSHNOWAIT = $2000; SHCNF_PATH = SHCNF_PATHW; SHCNF_PRINTER = SHCNF_PRINTERW; WM_SHNOTIFY = $401; NOERROR = 0;type TForm1 = class(TForm) Memo1: TMemo; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); private procedure WMShellReg(var Message: TMessage); message WM_SHNOTIFY; end;type PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT; SHNOTIFYSTRUCT = record dwItem1: PItemIDList; dwItem2: PItemIDList; end;type PSHFileInfoByte = ^SHFileInfoByte; _SHFileInfoByte = record hIcon: Integer; iIcon: Integer; dwAttributes: Integer; szDisplayName: array[0..259] of char; szTypeName: array[0..79] of char; end; SHFileInfoByte = _SHFileInfoByte;type PIDLSTRUCT = ^IDLSTRUCT; _IDLSTRUCT = record pidl: PItemIDList; bWatchSubFolders: Integer; end; IDLSTRUCT = _IDLSTRUCT;function SHNotify_Register(hWnd: Integer): Bool;function SHNotify_UnRegister: Bool;function SHEventName(strPath1, strPath2: string; lParam: Integer): string;function SHChangeNotifyDeregister(hNotify: integer): integer; stdcall;external 'Shell32.dll' index 4;function SHChangeNotifyRegister(hWnd, uFlags, dwEventID, uMSG, cItems: LongWord; lpps: PIDLSTRUCT): integer; stdcall; external 'Shell32.dll' index 2;function SHGetFileInfoPidl(pidl: PItemIDList;dwFileAttributes: Integer; psfib: PSHFILEINFOBYTE;cbFileInfo: Integer; uFlags: Integer): Integer; stdcall;external 'Shell32.dll' name 'SHGetFileInfoA';var Form1: TForm1; m_hSHNotify: Integer; m_pidlDesktop: PItemIDList;implementation{$R *.DFM}function SHEventName(strPath1, strPath2: string; lParam: Integer): string;var sEvent: string;begin case lParam of // 提示消息 SHCNE_RENAMEITEM: sEvent := '重命名文件 ' + strPath1 + '为' + strpath2; SHCNE_CREATE: sEvent := '建立文件 文件名: ' + strPath1; SHCNE_DELETE: sEvent := '删除文件 文件名: ' + strPath1; SHCNE_MKDIR: sEvent := '新建目录 目录名: ' + strPath1; SHCNE_RMDIR: sEvent := '删除目录 目录名: ' + strPath1; SHCNE_MEDIAINSERTED: sEvent := strPath1 + '中插入可移动存储介质'; SHCNE_MEDIAREMOVED: sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' ' + strpath2; SHCNE_DRIVEREMOVED: sEvent := '移去驱动器 ' + strPath1; SHCNE_DRIVEADD: sEvent := '添加驱动器 ' + strPath1; SHCNE_NETSHARE: sEvent := '改变目录 ' + strPath1 + '的共享属性'; SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名 ' + strPath1; SHCNE_UPDATEDIR: sEvent := '更新目录 ' + strPath1; SHCNE_UPDATEITEM: sEvent := '更新文件 文件名: ' + strPath1; SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接 ' + strPath1 + ' ' + strpath2; SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE'; SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI'; SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹 ' + strPath1 + '为' + strpath2; SHCNE_FREESPACE: sEvent := '磁盘空间大小改变 '; SHCNE_ASSOCCHANGED: sEvent := '改变文件关联 '; else sEvent := '打开文件或未知操作 ' + IntToStr(lParam); end; Result := sEvent;end;function SHNotify_Register(hWnd: Integer): Bool;var ps: PIDLSTRUCT;begin Result := False; ps:=AllocMem(SizeOf(IDLSTRUCT)); if m_hSHNotify = 0 then begin if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP, m_pidlDesktop) <> NOERROR then Form1.close; if Boolean(m_pidlDesktop) then begin ps.bWatchSubFolders := 1; ps.pidl := m_pidlDesktop; // 注册消息处理 m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST), (SHCNE_ALLEVENTS or SHCNE_INTERRUPT), WM_SHNOTIFY, 1, ps); Result := Boolean(m_hSHNotify); end else CoTaskMemFree(m_pidlDesktop); // 如果错误就释放 end; FreeMem(ps);end;function SHNotify_UnRegister: Bool;begin Result := False; if Boolean(m_hSHNotify) then if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then begin m_hSHNotify := 0; CoTaskMemFree(m_pidlDesktop); Result := True; end;end;procedure TForm1.WMShellReg(var Message: TMessage); //系统消息处理函数var strPath1, strPath2: string; charPath: array[0..259] of char; pidlItem: PSHNOTIFYSTRUCT; datetime: TDateTime; MyLogTextFile:TextFile;begin datetime:=Now; pidlItem := PSHNOTIFYSTRUCT(Message.wParam); SHGetPathFromIDList(pidlItem.dwItem1, charPath); strPath1 := charPath; SHGetPathFromIDList(pidlItem.dwItem2, charPath); strPath2 := charPath; Memo1.Lines.Add(DateToStr(datetime)+' '+TimeToStr(datetime)+' '+SHEvEntName(strPath1, strPath2, Message.lParam) + chr(10)); AssignFile(MyLogTextFile,'Log.txt'); Append(MyLogTextFile); try Writeln(MyLogTextFile,DateToStr(datetime)+' '+TimeToStr(datetime)+' '+SHEvEntName(strPath1, strPath2, Message.lParam) + chr(10)); Flush(MyLogTextFile); finally CloseFile(MyLogTextFile); end; end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);begin if Boolean(m_pidlDesktop) then SHNotify_Unregister;end;procedure TForm1.FormCreate(Sender: TObject);var MyLogTextFile:TextFile;begin AssignFile(MyLogTextFile,'Log.txt'); Rewrite(MyLogTextFile); try Writeln(MyLogTextFile,'时间'+' '+'操作'+' '+'文件路径'); finally CloseFile(MyLogTextFile); m_hSHNotify := 0; if SHNotify_Register(Form1.Handle) then Caption:=Caption+' (监视中,并写入当前目录的log.txt中)' end;end;end.我从网络下载来的程序,我用了一下,无法监视文件打开操作,比如说我打开了一个文本文件,是无法监控到的 想实现全部的监控,用驱动程序,Hook系统服务才能做到的例如FileMon的 如楼上所说,要用钩子截获系统信息,比如Socket,键盘,鼠标等等:WH_CALLWNDPROCWH_CALLWNDPROCRETWH_CBTWH_DEBUGWH_GETMESSAGEWH_JOURNALPLAYBACKWH_JOURNALRECORDWH_KEYBOARDWH_MOUSEWH_MSGFILTERWH_SHELLWH_SYSMSGFILTER 为什么打印时出现无名打印任务 怎么使用delphi皮肤文件啊 请问一条SQL语句怎么写 使用哪种数据库最为方便 怎么样锁定DBGRID的某一列不允许修改? 请问这样的控件是怎么做的? 请问各位大虾,dhlphi7中一般用什么工具做报表阿? Foxpro中有宏的替换(即‘&’),在DELPHI中有没有? 对了在数据库中的DBGRID中是否可加入两组以上的数据?? 关于数据库的简单问题? whats wrong? dbgridEn 如何实现翻页功能? FastReport 中条形码的打印问题!
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
shlobj, Activex, StdCtrls;const
SHCNE_RENAMEITEM = $1;
SHCNE_CREATE = $2;
SHCNE_DELETE = $4;
SHCNE_MKDIR = $8;
SHCNE_RMDIR = $10;
SHCNE_MEDIAINSERTED = $20;
SHCNE_MEDIAREMOVED = $40;
SHCNE_DRIVEREMOVED = $80;
SHCNE_DRIVEADD = $100;
SHCNE_NETSHARE = $200;
SHCNE_NETUNSHARE = $400;
SHCNE_ATTRIBUTES = $800;
SHCNE_UPDATEDIR = $1000;
SHCNE_UPDATEITEM = $2000;
SHCNE_SERVERDISCONNECT = $4000;
SHCNE_UPDATEIMAGE = $8000;
SHCNE_DRIVEADDGUI = $10000;
SHCNE_RENAMEFOLDER = $20000;
SHCNE_FREESPACE = $40000;
SHCNE_ASSOCCHANGED = $8000000;
SHCNE_DISKEVENTS = $2381F;
SHCNE_GLOBALEVENTS = $C0581E0;
SHCNE_ALLEVENTS = $7FFFFFFF;
SHCNE_INTERRUPT = $80000000; SHCNF_IDLIST = 0; // LPITEMIDLIST
SHCNF_PATHA = $1; // path name
SHCNF_PRINTERA = $2; // printer friendly name
SHCNF_DWORD = $3; // DWORD
SHCNF_PATHW = $5; // path name
SHCNF_PRINTERW = $6; // printer friendly name
SHCNF_TYPE = $FF; SHCNF_FLUSH = $1000; SHCNF_FLUSHNOWAIT = $2000;
SHCNF_PATH = SHCNF_PATHW;
SHCNF_PRINTER = SHCNF_PRINTERW; WM_SHNOTIFY = $401;
NOERROR = 0;type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure WMShellReg(var Message: TMessage); message WM_SHNOTIFY;
end;type PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT;
SHNOTIFYSTRUCT = record
dwItem1: PItemIDList;
dwItem2: PItemIDList;
end;type PSHFileInfoByte = ^SHFileInfoByte;
_SHFileInfoByte = record
hIcon: Integer;
iIcon: Integer;
dwAttributes: Integer;
szDisplayName: array[0..259] of char;
szTypeName: array[0..79] of char;
end;
SHFileInfoByte = _SHFileInfoByte;type PIDLSTRUCT = ^IDLSTRUCT;
_IDLSTRUCT = record
pidl: PItemIDList;
bWatchSubFolders: Integer;
end;
IDLSTRUCT = _IDLSTRUCT;
function SHNotify_Register(hWnd: Integer): Bool;
function SHNotify_UnRegister: Bool;
function SHEventName(strPath1, strPath2: string; lParam: Integer): string;
function SHChangeNotifyDeregister(hNotify: integer): integer; stdcall;
external 'Shell32.dll' index 4;
function SHChangeNotifyRegister(hWnd, uFlags, dwEventID, uMSG, cItems: LongWord;
lpps: PIDLSTRUCT): integer; stdcall; external 'Shell32.dll' index 2;
function SHGetFileInfoPidl(pidl: PItemIDList;dwFileAttributes: Integer;
psfib: PSHFILEINFOBYTE;cbFileInfo: Integer;
uFlags: Integer): Integer; stdcall;
external 'Shell32.dll' name 'SHGetFileInfoA';var
Form1: TForm1;
m_hSHNotify: Integer;
m_pidlDesktop: PItemIDList;
implementation{$R *.DFM}
function SHEventName(strPath1, strPath2: string; lParam: Integer): string;
var
sEvent: string;
begin
case lParam of // 提示消息
SHCNE_RENAMEITEM: sEvent := '重命名文件 ' + strPath1 + '为' + strpath2;
SHCNE_CREATE: sEvent := '建立文件 文件名: ' + strPath1;
SHCNE_DELETE: sEvent := '删除文件 文件名: ' + strPath1;
SHCNE_MKDIR: sEvent := '新建目录 目录名: ' + strPath1;
SHCNE_RMDIR: sEvent := '删除目录 目录名: ' + strPath1;
SHCNE_MEDIAINSERTED: sEvent := strPath1 + '中插入可移动存储介质';
SHCNE_MEDIAREMOVED: sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' ' + strpath2;
SHCNE_DRIVEREMOVED: sEvent := '移去驱动器 ' + strPath1;
SHCNE_DRIVEADD: sEvent := '添加驱动器 ' + strPath1;
SHCNE_NETSHARE: sEvent := '改变目录 ' + strPath1 + '的共享属性'; SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性 文件名 ' + strPath1;
SHCNE_UPDATEDIR: sEvent := '更新目录 ' + strPath1;
SHCNE_UPDATEITEM: sEvent := '更新文件 文件名: ' + strPath1;
SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接 ' + strPath1 + ' ' + strpath2;
SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';
SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';
SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹 ' + strPath1 + '为' + strpath2;
SHCNE_FREESPACE: sEvent := '磁盘空间大小改变 ';
SHCNE_ASSOCCHANGED: sEvent := '改变文件关联 ';
else
sEvent := '打开文件或未知操作 ' + IntToStr(lParam);
end;
Result := sEvent;
end;function SHNotify_Register(hWnd: Integer): Bool;
var
ps: PIDLSTRUCT;
begin
Result := False;
ps:=AllocMem(SizeOf(IDLSTRUCT));
if m_hSHNotify = 0 then
begin
if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,
m_pidlDesktop) <> NOERROR then
Form1.close;
if Boolean(m_pidlDesktop) then begin
ps.bWatchSubFolders := 1;
ps.pidl := m_pidlDesktop;
// 注册消息处理
m_hSHNotify := SHChangeNotifyRegister(hWnd, (SHCNF_TYPE or SHCNF_IDLIST),
(SHCNE_ALLEVENTS or SHCNE_INTERRUPT),
WM_SHNOTIFY, 1, ps);
Result := Boolean(m_hSHNotify);
end
else
CoTaskMemFree(m_pidlDesktop); // 如果错误就释放
end;
FreeMem(ps);
end;function SHNotify_UnRegister: Bool;
begin
Result := False;
if Boolean(m_hSHNotify) then
if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then begin
m_hSHNotify := 0;
CoTaskMemFree(m_pidlDesktop);
Result := True;
end;
end;procedure TForm1.WMShellReg(var Message: TMessage); //系统消息处理函数
var
strPath1, strPath2: string;
charPath: array[0..259] of char;
pidlItem: PSHNOTIFYSTRUCT;
datetime: TDateTime;
MyLogTextFile:TextFile;
begin
datetime:=Now; pidlItem := PSHNOTIFYSTRUCT(Message.wParam);
SHGetPathFromIDList(pidlItem.dwItem1, charPath);
strPath1 := charPath;
SHGetPathFromIDList(pidlItem.dwItem2, charPath);
strPath2 := charPath; Memo1.Lines.Add(DateToStr(datetime)+' '+TimeToStr(datetime)+' '+SHEvEntName(strPath1, strPath2, Message.lParam) + chr(10));
AssignFile(MyLogTextFile,'Log.txt');
Append(MyLogTextFile);
try
Writeln(MyLogTextFile,DateToStr(datetime)+' '+TimeToStr(datetime)+' '+SHEvEntName(strPath1, strPath2, Message.lParam) + chr(10));
Flush(MyLogTextFile);
finally
CloseFile(MyLogTextFile);
end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Boolean(m_pidlDesktop) then SHNotify_Unregister;
end;procedure TForm1.FormCreate(Sender: TObject);
var
MyLogTextFile:TextFile;
begin
AssignFile(MyLogTextFile,'Log.txt');
Rewrite(MyLogTextFile);
try
Writeln(MyLogTextFile,'时间'+' '+'操作'+' '+'文件路径');
finally
CloseFile(MyLogTextFile);
m_hSHNotify := 0;
if SHNotify_Register(Form1.Handle) then
Caption:=Caption+' (监视中,并写入当前目录的log.txt中)'
end;
end;end.
我从网络下载来的程序,我用了一下,无法监视文件打开操作,比如说我打开了一个文本文件,是无法监控到的
例如FileMon的
WH_CALLWNDPROC
WH_CALLWNDPROCRET
WH_CBT
WH_DEBUG
WH_GETMESSAGEWH_JOURNALPLAYBACK
WH_JOURNALRECORD
WH_KEYBOARD
WH_MOUSE
WH_MSGFILTER
WH_SHELL
WH_SYSMSGFILTER