AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Dienst: Aktuellen Inputdesktop auslesen
Thema durchsuchen
Ansicht
Themen-Optionen

Dienst: Aktuellen Inputdesktop auslesen

Ein Thema von Harry Stahl · begonnen am 8. Jul 2015 · letzter Beitrag vom 12. Jul 2015
Antwort Antwort
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
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.648 Beiträge
 
Delphi 11 Alexandria
 
#2

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 06:41
Das geht per Definition nicht mehr. Aus Sicherheitsgründen.

Ein Programm im Benutzerkontext, das die Daten anzeigt, ist genau das richtige. Wir benutzen dafür eine Webseite. Im Dienst ist dafür ein Datasnap Server integriert.

Das hat auch den Vorteil, dass sich der Dienst voll auf die Daten konzentrieren kann und keine GUI-Logik mehr benötigt.
Sebastian Jänicke
AppCentral
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

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

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 17:42
Ja, das hatte ich befürchtet.

Gerade mal getestet, wenn das Serverprogramm als Dienst läuft, dann kann ich zwar mit dem Dienst Dateien auf dem Rechner kopieren, löschen, umbenennen etc. aber nicht ausführen?

ShellExecute scheint dann nicht zu funktionieren?

Wie starte ich dann mit dem Dienst ein GUI-Programm im gerade aktuellen User-Kontext? Auf einen Input-Desktop kann ich ja mit dem Dienst nicht wechseln.
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#4

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 17:47
Ha, genau damit habe ich mich letztens auch rumgeschlagen. Es geht. Man muss auch nicht bei jedem Wechsel eine neue Instanz starten, obwohl es viele Programme gibt, die es genau so machen.

Es ist aber auch tatsächlich immer noch möglich (zumindest unter Windows 7), GUI-Prozesse mit System-Rechten laufen zu lassen. Auch wenn Microsoft das extrem verschleiert (aus gutem Grund).

Man braucht nur (*) einen Dienst, der das Programm einmal am Anfang mit System-Rechten startet. Wenn das Programm mit System-Rechten erst mal läuft, dann klappt auch das Wechseln des Desktops wieder.

Hier mal meine Funktion zum Starten eines Prozesses mit System-Rechten (das Ergebnis von mehreren Tagen Recherche):
Delphi-Quellcode:
function CreateElevatedUserProcess(ProcessPath: String; ProcessArgs: String; out Log: String): Boolean;
var
  OwnToken: HANDLE;
  NewToken: HANDLE;
  SecurityAttributes: SECURITY_ATTRIBUTES;
  SessId: DWORD;
  UiAccess: DWORD;
  CommandLine: String;
  StartupInfo: TSTARTUPINFO;
  ProcessInformation: PROCESS_INFORMATION;
begin
  Log := 'OpenProcessToken';
  Result := OpenProcessToken(GetCurrentProcess,
    TOKEN_ALL_ACCESS or TOKEN_ADJUST_SESSIONID,
    @OwnToken);
  if not Result then exit;

  SecurityAttributes.nLength := sizeof(SecurityAttributes);
  SecurityAttributes.bInheritHandle := TRUE;
  SecurityAttributes.lpSecurityDescriptor := nil;

  Log := 'DuplicateTokenEx';
  Result := DuplicateTokenEx(
    OwnToken,
    MAXIMUM_ALLOWED,
    @SecurityAttributes,
    SecurityImpersonation,
    TokenPrimary,
    @NewToken);
  if not Result then exit;

  Log := 'WTSGetActiveConsoleSessionId';
  SessID := WTSGetActiveConsoleSessionId;

  Log := 'SetTokenInformation (TokenSessionId)';
  Result := SetTokenInformation(NewToken, TokenSessionId, @SessId, sizeof(SessId));
  if not Result then exit;

  UiAccess := 1;
  Log := 'SetTokenInformation (UiAccess)';
  Result := SetTokenInformation(NewToken, TokenUIAccess, @UiAccess, sizeof(UiAccess));
  if not Result then exit;

  FillChar(StartupInfo, sizeof(StartupInfo), 0);
  StartupInfo.wShowWindow := SW_SHOWDEFAULT;
  StartupInfo.lpDesktop := 'winsta0\Default';

  CommandLine := '"' + ProcessPath + '"' + ' ' + ProcessArgs;
  Log := 'CreateProcessAsUser';
  Result := CreateProcessAsUser(
    NewToken,
    LPCTSTR(ProcessPath),
    LPTSTR(CommandLine),
    @SecurityAttributes,
    @SecurityAttributes,
    FALSE,
    0,
    nil,
    nil,
    @StartupInfo,
    @ProcessInformation);

