Программа записи действий пользователя

В новом году открываю новую рубрику — код месяца! В этом цикле статей ежемесячно буду публиковать свои коды различных программ и модулей на языке программирования Delphi под систему Windows.

В январе рассмотрим пример написания программы мониторинга действий пользователя в операционной системе семейства Windows. Программа записывает в лог файл мониторинг запуска программ (процессов), открытия окон, буфера обмена, открытия страниц интернета, подключения съемных устройств, включение и выключение компьютера.

Ну что ж начнем, для написания данной программы понадобится создать стандартное окно формы, добавить на него 4 таймера и 1 поле мемо, в uses необходимо помимо стандартных модулей подключить TlHelp32, PsAPI для работы с процессами

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, TlHelp32, PsAPI;

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, TlHelp32, PsAPI;

далее понадобится добавить типы данных для мониторинга дисков

const
  DBT_DeviceArrival        = $8000;
  DBT_DeviceRemoveComplete = $8004;
  DBT_DevTyp_Volume        = $0002;
  MAX_WINDOW_NAME          = 32767;

type
  PDevBroadcastHdr = ^TDevBroadcastHdr;
  TDevBroadcastHdr = packed record
    dbcd_size: DWORD;
    dbcd_devicetype: DWORD;
    dbcd_reserved: DWORD;
  end;

  PDevBroadcastVolume = ^TDevBroadcastVolume;
  TDevBroadcastVolume = packed record
    dbcv_size: DWORD;
    dbcv_devicetype: DWORD;
    dbcv_reserved: DWORD;
    dbcv_unitmask: DWORD;
    dbcv_flags: Word;
  end;

const

DBT_DeviceArrival = $8000;

DBT_DeviceRemoveComplete = $8004;

DBT_DevTyp_Volume = $0002;

MAX_WINDOW_NAME = 32767;

type

PDevBroadcastHdr = ^TDevBroadcastHdr;

TDevBroadcastHdr = packed record

dbcd_size: DWORD;

dbcd_devicetype: DWORD;

dbcd_reserved: DWORD;

end;

PDevBroadcastVolume = ^TDevBroadcastVolume;

TDevBroadcastVolume = packed record

dbcv_size: DWORD;

dbcv_devicetype: DWORD;

dbcv_reserved: DWORD;

dbcv_unitmask: DWORD;

dbcv_flags: Word;

end;

теперь в класс формы в приватную и защищенную секцию добавляем следующий код, процедуры будут рассмотрены далее. Также на форму понадобится добавить 4 таймера и 1 Мемо поле. В переменные добавить строковые переменные для хранения текста мониторинга окон и буфера обмена и 4 строковых листа для хранения и сравнивания полученных данных.

TForm1 = class(TForm)
    Memo1: TMemo;
    Timer1: TTimer;
    Timer2: TTimer;
    Timer3: TTimer;
    Timer4: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer4Timer(Sender: TObject);
  private
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    procedure WMHotkey( var msg: TWMHotkey ); message WM_HOTKEY;
    procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;
    procedure WMQUERYENDSESSION(var Msg : TMessage); message WM_QUERYENDSESSION;
  public
  protected
    procedure IsWindowsShutDown(Var Msg:TMessage); message WM_ENDSESSION;
  end;

var
  Form1       : TForm1;
  wndstr2     : string;
  clipbrdstr  : string;
  L1,L2,W1,W2 : TStringList;

TForm1 = class(TForm)

Memo1: TMemo;

Timer1: TTimer;

Timer2: TTimer;

Timer3: TTimer;

Timer4: TTimer;

