Messages abfangen als Dienst !

[CReber]

Ich habe heute den Tag über ein Tool programmiert das bestimmte Functions ausführt sobald ein Datenträger irgendwo eingelegt wird usw.. Nun hatte ich die Idee das als Dienst zu programmieren weil das einfach komfortabler für den Anwender ist und da ist mir aufgefallen das ein non-visuelles Programm Windows Messages nicht so einfach abfangen kann! Könnte mir da mal jemand auf die Sprünge helfen? Hab hier schon eine sehr interessante Adresse gefunden aber leider auf engl. sodass ich nicht allzu viel verstehe ;)

http://delphi.about.com/library/weekly/aa093003a.htm

[Chewie]

Bei einem Dienst hast du das Problem, dass dieser in einer anderen WindowStation (frag mich nicht, was das genau ist) läuft und infolgedessen kannst du kein Handle erhalten, an den du eine Windows Message verschicken könntest.

[CReber]

Aber laut delphi.about.com scheint das doch aber möglich zu sein oder?

[SirThornberry]

stopf in deinen service einefach einen server (serversocket etc.) und in dem hook sendest du dann an das port...

[Robert Marquardt]

Mach eine Service-Application (siehe "Neu...") und es sollte gehen.
Es gibt aber genau bei WM_DEVICECHANGE eine zeitliche Luecke wo keine Messages kommen.
Waehrend die Subsysteme wie USB beim Booten initialisiert werden, werden auch schon die
Services gestartet. Es sind noch nicht alle Geraete erkannt und der Service bekommt
entsprechend nicht alle aufgezaehlt. Fuer die folgenden Geraete gibt es kein WM_DEVICECHANGE,
da der Desktop des Benutzers (von dem die Messages kommen) noch nicht eingerichtet ist.

[Chewie]

Ich hatte mal folgende Konstellation: Ein CGI-Programm, das vom Server, der als Dienst lief, gestartet wurde, sendet eine Message an ein Fensterhandle. Ergebnis: Die Nachricht kommt nicht an.
Auch bei einem Broadcast nicht.

Deshalb meine Vermutung, dass Messages zwischen Diensten und "normalen" Anwedungen nicht so ohne weiteres ausgetauscht werden können.

[CReber]

Ich hab das jetzt anders gemacht... Alle 1,5 Sekunden werden alle Laufwerke überprüft ob ein bestimmtes Laufwerk die bestimmte Seriennummer hat... Sollte das nicht der Fall sein -> BlockInput !

Das funktioniert ebenfalls als Anwendung aber nicht als Service ?!?! Langsam bringt mich das echt durcheinander..

[CReber]

Hier ist mal der Quellcode vom Service

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ShellAPI, md5, Registry,
  ExtCtrls;

type
  TUSBAccess = class(TService)
    Timer1: TTimer;
    procedure ServiceCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
    procedure CheckStick;
  public
    function GetServiceController: TServiceController; override;
    { Public-Deklarationen }
  end;

var
  USBAccess: TUSBAccess;

implementation

{$R *.DFM}

function BlockInput (fBlockInput : boolean) : DWord; stdcall; external 'user32.DLL'

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  USBAccess.Controller(CtrlCode);
end;

function TUSBAccess.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

function DriveExists(DriveByte: Byte): Boolean;
begin 
  Result := GetLogicalDrives and (1 shl DriveByte) <> 0; 
end; 

function DriveType(DriveByte: Byte): String; 
begin 
  case GetDriveType(PChar(Chr(DriveByte + Ord('A')) + ':\')) of 
    DRIVE_UNKNOWN: Result := 'unbekannt'; 
    DRIVE_NO_ROOT_DIR: Result := 'Laufwerk existiert nicht'; 
    DRIVE_REMOVABLE: Result := 'Wechseldatenträger'; 
    DRIVE_FIXED: Result := 'Festplatte'; 
    DRIVE_REMOTE: Result := 'Netzwerk'; 
    DRIVE_CDROM: Result := 'CD-ROM/DVD'; 
    DRIVE_RAMDISK: Result := 'RAM Disk'; 
  else
    Result := 'anderer Laufwerkstyp';
  end;
end;

function GetSerialNumber(Drive: PChar): DWord;
var
  FileSysName, VolName: array[0..255] of Char;
  SerialNum, MaxCLength, FileSysFlag: DWORD;
  i : integer;
begin
  GetVolumeInformation(Drive, VolName, 255, @SerialNum, MaxCLength, FileSysFlag, FileSysName, 255);
  Result := SerialNum;
end;

// Wandelt MD5 in String um
function LogEntry(Dig: MD5Digest): string;
begin
   Result := Format('%s', [MD5Print(Dig)]);
end;

procedure TUSBAccess.CheckStick;
var 
  I: Integer;
  check: Boolean;
  res1, drive, md5key, md5key2: string;
  serial: integer;
  regist: TRegistry;
begin
  check:=False;
  regist:=TRegistry.Create;
  regist.RootKey:=HKEY_LOCAL_MACHINE;
  regist.OpenKey('Software\....\.....', true);
  md5key:=regist.ReadString('Key');
  regist.free;
  for I := 0 to 25 do
    begin
      if DriveExists(I) then
        begin
          res1:=Chr(I + Ord('A')) + ':\  (' + DriveType(I) + ')';
          drive:=Copy(res1,1,3);
          serial:=GetSerialNumber(PChar(drive));
          md5key2:=LogEntry(MD5String(IntToStr(serial)));
          if (md5key=md5key2) then
            begin
              BlockInput(false);
              check:=true;
            end;
        end;
    end;
      if check=False then
        begin
          BlockInput(true);
          //LockWorkStation;
        end;
end;

procedure TUSBAccess.ServiceCreate(Sender: TObject);
begin
  USBAccess.CheckStick;
end;

procedure TUSBAccess.Timer1Timer(Sender: TObject);
begin
  USBAccess.CheckStick;
end;

end.

[Robert Marquardt]

Der Dienst muss ein interaktiver Dienst sein, damit er selbst Fenster oeffnen kann.
Der Desktop den du siehst ist leztlich dem Benutzer zugeordnet.
Der Dienst laeuft aber unabhaengig vom Benutzer und hat seinen eigenen Desktop.
Eine Interaktion mit dem Desktop des Benutzers muss erst erlaubt werden.

[Luckie]

Zitat:

Zitat von Robert Marquardt

Der Dienst muss ein interaktiver Dienst sein, damit er selbst Fenster oeffnen kann.

... und auch gleich neune Sicherheitslücken im System mit. :roll: