Создание службы мониторинга
Хочу написать службу, которая будет делать скрины, когда система в работе. В обычном приложении проблем нет, а вот в службе полный разнос.
procedure Tsc.MakeScreen;
var
Path: String;
ScreenDC: HDC;
Image: TImage;
Canvas: TCanvas;
JPG: TJPEGImage;
begin
Path := 'путь';
if not TDirectory.Exists(Path) then TDirectory.CreateDirectory(Path);
ScreenDC := GetDC(0);
Image := TImage.Create(nil);
Canvas := TCanvas.Create;
Canvas.Handle := ScreenDC;
Image.Width := Screen.Width;
Image.Height := Screen.Height;
Image.Canvas.CopyRect(Rect(0, 0, Image.Width, Image.Height), Canvas, Rect(0, 0, Screen.Width, Screen.Height));
ReleaseDC(0, ScreenDC);
JPG := TJPEGImage.Create;
JPG.Assign(Image.Picture.Bitmap);
JPG.CompressionQuality := 100; // Устанавливаем параметры качества. Должно быть от 1 до 100. Если 100, то качество наилучшее, 1 наихудшее
JPG.Compress; // Производим сжатие данных картинки
// Запись без прав Администратора будет выдавать ошибку в местах где они нужны (Program Files и т.д.)
try
JPG.SaveToFile(Path + '\' + FormatDateTime('yyyymmdd_hhmmss', Now) + '.jpg');
except
end;
FreeAndNil(Image);
FreeAndNil(Canvas);
FreeAndNil(JPG);
end;
Создаёт скрины на которых пустота
function LastInput: DWord;
var
LInput: TLastInputInfo;
begin
LInput.cbSize := SizeOf(TLastInputInfo);
GetLastInputInfo(LInput);
Result := (GetTickCount - LInput.dwTime) div 1000;
end;
Отлов события занятости системы тоже не работает