Hallo Leute,
ich stehe vor dem Problem einen Screenshot des aktuell angemeldeten Benutzer (nur Workstation an Console, kein RDP oder Terminalserver) aus einem TService heraus zu machen. Komme aber mit meinem Wissen nicht so recht weiter und brauch eure Unterstützung.
Folgendes habe ich bereits zusammengesucht um auf dem lokalen Desktop zu kommen (und hoffe, dass das soweit korrekt ist).
Delphi-Quellcode:
function TScreenCapture.GetScreenBitmap(bmp:
Vcl.Graphics.TBitmap; lpszWinSta: PWideChar): Boolean;
var
hDeskCurrent: HDESK;
hdesk1: HDESK;
hwinstaCurrent: HWINSTA;
hwinsta1: HWINSTA;
Canvas: TCanvas;
r: TRect;
begin
hwinstaCurrent:=GetProcessWindowStation;
if hwinstaCurrent<>0
then
begin
hwinsta1:=OpenWindowStation(lpszWinSta, False,
WINSTA_ACCESSCLIPBOARD
or
WINSTA_ACCESSGLOBALATOMS
or
WINSTA_CREATEDESKTOP
or
WINSTA_ENUMDESKTOPS
or
WINSTA_ENUMERATE
or
WINSTA_EXITWINDOWS
or
WINSTA_READATTRIBUTES
or
WINSTA_READSCREEN
or
WINSTA_WRITEATTRIBUTES);
if hwinsta1<>0
then
begin
if SetProcessWindowStation(hwinsta1)
then
begin
hdesk1:=OpenDesktop('
default', 0, False,
DESKTOP_CREATEMENU
or
DESKTOP_CREATEWINDOW
or
DESKTOP_ENUMERATE
or
DESKTOP_HOOKCONTROL
or
DESKTOP_JOURNALPLAYBACK
or
DESKTOP_JOURNALRECORD
or
DESKTOP_READOBJECTS
or
DESKTOP_SWITCHDESKTOP
or
DESKTOP_WRITEOBJECTS);
// Hier Screenshot machen
if SetThreadDesktop(hdesk1)
then
begin
Canvas := TCanvas.Create;
try
Canvas.Handle:=GetWindowDC(hdesk1);
try
//GetWindowRect(Canvas.Handle, r);
bmp.Width:=Screen.Width;
bmp.Height:=Screen.Height;
bmp.PixelFormat:=pfDevice;
BitBlt(bmp.Canvas.Handle, 0, 0, Pred(bmp.Width),
Pred(bmp.Height), Canvas.Handle, 0,
0, SRCCOPY);
finally
ReleaseDC(0, Canvas.Handle);
end;
finally
Canvas.Free;
end;
end;
CloseDesktop(hdesk1);
end;
end;
end;
end;
Aufruf:
Delphi-Quellcode:
bmp:=
Vcl.Graphics.TBitmap.Create;
try
try
GetScreenBitmap(bmp, '
WinSta0');
except
DoLastError(GetLastError);
end;
bmp.SaveToFile(FPath+'
bmp.bmp');
finally
bmp.Free;
end;
Soweit so gut. Diese Funktion lasse ich in einem Thread laufen (Source hängt an).
Wenn ich das über eine TApplication, also über den Benutzercontext, laufen lassen, bekomme ich auch eine Bitmap. Allerdings ist diese weiß.
Lass ich das über ein TService laufen, bekomme ich ebenfalls eine weiße Bitmap. Zusätzlich tritt bei Screen.Width, bei Screen.Height oder beim BitBlt (und wenn ich es drin lasse auch beim GetWindowRect) ein Windows-Fehler 1400 auf.
Irgendwas mache ich wohl grundsätzlich falsch. Ich bin mir auch nicht sicher, ob ich aus einem TService auf Screen zugreifen kann. Wär nett, wenn sich das mal jemand anschauen könnte.
Vielen Dank