... - выбрать каталог, который будет прозваниваться.
ClearList - очистить текущий список (отслеживаемые объекты).
SaveList - сохранить лог в файл (сохраняет рядом с .exe).
Change - при выборе нового каталога нажать, чтобы монитор начал мониторить новый каталог.
pm/am - переключение "день/ночь".
LVi scroll - включение автоматической прокрутки скроллинга вниз.
Код: Выделить всё
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, ShlObj, Forms, Dialogs,Math,
StdCtrls, StrUtils, Controls, ExtCtrls, ComCtrls, FileCtrl, ShellAPI;
//{$R XPManifest.res}
type
TForm1 = class(TForm)
LVi: TListView;
Edit1: TEdit;
Button2: TButton;
Button1: TButton;
StatusBar1: TStatusBar;
Button3: TButton;
Panel1: TPanel;
Button4: TButton;
Button5: TButton;
Timer1: TTimer;
CheckBox1: TCheckBox;
procedure LVSaveList(Sender: TObject);
procedure LViChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormShow(Sender: TObject);
procedure xXx(Sender: TObject);
procedure LViMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
type
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: array [0..2047] of WCHAR;
end;
PFileNotifyInformation = ^TFileNotifyInformation;
var
Form1: TForm1;
hThread: Cardinal;
move: boolean;
px, py: integer;
savelist: String;
implementation
{$R *.DFM}
procedure WorkThread(LV : TListView); stdcall;
var
hDir : THandle;
lpBuf : Pointer;
Ptr : Pointer;
cbReturn : Cardinal;
FileName : PWideChar;
Item : TListItem;
sTime : _SYSTEMTIME;
FILE_NOTIFY_CHANGE: DWORD;
path: String;
const
BUF_SIZE = 2048;
begin
path:=Form1.Edit1.Text;
path:=ExcludeTrailingBackslash(path)+'\';
if not DirectoryExists(path) then
begin
ShowMessage('Directory does not exists! Enter correct directory.');
Exit;
end;
hDir := CreateFile(PChar(path),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE
or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
if hDir = INVALID_HANDLE_VALUE then
begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
FILE_NOTIFY_CHANGE:= FILE_NOTIFY_CHANGE_FILE_NAME+
FILE_NOTIFY_CHANGE_DIR_NAME+
FILE_NOTIFY_CHANGE_ATTRIBUTES+
FILE_NOTIFY_CHANGE_SIZE;
GetMem(lpBuf,BUF_SIZE);
repeat
ZeroMemory(lpBuf,BUF_SIZE);
if not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,
FILE_NOTIFY_CHANGE,@cbReturn,nil,nil) then Break;
Ptr:=lpBuf;
repeat
Item := LV.Items.Add;
GetMem(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
ZeroMemory(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
lstrcpynW(FileName,PFileNotifyInformation(Ptr).FileName,
PFileNotifyInformation(Ptr).FileNameLength div 2+1);
Item.Caption:=path+String(FileName);
FreeMem(FileName);
case PFileNotifyInformation(Ptr).Action of
FILE_ACTION_ADDED : Item.SubItems.Add('Файл был создан');
FILE_ACTION_REMOVED : Item.SubItems.Add('Файл был удален');
FILE_ACTION_MODIFIED : Item.SubItems.Add('Файл был изменен');
FILE_ACTION_RENAMED_OLD_NAME :
Item.SubItems.Add('Файл был переименован и в имени файла - предыдущее имя');
FILE_ACTION_RENAMED_NEW_NAME :
Item.SubItems.Add('новое имя после переименования');
else
Item.SubItems.Add('Произошло что-то странное');
end;
GetLocalTime(sTime);
with sTime do
Item.SubItems.Add(Format('%.2d:%.2d:%.2d',[wHour,wMinute,wSecond]));
if PFileNotifyInformation(Ptr).NextEntryOffset=0 then Break
else begin
Item.SubItems.Add('Offset : '+
IntToStr(PFileNotifyInformation(Ptr).NextEntryOffset));
Inc(Cardinal(Ptr),PFileNotifyInformation(Ptr).NextEntryOffset);
end;
until false;
until false;
FreeMem(lpBuf);
end;
procedure TForm1.LViChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
begin
if CheckBox1.Checked = true then LVi.Scroll(0,Item.Position.y);
// StatusBar1.Panels[0].Text := IntToStr(LVi.Items.Count);
form1.Caption:=IntToStr(LVi.Items.Count);
end;
function BrowseFolder(title: PChar; h: HWND): String;
var
lpItemID: PItemIDList;
path: array[0..Max_path] of Char;
BrowseInfo: TBrowseInfo;
begin
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
SHGetSpecialFolderLocation(h,csidl_desktop,BrowseInfo.pidlRoot);
with BrowseInfo do
begin
hwndOwner := h;
lpszTitle := title;
ulFlags := BIF_RETURNONLYFSDIRS+BIF_EDITBOX+BIF_STATUSTEXT;
end;
lpItemID := SHBrowseForFolder(BrowseInfo);
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, Path);
result:=path;
GlobalFreePtr(lpItemID);
end;
end;
procedure TForm1.xXx(Sender: TObject);
var
ExitCode: Cardinal;
path: String;
begin
case TComponent(Sender).Tag of
1:
begin
GetExitCodeThread(hThread,ExitCode);
if not TerminateThread(hThread,ExitCode) then
ShowMessage(SysErrorMessage(GetLastError))
else
FormShow(nil);
application.Title:='Сниффер каталога - ['+edit1.Text+']';
end;
2:
begin
path:=BrowseFolder('Выберите папку, в которой будет '+
'проводится мониторинг файлов. Затем нажмите ''Change'' ', Form1.Handle);
if path <> '' then Edit1.Text:=path;
end;
3: if lvi.Color=clWindow then
begin
lvi.Color:=(clBlack);
lvi.Font.Color:=(clWindow);
end
else
begin
lvi.Color:=(clWindow);
lvi.Font.Color:=(clBlack);
end;
4: lvi.Clear;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
var
ThID : Cardinal;
begin
hThread:=CreateThread(nil,0,@WorkThread,LVi,0,ThID);
if hThread = 0 then ShowMessage(SysErrorMessage(GetLastError))
//else StatusBar1.SimpleText:='Слежение в '+Edit1.Text;
else StatusBar1.Panels[1].Text:='Слежение в '+Edit1.Text;
end;
procedure TForm1.LViMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Panel1.Top > Y-40 then panel1.visible := true else panel1.visible := false;
end;
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=true;
px:=x; py:=y;
end;
procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if move=true then
begin
Panel1.Left:=Panel1.Left+(x-px);
Panel1.Top:=Panel1.Top+(y-py);
end;
end;
procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
move:=false;
end;
procedure TForm1.LVSaveList(Sender: TObject);
var
S:TStringList;
i:integer;
begin
savelist:=ExtractFilePath(Application.ExeName)+FormatDateTime('ddmmyyyy-hhnn',now)+'.txt';
S := TStringList.Create;
for i := 0 to LVi.Items.Count-1 do
begin
S.Add(IfThen(LVi.Items[i].Checked,IntToStr(1+i),'0') + '"' +
LVi.Items[i].Caption +'",' +
LVi.Items[i].SubItems.CommaText)
end;
S.SaveToFile(savelist);
S.Free;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
//StatusBar1.Panels[0].Text := IntToStr(LVi.Items.Count);
end;
end.