procedure FormCreate(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure Timer2Timer(Sender: TObject);

procedure Timer3Timer(Sender: TObject);

procedure FormClose(Sender: TObject; var Action: TCloseAction);

procedure Timer4Timer(Sender: TObject);

private

procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;

procedure WMHotkey( var msg: TWMHotkey ); message WM_HOTKEY;

procedure WMSysCommand(var Msg: TWMSysCommand);message WM_SYSCOMMAND;

procedure WMQUERYENDSESSION(var Msg : TMessage); message WM_QUERYENDSESSION;

public

protected

procedure IsWindowsShutDown(Var Msg:TMessage); message WM_ENDSESSION;

end;

var

Form1 : TForm1;

wndstr2 : string;

clipbrdstr : string;

L1,L2,W1,W2 : TStringList;

далее переходим к секции реализации кода, первая функция получает дату и время наступления регистрируемого события

implementation

{$R *.dfm}

function GET_DT: string;
begin
  Result:= FormatDateTime(‘dd.mm.yy hh.mm.ss’,Now);
end;

implementation

{$R *.dfm}

function GET_DT: string;

begin

Result:= FormatDateTime(‘dd.mm.yy hh.mm.ss’,Now);

end;

далее функции получения текста из буфера обмена, списка процессов, запущенных в системе, списка открытых в системе окон, и имеющихся в системе дисков. Подробно рассматривать не будем функции и процедуры довольно распространенные

function GetClipText : PWideChar;
var
  Data: DWORD;
  StrData: PWideChar;
begin
  Result:= #0;
  if OpenClipboard(0) then
  begin
    Data := GetClipboardData(CF_UNICODETEXT);
    StrData := PWideChar(GlobalLock(Data));
    GlobalUnlock(Data);
    Result := StrData;
    CloseClipboard;
  end;
end;

procedure GetProcessList(Proc: TStrings);
var
  HSnapshot: THandle;
  Pe32: TProcesSentry32;
begin
  Proc.Clear;
  HSnapshot:= CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
  Pe32.DwSize:=SizeOf(TProcesSentry32);
  if (Process32First(HSnapshot,Pe32)) then
  repeat
    Proc.Add(Pe32.SzExeFile);
  until not
    Process32Next(HSnapshot,Pe32);
  CloseHandle(HSnapshot);
end;

procedure Okna(List: TStrings);
var
  Wnd : hWnd;
  buff: array [0..MAX_WINDOW_NAME] of Char;
begin
  List.Clear;
  Wnd := GetWindow(Application.Handle, gw_HWndFirst);
  while Wnd <> 0 do
  begin
    if (Wnd <> Application.Handle)
    and IsWindowVisible(Wnd)
    and (GetWindow(Wnd, gw_Owner) = 0)
    and (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then
    begin
      GetWindowText(Wnd, buff, sizeof(buff));
      if StrPas(buff) <> ‘Program Manager’ then
        List.Add(StrPas(buff));
    end;
    Wnd := GetWindow(Wnd, gw_hWndNext);
  end;
end;

function GetDrive(pDBVol: PDevBroadcastVolume): string;
var
  i: Byte;
  Maske: DWORD;
begin
  Maske := pDBVol^.dbcv_unitmask;
  for i := 0 to 25 do
  begin
    if (Maske and 1)=1 then
      Result:=Char(i+Ord(‘A’))+’:\’;
    Maske:=Maske shr 1;
  end;
end;

function GetClipText : PWideChar;

var

Data: DWORD;

StrData: PWideChar;

begin

Result:= #0;

if OpenClipboard(0) then

begin

Data := GetClipboardData(CF_UNICODETEXT);

StrData := PWideChar(GlobalLock(Data));

GlobalUnlock(Data);

Result := StrData;

CloseClipboard;

end;

procedure GetProcessList(Proc: TStrings);

var

HSnapshot: THandle;

Pe32: TProcesSentry32;

begin

Proc.Clear;

HSnapshot:= CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);

Pe32.DwSize:=SizeOf(TProcesSentry32);

if (Process32First(HSnapshot,Pe32)) then

repeat

Proc.Add(Pe32.SzExeFile);

until not

Process32Next(HSnapshot,Pe32);

CloseHandle(HSnapshot);

end;

procedure Okna(List: TStrings);

var

Wnd : hWnd;

buff: array [0..MAX_WINDOW_NAME] of Char;

begin

List.Clear;

Wnd := GetWindow(Application.Handle, gw_HWndFirst);

while Wnd <> 0 do

begin

if (Wnd <> Application.Handle)

and IsWindowVisible(Wnd)

and (GetWindow(Wnd, gw_Owner) = 0)

and (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then

begin

GetWindowText(Wnd, buff, sizeof(buff));

if StrPas(buff) <> ‘Program Manager’ then

List.Add(StrPas(buff));

end;

Wnd := GetWindow(Wnd, gw_hWndNext);

end;

function GetDrive(pDBVol: PDevBroadcastVolume): string;

var

i: Byte;

Maske: DWORD;

begin

Maske := pDBVol^.dbcv_unitmask;

for i := 0 to 25 do

begin

if (Maske and 1)=1 then

Result:=Char(i+Ord(‘A’))+’:\‘;

Maske:=Maske shr 1;

end;

теперь пригодятся (но не обязательны) 3 горячие клавиши, а именно: показать и скрыть окно программы и сохранить записанную информацию в текстовый файл

procedure TForm1.WMHotkey( var msg: TWMHotkey );
begin
  if msg.hotkey = 1 then
  begin
    Application.ShowMainForm:= true;
    Form1.Show;
  end;
  if msg.hotkey = 2 then
  begin
    Form1.Hide;
    Application.ShowMainForm:= false;
    Form1.Hide;
  end;
  if msg.hotkey = 3 then
  begin
    // Создание папки лог
    try
      if not DirectoryExists(ExtractFilePath(ParamStr(0))+’log’) then
        CreateDir(ExtractFilePath(ParamStr(0))+’log’);
      Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+’log\’+GET_DT+’.txt’);
      Memo1.Clear;
    except
    end;
  end;
end;

procedure TForm1.WMHotkey( var msg: TWMHotkey );

begin

if msg.hotkey = 1 then

begin

Application.ShowMainForm:= true;

Form1.Show;

end;

if msg.hotkey = 2 then

begin

Form1.Hide;

Application.ShowMainForm:= false;

Form1.Hide;

end;

if msg.hotkey = 3 then

begin

// Создание папки лог

try

if not DirectoryExists(ExtractFilePath(ParamStr(0))+‘log’) then

CreateDir(ExtractFilePath(ParamStr(0))+‘log’);

Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+‘log\’+GET_DT+’.txt‘);

