Создание службы мониторинга

Хочу написать службу, которая будет делать скрины, когда система в работе. В обычном приложении проблем нет, а вот в службе полный разнос.

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;

Отлов события занятости системы тоже не работает


Ответы (0 шт):