Сниффер каталога/локального диска - исходник на delphi

Исходники делфи, готовые программы/приложения и т.д.
Ответить
Аватара пользователя
glGizma
Site Admin
Сообщения: 214
Зарегистрирован: Ср сен 27, 2017 2:20 pm

Сниффер каталога/локального диска - исходник на delphi

Сообщение glGizma » Вс окт 03, 2021 1:40 pm

Обычный файловый монитор/сниффер каталога/локального диска, отображает изменение/удаление/создание объектов.
... - выбрать каталог, который будет прозваниваться.
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.
Готовый .exe файл в архиве
Вложения
FMON.rar
(207.97 КБ) 295 скачиваний
fmon.png
fmon.png (68.79 КБ) 9700 просмотров

Ответить