Memo1.Clear;

except

end;

теперь добавляем процедуру записи в поле мемо информации об изменениях в конфигурации дисков в системе (подключение и отключение)

procedure TForm1.WMDeviceChange(var Msg: TMessage);
var
  Drive : string;
begin
  case Msg.wParam of
    DBT_DeviceArrival:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        Memo1.Lines.Add(GET_DT+’ — Вставлен диск ‘+Drive);
      end;
    DBT_DeviceRemoveComplete:
      if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then
      begin
        Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));
        Memo1.Lines.Add(GET_DT+’ — Вынут диск ‘+Drive);
      end;
  end;
end;

procedure TForm1.WMDeviceChange(var Msg: TMessage);

var

Drive : string;

begin

case Msg.wParam of

DBT_DeviceArrival:

if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then

begin

Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));

Memo1.Lines.Add(GET_DT+‘ — Вставлен диск ‘+Drive);

end;

DBT_DeviceRemoveComplete:

if PDevBroadcastHdr(Msg.lParam)^.dbcd_devicetype = DBT_DevTyp_Volume then

begin

Drive := GetDrive(PDevBroadcastVolume(Msg.lParam));

Memo1.Lines.Add(GET_DT+‘ — Вынут диск ‘+Drive);

end;

далее приведена процедура записывающая информацию о выключении компьютера

procedure TForm1.IsWindowsShutDown(var Msg: TMessage);
begin
  inherited;
  if Msg.WParam = 1 then
  begin
    Memo1.Lines.Add(GET_DT+’ — Выключение компьютера’);
    // Создание папки лог
    if not DirectoryExists(ExtractFilePath(ParamStr(0))+’log’) then
      CreateDir(ExtractFilePath(ParamStr(0))+’log’);
    try
      Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+’log\’+GET_DT+’.txt’);
    except
    end;
    Close;
  end;
end;

procedure TForm1.IsWindowsShutDown(var Msg: TMessage);

begin

inherited;

if Msg.WParam = 1 then

begin

Memo1.Lines.Add(GET_DT+‘ — Выключение компьютера’);

// Создание папки лог

if not DirectoryExists(ExtractFilePath(ParamStr(0))+‘log’) then

CreateDir(ExtractFilePath(ParamStr(0))+‘log’);

