Messages abfangen als Dienst !

[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.