Einzelnen Beitrag anzeigen

Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.538 Beiträge
 
Delphi 11 Alexandria
 
#1

Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 02:18
Bis Windows XP konnte man ja auch den aktuellen Inputdesktop auslesen, wenn das Programm als Service (Dienst) ausgeführt wurde. Zumindest dann, wenn es ein interaktiver Dienst war, dem man also die Kommunikation mit dem Desktop erlaubt.

Seit Vista können Meldungen des interaktiven Dienstes nicht mehr auf dem normalen Input Desktop ausgegeben werden, Windows gibt dann eine Info aus, dass eine Meldung vorliegt, die kann man sich dann in einem extra Fenster ansehen.

Leider ist aber anscheinend auch das auslesen des Desktops nicht mehr erlaubt, wenn das Programm als Dienst läuft.

Oder gibt es eine Variante, wie das doch noch möglich ist?

Der einzige WorkAround, der mir hierzu einfällt wäre, dass der Dienst, wenn ein User-Desktop aktiv ist ein Programm startet, welches dann - anstatt des Dienstes - den Bildschirminhalt zum Client überträgt.

Auf diese Extra-Schleife würde ich aber gerne verzichten.

Ein Auszug aus dem Code, der bis Windows XP noch funktionierte:

Delphi-Quellcode:

function hs_GetInputDesktop: String;
var
  hd: HDESK;
  szb: Array [0..80] of char;
  needed: DWord;
begin
  hd := OpenInputDesktop (0, false,
      DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
      DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
      DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
      DESKTOP_JOURNALPLAYBACK or DESKTOP_JOURNALRECORD or
      DESKTOP_SWITCHDESKTOP or GENERIC_WRITE);

  if hd = 0 then begin
    Result := '';
  end else begin
    if GetUserObjectInformation (hd, UOI_NAME, @szb, SizeOf(szb), needed) then begin
      Result := (String (szb));
    end else begin
      Result := '';
    end;
  end;

  if hd <> 0 then begin
    CloseDesktop (hd);
  end;
end;

function hs_GetThreadDesktop (TID: DWord): String;
var
  hd: HDESK;
  szb: Array [0..80] of char;
  needed: DWord;
begin
  hd := GetThreadDesktop (TID);

  if hd = 0 then begin
    Result := '';
  end else begin
    if GetUserObjectInformation (hd, UOI_NAME, @szb, SizeOf(szb), needed) then begin
      Result := String (szb);
    end else begin
      Result := '';
    end;
  end;
end;

procedure TWatchThread.Execute;
// Diese Funktion kopiert den aktuellen Bildschirminhalt in
// ein bitmap, aber ressorcenschonend
var
  aHDC: HDC;
  i, c, L, al: Integer;
  hd, hd_old: HDESK;
  dtw: THandle;
begin
  cs.enter;
  hd_Old := 0;

  if hs_RunAsService then begin
    hd_old := GetThreadDeskTop (GetCurrentThreadID);

    // Das funktioniert nur noch bis Windows XP
    if hs_GetInputDesktop <> hs_GetThreadDesktop (GetCurrentThreadID) then begin
      if hs_GetInputDesktop = 'Winlogonthen begin
        hd := OpenDesktop ('Winlogon', 0, false,
        DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
        DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
        DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
        DESKTOP_JOURNALPLAYBACK or DESKTOP_JOURNALRECORD or
        DESKTOP_SWITCHDESKTOP or GENERIC_WRITE);

        if hd <> 0 then begin
          if SetThreadDesktop (hd) then begin
          end;
        end;
      end else begin
        hd := OpenInputDesktop (0, false,
        DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
        DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
        DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
        DESKTOP_JOURNALPLAYBACK or DESKTOP_JOURNALRECORD or
        DESKTOP_SWITCHDESKTOP or GENERIC_WRITE);

        if hd <> 0 then begin
          if SetThreadDesktop (hd) then begin
          end;
        end else begin
          // Desktop konnte nicht geholt werden
        end;
      end;
    end;
  end else begin
    hd := OpenInputDesktop (0, false,
      DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or
      DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or
      DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or
      DESKTOP_JOURNALPLAYBACK or DESKTOP_JOURNALRECORD or
      DESKTOP_SWITCHDESKTOP or GENERIC_WRITE);

    if hd = 0 then begin
      if (GetOsName = 'Windows Vista')
      or (GetOsName = 'Windows Seven')
      or (GetOsName = 'Windows Eight')
      or (GetOsName = 'Windows Ten')

      then begin
        // UAC-Fenster ist Aktiv
      //Client informieren.
     ...
   end;
   //... Hier Bildschirminhalt kopieren und zum Client transferieren
end;
  Mit Zitat antworten Zitat