try

Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+‘log\’+GET_DT+’.txt‘);

except

end;

Close;

end;

далее процедура установки стартовых параметров при запуске программы. Скрытие окна программы, горячие клавиши, создание папки для записи логов, создание строковых листов, и получение стартовых данных

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.ShowMainForm:= false;
  clipbrdstr:= GetClipText;
  // Горячие клавиши
  RegisterHotkey(Handle,1,MOD_ALT or MOD_SHIFT,VK_F1);
  RegisterHotkey(Handle,2,MOD_ALT or MOD_SHIFT,VK_F2);
  RegisterHotkey(Handle,3,MOD_ALT or MOD_SHIFT,VK_F3);
  // Создание папки лог
  if not DirectoryExists(ExtractFilePath(ParamStr(0))+’log’) then
    CreateDir(ExtractFilePath(ParamStr(0))+’log’);
  // информирование о запуске
  Memo1.Lines.Add(GET_DT+’ — Запуск программы под пользователем ‘+GetEnvironmentVariable(‘USERNAME’));
  // создание листов слежения
  L1:= TStringList.Create;
  L2:= TStringList.Create;
  L1.Sorted:= true;
  L2.Sorted:= true;
  GetProcessList(L1);
  GetProcessList(L2);
  W1:= TStringList.Create;
  W2:= TStringList.Create;
  W1.Sorted:= true;
  W2.Sorted:= true;
  // первый снимок окон
  Okna(W1);
  Okna(W2);
  // установка таймера сохранения лога
  Timer3.Interval:= 1000 * 60 * 15;
end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Application.ShowMainForm:= false;

clipbrdstr:= GetClipText;

// Горячие клавиши

RegisterHotkey(Handle,1,MOD_ALT or MOD_SHIFT,VK_F1);

RegisterHotkey(Handle,2,MOD_ALT or MOD_SHIFT,VK_F2);

RegisterHotkey(Handle,3,MOD_ALT or MOD_SHIFT,VK_F3);

// Создание папки лог

if not DirectoryExists(ExtractFilePath(ParamStr(0))+‘log’) then

CreateDir(ExtractFilePath(ParamStr(0))+‘log’);

// информирование о запуске

Memo1.Lines.Add(GET_DT+‘ — Запуск программы под пользователем ‘+GetEnvironmentVariable(‘USERNAME’));

// создание листов слежения

L1:= TStringList.Create;

L2:= TStringList.Create;

L1.Sorted:= true;

L2.Sorted:= true;

GetProcessList(L1);

GetProcessList(L2);

W1:= TStringList.Create;

W2:= TStringList.Create;

W1.Sorted:= true;

W2.Sorted:= true;

// первый снимок окон

Okna(W1);

Okna(W2);

// установка таймера сохранения лога

Timer3.Interval:= 1000 * 60 * 15;

end;

теперь процедура мониторинга окон, по таймеру получается список открытых окон, сохраняется в память как архивный список, по таймеру получается следующих, списки сортируются и сравниваются и если они различны, различия записываются в поле мемо, далее новый список записывается в архивный и процедура повторяется циклично

procedure TForm1.Timer1Timer(Sender: TObject);
var
  Wnd  : HWND;
  buff : array [0..MAX_WINDOW_NAME] of Char;