end;
Aber bitte mit Vorsicht genießen!

Du könntest dich bei mir revanchieren, indem du mal testest, ob das ganze unter Windows 8 und Windows 10 auch noch funktioniert . Habe es bisher nur unter Windows 7 getestet.

Edit:
(*) Achja, es gibt noch ein paar Dinge zu beachten. Programm und Dienst (?) müssen digital signiert sein und in einem „sicheren“ Ordner liegen. Andernfalls wird der Start verweigert. Ein „sicherer“ Ordner ist z.B. „C:\Programme“. Sind noch mal zusätzliche Hürden von Microsoft.

Geändert von Namenloser ( 8. Jul 2015 um 18:18 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

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

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 19:42
Hey, da hab ich ja echt Glück gehabt!

Klappt auch, insofern schon mal vielen Dank!

Und hier die erste Rückmeldung: Funktioniert auch unter Windows 8.1. Dabei war der Dienst noch nicht mal signiert und lag auch nicht in einem geschützten Bereich (in der installierten Version wird beides aber der Fall sein, insofern ist es egal, ob diese Anforderungen nun letztlich gegeben sein müssen oder nicht).

Zu Windows 10 gebe ich später noch eine Rückmeldung.
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

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

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 20:03
Vielleicht noch eine Nachfrage:

Wie bekommt mein Service jetzt eigentlich mit, dass gerade kein Anmelde- oder Gespert-Desktop angezeigt wird, bzw. dass jetzt ein User-Desktop aktiv ist.

Alle Anfragen zur Windows-Station liefern zu jeder Zeit leider nur "Service-0x0-3e7$" zurück.

Ein "InputDesktop" steht ja nicht zur Verfügung, anhand dessen ich einen Wechsel des Desktops testen könnte.
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#7

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 20:18
Das müsstest du aus dem vom Dienst gestarteten Prozess heraus machen. Der Dienst selbst hat keinen Zugriff darauf.

Kann sein, dass das mit der Signatur und dem sicheren Ort doch nur für den gestarteten Prozess gilt und nicht für den Dienst. Deswegen hatte ich auch hinter Dienst ein Fragezeichen gesetzt. Aber wenn man schon den Prozess signiert, kann man den Dienst ja gleich auch signieren.

Geändert von Namenloser ( 8. Jul 2015 um 20:23 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

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

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 8. Jul 2015, 20:36
Ah ja, habe gerade gesehen, mein Dienst kann das Programm schon starten, auch wenn noch gar keiner am PC angemeldet ist. Nehme an, das geht dann automatisch in den ersten User-Desktop rein.

Und von da aus kann das GUI-Programm dann arbeiten wie sonst auch.

Wobei dann insgesamt nicht mehr so ein riesengroßer Unterschied zum Autostart ist, zumindest wenn sonst eh nur ein User am PC arbeitet.
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.648 Beiträge
 
Delphi 11 Alexandria
 
#9

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 9. Jul 2015, 07:45
Wobei die saubere Lösung dennoch ein komplett eigenständiges Programm wäre, das im Autostart liegen oder vom Benutzer gestartet werden kann.

Ein weiterer Vorteil der Lösung ist, dass man nicht befürchten muss, dass diese in zukünftigen Windowsversionen plötzlich nicht mehr funktioniert...

Und ich persönlich würde eine Lösung, die das anders macht, auch nicht einsetzen. In einer Lösung, die in Firmen zum Einsatz kommt, wäre das z.B. in der Regel ein NoGo.
Sebastian Jänicke
AppCentral
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

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

AW: Dienst: Aktuellen Inputdesktop auslesen

  Alt 12. Jul 2015, 16:52
Das nur mit dem Autostart könnte man machen, wenn man z.B. per Remote einem User (z.B. im Unternehmen) Hilfestellung geben möchte.

Autostart reicht natürlich nicht, wenn ich mich per Remote auf den Login-Desktop schalten muss oder Remote UAC-Abfragen bestätigen muss. Da brauche ich schon den Dienst, der mir das ermöglicht. Man kann mein Programm für beide Fälle einrichten.

Und hier will ich noch die versprochene Info nachzureichen:

Das Abfragen des InputDesktops über einen gestarteten Prozess im Rahmen von UAC-Abfragen oder LogIn-Bildschirme funktioniert unter Vista, Seven, 8.x und Windows 10.

Es funktioniert auch unter Windows Server 2008, leider aber nicht unter Windows Server 2012, da bleibt das gestartete Programm im Kontext des Dienstes (Im WinLogOn-Desktop). Da hat sich dann wohl leider was geändert....
  Mit Zitat antworten Zitat
Antwort Antwort


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 08:04 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz