В новом году открываю новую рубрику — код месяца! В этом цикле статей ежемесячно буду публиковать свои коды различных программ и модулей на языке программирования Delphi под систему Windows.
В январе рассмотрим пример написания программы мониторинга действий пользователя в операционной системе семейства Windows. Программа записывает в лог файл мониторинг запуска программ (процессов), открытия окон, буфера обмена, открытия страниц интернета, подключения съемных устройств, включение и выключение компьютера.
Ну что ж начнем, для написания данной программы понадобится создать стандартное окно формы, добавить на него 4 таймера и 1 поле мемо, в uses необходимо помимо стандартных модулей подключить TlHelp32, PsAPI для работы с процессами
|
1 2 3 4 5 6 7 |
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, TlHelp32, PsAPI; |
далее понадобится добавить типы данных для мониторинга дисков
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 |
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 строковых листа для хранения и сравнивания полученных данных.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 |
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; |
далее переходим к секции реализации кода, первая функция получает дату и время наступления регистрируемого события
|
1 2 3 4 5 6 7 8 |
implementation {$R *.dfm} function GET_DT: string; begin Result:= FormatDateTime(‘dd.mm.yy hh.mm.ss’,Now); end; |
далее функции получения текста из буфера обмена, списка процессов, запущенных в системе, списка открытых в системе окон, и имеющихся в системе дисков. Подробно рассматривать не будем функции и процедуры довольно распространенные
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 |
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; |
теперь пригодятся (но не обязательны) 3 горячие клавиши, а именно: показать и скрыть окно программы и сохранить записанную информацию в текстовый файл
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
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; |
теперь добавляем процедуру записи в поле мемо информации об изменениях в конфигурации дисков в системе (подключение и отключение)
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
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; |
далее приведена процедура записывающая информацию о выключении компьютера
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
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; |
далее процедура установки стартовых параметров при запуске программы. Скрытие окна программы, горячие клавиши, создание папки для записи логов, создание строковых листов, и получение стартовых данных
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 |
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; |
теперь процедура мониторинга окон, по таймеру получается список открытых окон, сохраняется в память как архивный список, по таймеру получается следующих, списки сортируются и сравниваются и если они различны, различия записываются в поле мемо, далее новый список записывается в архивный и процедура повторяется циклично
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 |
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; |
далее аналогичным образом получается и анализируется список процессов
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
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; |
по следующей процедуре по событию таймера (по таймеру) происходит сохранение полученных выше данных, при условии их накопления в определенном количестве. Так называемый сброс в лог по таймеру.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
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; |
еще один таймер следит за буфером обмена
|
1 2 3 4 5 6 7 8 9 |
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; |
далее идет процедура отключения горячих клавиш
|
1 2 3 4 5 6 |
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin UnRegisterHotkey(Handle,1); UnRegisterHotkey(Handle,2); UnRegisterHotkey(Handle,3); end; |
ну вот собственно и всё, основная идея изложена. Программу можно добавить в автозапуск, она будет мониторить события в системе в скрытом режиме. Подобный функционал реализован, например, в программе Infowatch и возможно других программах. Но теперь у нас есть собственная разработка для мониторинга событий системы. Данный код можно дополнить другими необходимыми функциями.
Добавить комментарий