begin
  try
    W1.Clear;
    Wnd := GetWindow(Application.Handle, GW_HWNDFIRST);
    while Wnd <> 0 do
    begin
      if (Wnd <> Application.Handle) and IsWindowVisible(Wnd) and (GetWindow(Wnd, GW_OWNER) = 0) and (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then
      begin
        GetWindowText(Wnd, buff, sizeof(buff));
        if (LowerCase(StrPas(buff)) <> ‘progman’) and
        (LowerCase(StrPas(buff)) <> ‘prog man’) and
        (LowerCase(StrPas(buff)) <> ‘program manager’) then
          W1.Add(‘[‘+StrPas(buff)+’]’);
      end;
      Wnd := GetWindow(Wnd, gw_hWndNext);
    end;
    if (W1.Text <> W2.Text) and (W1.Count <> 0) then
    begin
      // Открылось
      if (W1.Count > W2.Count) then
      begin
        Memo1.Lines.Add(GET_DT+’ — Открытие окон’+#13#10+W1.Text);
        W2.Text := W1.Text;
        Exit;
      end;
      //Закрылось
      if (W1.Count < W2.Count) then
      begin
        Memo1.Lines.Add(GET_DT+’ — Закрытие окон’+#13#10+W1.Text);
        W2.Text := W1.Text;
        Exit;
      end;
      // Изменения
      if (W1.Count = W2.Count) then
      begin
        Memo1.Lines.Add(GET_DT+’ — Изменения окон’+#13#10+W1.Text);
        W2.Text := W1.Text;
        Exit;
      end;
    end;
  except
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);

var

Wnd : HWND;

buff : array [0..MAX_WINDOW_NAME] of Char;

begin

try

W1.Clear;

Wnd := GetWindow(Application.Handle, GW_HWNDFIRST);

while Wnd <> 0 do

begin

if (Wnd <> Application.Handle) and IsWindowVisible(Wnd) and (GetWindow(Wnd, GW_OWNER) = 0) and (GetWindowText(Wnd, buff, sizeof(buff)) <> 0) then

begin

GetWindowText(Wnd, buff, sizeof(buff));

if (LowerCase(StrPas(buff)) <> ‘progman’) and

(LowerCase(StrPas(buff)) <> ‘prog man’) and

(LowerCase(StrPas(buff)) <> ‘program manager’) then

W1.Add(‘[‘+StrPas(buff)+‘]’);

end;

Wnd := GetWindow(Wnd, gw_hWndNext);

end;

if (W1.Text <> W2.Text) and (W1.Count <> 0) then

begin

// Открылось

if (W1.Count > W2.Count) then

begin

Memo1.Lines.Add(GET_DT+‘ — Открытие окон’+#13#10+W1.Text);

W2.Text := W1.Text;

Exit;

end;

//Закрылось

if (W1.Count < W2.Count) then

begin

Memo1.Lines.Add(GET_DT+‘ — Закрытие окон’+#13#10+W1.Text);

W2.Text := W1.Text;

Exit;

end;

// Изменения

if (W1.Count = W2.Count) then

begin

Memo1.Lines.Add(GET_DT+‘ — Изменения окон’+#13#10+W1.Text);

W2.Text := W1.Text;

Exit;

end;

except

end;

далее аналогичным образом получается и анализируется список процессов

procedure TForm1.Timer2Timer(Sender: TObject);
var
  i,j : integer;
begin
  try
    GetProcessList(L1);
    if L1.Text <> L2.Text then
    begin
      if L1.Count = 0 then
        Memo1.Lines.Add(GET_DT+’ — Завершён — ‘+L2.Strings[0]);
      if L2.Count = 0 then
        Memo1.Lines.Add(GET_DT+’ — Запущен — ‘+L1.Strings[0]);
      //Запустилось
      if (l1.Count > l2.Count) and (l1.Count <> 0) and (l2.Count <> 0) then
      begin
        j:=0;
        for i:=0 to L1.Count — 2 do
        if L1.Strings[i] <> L2.Strings[i] then
        begin
          Memo1.Lines.Add(GET_DT+’ — Запущен — ‘+L1.Strings[i]);
          inc(j);
          break;
        end;
        if j = 0 then
          Memo1.Lines.Add(GET_DT+’ — Запущен — ‘+L1.Strings[L1.Count — 1]);
      end;
      //Завершилось
      if (l1.Count < l2.Count) and (l1.Count <> 0) and (l2.Count <> 0) then
      begin
        j:=0;
        for i:=0 to L2.Count — 2 do
        if L2.Strings[i] <> L1.Strings[i] then
        begin
          Memo1.Lines.Add(GET_DT+’ — Завершён — ‘+L2.Strings[i]);
          inc(j);
          break;
        end;
        if j = 0 then
          Memo1.Lines.Add(GET_DT+’ — Завершён — ‘+L2.Strings[L2.Count — 1]);
      end;
    end;
    L2.Text := L1.Text;
  except
  end;
end;

procedure TForm1.Timer2Timer(Sender: TObject);

var

i,j : integer;

begin

try

GetProcessList(L1);

if L1.Text <> L2.Text then

begin

if L1.Count = 0 then

Memo1.Lines.Add(GET_DT+‘ — Завершён — ‘+L2.Strings[0]);

if L2.Count = 0 then

Memo1.Lines.Add(GET_DT+‘ — Запущен — ‘+L1.Strings[0]);

//Запустилось

if (l1.Count > l2.Count) and (l1.Count <> 0) and (l2.Count <> 0) then

begin

j:=0;

for i:=0 to L1.Count — 2 do

if L1.Strings[i] <> L2.Strings[i] then

begin

Memo1.Lines.Add(GET_DT+‘ — Запущен — ‘+L1.Strings[i]);

inc(j);

break;

end;

if j = 0 then

Memo1.Lines.Add(GET_DT+‘ — Запущен — ‘+L1.Strings[L1.Count — 1]);

end;

//Завершилось

if (l1.Count < l2.Count) and (l1.Count <> 0) and (l2.Count <> 0) then

begin

j:=0;

for i:=0 to L2.Count — 2 do

if L2.Strings[i] <> L1.Strings[i] then

begin

Memo1.Lines.Add(GET_DT+‘ — Завершён — ‘+L2.Strings[i]);

inc(j);

break;

end;

if j = 0 then

Memo1.Lines.Add(GET_DT+‘ — Завершён — ‘+L2.Strings[L2.Count — 1]);

end;

L2.Text := L1.Text;

except

end;

по следующей процедуре по событию таймера (по таймеру) происходит сохранение полученных выше данных, при условии их накопления в определенном количестве. Так называемый сброс в лог по таймеру.

procedure TForm1.Timer3Timer(Sender: TObject);
begin
  try
    if Memo1.Lines.Count >= 222 then
    begin
      // Создание папки лог
      if not DirectoryExists(ExtractFilePath(ParamStr(0))+’log’) then
        CreateDir(ExtractFilePath(ParamStr(0))+’log’);
      try
        Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+’log\’+GET_DT+’.txt’);
        Memo1.Clear;
      except
      end;
    end;
  except
  end;
end;

procedure TForm1.Timer3Timer(Sender: TObject);

begin

try

if Memo1.Lines.Count >= 222 then

begin

// Создание папки лог

if not DirectoryExists(ExtractFilePath(ParamStr(0))+‘log’) then

CreateDir(ExtractFilePath(ParamStr(0))+‘log’);

try

Memo1.Lines.SaveToFile(ExtractFilePath(ParamStr(0))+‘log\’+GET_DT+’.txt‘);

Memo1.Clear;

except

end;

except

end;

еще один таймер следит за буфером обмена

procedure TForm1.Timer4Timer(Sender: TObject);
begin
  if length(GetClipText) > MAX_WINDOW_NAME then Exit;
  if GetClipText <> clipbrdstr then
  begin
    Memo1.Lines.Add(GET_DT+’ — буфер обмена изменен <‘+GetClipText+’>’);
    clipbrdstr := GetClipText;
  end;
end;

procedure TForm1.Timer4Timer(Sender: TObject);

begin

if length(GetClipText) > MAX_WINDOW_NAME then Exit;

if GetClipText <> clipbrdstr then

begin

Memo1.Lines.Add(GET_DT+‘ — буфер обмена изменен <‘+GetClipText+‘>’);

clipbrdstr := GetClipText;

end;

далее идет процедура отключения горячих клавиш

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  UnRegisterHotkey(Handle,1);
  UnRegisterHotkey(Handle,2);
  UnRegisterHotkey(Handle,3);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

UnRegisterHotkey(Handle,1);

UnRegisterHotkey(Handle,2);

UnRegisterHotkey(Handle,3);

end;

ну вот собственно и всё, основная идея изложена. Программу можно добавить в автозапуск, она будет мониторить события в системе в скрытом режиме. Подобный функционал реализован, например, в программе Infowatch и возможно других программах. Но теперь у нас есть собственная разработка для мониторинга событий системы. Данный код можно дополнить другими необходимыми функциями.

Опубликовано

14.01.2024

Компьютеры, Программирование

Изменено

08.09.2024

stepanov.es

Метки:

delphi, запись действий пользователя