Messages aufzeichnen

[XXcD]

Hallo,
ich habe vor einiger Zeit mal ne Delphi Demo gefunden über das aufzeichnen von Windows Messages.
Leider habe ich vergessen wo ich das her hatte und kann das auch nicht mehr finden, könnt ihr mit da weiterhelfen?

[Astat]

Hallo XXcD,

Ist wahrscheinlich Ben Ziegler's Message Simulator Componente, die Du suchst!

Delphi-Quellcode:

unit MsgSimulator;

{
   June 23, 1998   by Ben Ziegler

   6/30/98 - Added a Record Macro function
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
   TWMMessage = (mmMouseDown, mmMouseUp, mmMouseMove, mmKeyDown, mmKeyUp);

   TMessageItem = class(TCollectionItem)
   protected
      em          : TEventMsg;      // Structure required by JournalPlayback Proc
      FMsg        : TWMMessage;
      FDelay      : DWORD;          // Delay in msec before next message is played
      FX          : integer;        // This means nothing for keystrokes
      FY          : integer;        // This means nothing for keystrokes
      FKey        : integer;        // This means nothing for mouse clicks
      FHWND       : integer;        // Window Handle (not used for keystrokes)
      FButton     : TMouseButton;   // This means nothing for keystrokes
      procedure   Fill_EM_From_Props;
      procedure   Fill_Props_From_EM;
   public
      constructor Create(Collection: TCollection); override;
      property    HWND        : integer read FHWND write FHWND; // No need to save it - it will be different after each run
   published
      property    Msg         : TWMMessage read FMsg write FMsg;
      property    PosX        : integer read FX write FX;
      property    PosY        : integer read FY write FY;
      property    VkKey       : integer read FKey write FKey;
      property    Delay       : DWORD read FDelay write FDelay;
      property    Button      : TMouseButton read FButton write FButton;
   end;

   TMsgSimulator = class;

   TMessageCollection = class(TCollection)
   private
     FOwner       : TMsgSimulator;
     function     GetItem(Index: Integer): TMessageItem;
     procedure    SetItem(Index: Integer; Value: TMessageItem);
   protected
     function     GetOwner: TPersistent; override;
     procedure    Update(Item: TCollectionItem); override;
   public
     constructor  Create(AOwner: TMsgSimulator);
     function     Add: TMessageItem;
     property     AOwner: TMsgSimulator read FOwner;
     property     Items[Index: Integer]: TMessageItem read GetItem write SetItem; default;
   end;

   TMsgSimulator = class(TComponent)
   protected
      FRunning    : boolean;     // Simulation is currently running
      play_hk     : THandle;     // JournalPlayback Hook handle
      rec_hk      : THandle;     // RecordPlayback Hook handle
      PlayDone    : boolean;     // Flag to signal that all messages have been simulated
      AbortSim    : boolean;     // Flag to signal aborting the playback of messages
      StartTime   : DWORD;       // Time simulation started (msec)
      StopTime    : DWORD;       // Time simulation stoped (msec)
      FDelay      : integer;     // Default delay between messages
      FMsgList    : TMessageCollection; // Messages to playback
      FTopWin     : string;
      FindText    : string;
      FindHandle  : THandle;
      StopRec     : integer;
      FRecording  : boolean;
      FOnStopRec  : TNotifyEvent;
      function    GetElapTime: integer;
      procedure   SetMsgList(MsgList: TMessageCollection);
      function    Add_Raw_Message(Msg: TWMMessage; x, y, VkKey, Delay, HWND: integer; Button: TMouseButton): TMessageItem;
      procedure   Add_Shift(hwnd: THandle; Shift: TShiftState; UpDown: TWMMessage; Delay: integer);
      procedure   SimClientToScreen(hwnd: THandle; var x, y: integer);
      procedure   FixUp_Playback_Delays;
      procedure   FixUp_Record_Delays;
   public
      constructor Create(AOwner: TComponent); override;
      destructor  Destroy; override;
      // Low-level Message Creation Functions
      procedure   Add_ClickEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
                     x, y, Delay: integer);
      procedure   Add_DragEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
                     StartX, StartY, StopX, StopY, NumMoves, Delay: integer);
      procedure   Add_VirtualKey(hwnd: THandle; VkKey, Delay: integer; UpDown: TWMMessage);
      // High-level Message Creation Functions
      procedure   Add_Window_Click(hwnd: THandle; x, y: integer);
      procedure   Add_Window_Drag(hwnd: THandle; StartX, StartY, StopX, StopY: integer);
      procedure   Add_Screen_Click(x, y: integer);
      procedure   Add_Screen_Drag(StartX, StartY, StopX, StopY: integer);
      procedure   Add_ASCII_Keys(const Keystrokes: string);
   public
      // Playback & Cancel Functions
      procedure   Play;                      // Plays messages, then returns
      procedure   Play_Async;                // Returns immediately
      procedure   Abort;
      procedure   Record_Input;
      procedure   Stop_Record;
      property    Running: boolean read FRunning;
      property    Recording: boolean read FRecording;
      property    ElapTime: integer read GetElapTime; // Elapsed running time in msec
      // Helper Functions
      procedure   FocusWin(hwnd: THandle);
      function    FindTopLevelWin(const FindText: string): THandle;
   published
      property    Messages: TMessageCollection read FMsgList write SetMsgList;
      property    DefaultDelay: integer read FDelay write FDelay default 50;
      property    OnStopRecord: TNotifyEvent read FOnStopRec write FOnStopRec;
   end;

procedure Register;


implementation

var
   CurSim   : TMsgSimulator;  // Only one TMsgSimulator can play at a time
   Cur      : integer;        // Current Message to play in the MsgList
   NumCur   : integer;        // Number of times current message has been played


procedure Register;
begin
  RegisterComponents('Samples', [TMsgSimulator]);
end;


// *********************************************************************
// TMessageItem

constructor TMessageItem.Create(Collection: TCollection);
begin
   inherited;
   Delay := TMessageCollection(Collection).AOwner.DefaultDelay;
end;

procedure TMessageItem.Fill_EM_From_Props;
begin
   em.hwnd  := hwnd;

   if (Msg = mmMouseDown) and (Button = mbLeft)   then em.message := WM_LBUTTONDOWN;
   if (Msg = mmMouseUp)   and (Button = mbLeft)   then em.message := WM_LBUTTONUP;
   if (Msg = mmMouseDown) and (Button = mbRight)  then em.message := WM_RBUTTONDOWN;
   if (Msg = mmMouseUp)   and (Button = mbRight)  then em.message := WM_RBUTTONUP;
   if (Msg = mmMouseDown) and (Button = mbMiddle) then em.message := WM_MBUTTONDOWN;
   if (Msg = mmMouseUp)   and (Button = mbMiddle) then em.message := WM_MBUTTONUP;

   case Msg of
      mmMouseMove : em.message := WM_MOUSEMOVE;
      mmKeyDown   : em.message := WM_KEYDOWN;
      mmKeyUp     : em.message := WM_KEYUP;
   end;

   if (Msg = mmKeyDown) or (Msg = mmKeyUp) then begin
      // Keystroke Message
      em.paramL := VkKey;
      em.paramH := MapVirtualKey(VkKey, 0);
   end else begin
      // Mouse Message
      em.paramL := PosX;
      em.paramH := PosY;
   end;
end;

procedure TMessageItem.Fill_Props_From_EM;
begin
   hwnd := em.hwnd;

   case em.message of
      WM_LBUTTONDOWN : begin Msg := mmMouseDown; Button := mbLeft;   end;
      WM_LBUTTONUP   : begin Msg := mmMouseUp;   Button := mbLeft;   end;
      WM_RBUTTONDOWN : begin Msg := mmMouseDown; Button := mbRight;  end;
      WM_RBUTTONUP   : begin Msg := mmMouseUp;   Button := mbRight;  end;
      WM_MBUTTONDOWN : begin Msg := mmMouseDown; Button := mbMiddle; end;
      WM_MBUTTONUP   : begin Msg := mmMouseUp;   Button := mbMiddle; end;
      WM_MOUSEMOVE   : Msg := mmMouseMove;
      WM_KEYDOWN     : Msg := mmKeyDown;
      WM_KEYUP       : Msg := mmKeyUp;
   end;

   if (Msg = mmKeyDown) or (Msg = mmKeyUp) then begin
      // Keystroke Message
      VkKey := em.paramL;
   end else begin
      // Mouse Message
      PosX := em.paramL;
      PosY := em.paramH;
   end;
end;


// *********************************************************************
// TMessageCollection

constructor TMessageCollection.Create(AOwner: TMsgSimulator);
begin
  inherited Create(TMessageItem);
  FOwner := AOwner;
end;

function TMessageCollection.Add: TMessageItem;
begin
  Result := TMessageItem(inherited Add);
end;

function TMessageCollection.GetItem(Index: Integer): TMessageItem;
begin
  Result := TMessageItem(inherited GetItem(Index));
end;

function TMessageCollection.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TMessageCollection.SetItem(Index: Integer; Value: TMessageItem);
begin
  inherited SetItem(Index, Value);
end;

procedure TMessageCollection.Update(Item: TCollectionItem);
begin
   Assert(not FOwner.Running);
end;


// *********************************************************************
// TMsgSimulator

constructor TMsgSimulator.Create(AOwner: TComponent);
begin
   inherited;
   FDelay   := 50;
   FMsgList := TMessageCollection.Create(Self);
end;

destructor TMsgSimulator.Destroy;
begin
   if Running then Abort;
   FMsgList.Free;
   FMsgList := nil;
   inherited;
end;

procedure TMsgSimulator.SetMsgList(MsgList: TMessageCollection);
begin
   FMsgList.Assign(MsgList);
end;

function TMsgSimulator.Add_Raw_Message(Msg: TWMMessage; x, y, VkKey, Delay, HWND: integer; Button: TMouseButton): TMessageItem;
begin
   Result := Messages.Add;
   Result.Msg    := Msg;
   Result.PosX   := x;
   Result.PosY   := y;
   Result.VkKey  := VkKey;
   Result.Delay  := Delay;
   Result.HWND   := HWND;
   Result.Button := Button;
end;

procedure TMsgSimulator.Add_Shift(hwnd: THandle; Shift: TShiftState; UpDown: TWMMessage; Delay: integer);
begin
   // NOTE:  Keystrokes do not require an hwnd, so use 0
   if Shift = [] then exit;
   if ssShift in Shift then Add_Raw_Message(UpDown, 0, 0, VK_SHIFT, Delay, 0, mbLeft);
   if ssCtrl  in Shift then Add_Raw_Message(UpDown, 0, 0, VK_CONTROL, Delay, 0, mbLeft);
   if ssAlt   in Shift then Add_Raw_Message(UpDown, 0, 0, VK_MENU, Delay, 0, mbLeft);
end;

// x, y are in Screen coordinates
procedure TMsgSimulator.Add_ClickEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
               x, y, Delay: integer);
begin
   Add_Shift(hwnd, Shift, mmKeyDown, Delay);
   Add_Raw_Message(mmMouseDown, x, y, 0, Delay, hwnd, Button);
   Add_Raw_Message(mmMouseUp, x, y, 0, Delay, hwnd, Button);
   Add_Raw_Message(mmMouseMove, x, y, 0, Delay, hwnd, Button);
   Add_Shift(hwnd, Shift, mmKeyUp, Delay);
end;

// x, y are in Screen coordinates
procedure TMsgSimulator.Add_DragEx(hwnd: THandle; Button: TMouseButton; Shift: TShiftState;
               StartX, StartY, StopX, StopY, NumMoves, Delay: integer);
var
   i, x, y : integer;
begin
   Add_Shift(hwnd, Shift, mmKeyDown, Delay);
   Add_Raw_Message(mmMouseDown, StartX, StartY, 0, Delay, hwnd, Button);

   for i := 0 to NumMoves do begin
      x := (StopX - StartX) * i div NumMoves + StartX;
      y := (StopY - StartY) * i div NumMoves + StartY;
      Add_Raw_Message(mmMouseMove, x, y, 0, Delay, hwnd, Button);
   end;

   Add_Raw_Message(mmMouseUp, StopX, StopY, 0, Delay, hwnd, Button);
   Add_Shift(hwnd, Shift, mmKeyUp, Delay);
end;

procedure TMsgSimulator.Add_VirtualKey(hwnd: THandle; VkKey, Delay: integer; UpDown: TWMMessage);
begin
   Add_Raw_Message(upDown, 0, 0, vkKey, Delay, hwnd, mbLeft);
end;

procedure TMsgSimulator.SimClientToScreen(hwnd: THandle; var x, y: integer);
var
   p : TPoint;
begin
   if hwnd = 0 then exit;
   p := Point(x, y);
   Windows.ClientToScreen(hwnd, p);
   x := p.x;
   y := p.y;
end;

// x, y are in the Window's coordinates
procedure TMsgSimulator.Add_Window_Click(hwnd: THandle; x, y: integer);
begin
   SimClientToScreen(hwnd, x, y);
   Add_ClickEx(hwnd, mbLeft, [], x, y, DefaultDelay);
end;

// StartXY & StopXY are in the Window's coordinates
procedure TMsgSimulator.Add_Window_Drag(hwnd: THandle; StartX, StartY, StopX, StopY: integer);
begin
   SimClientToScreen(hwnd, StartX, StartY);
   SimClientToScreen(hwnd, StopX, StopY);
   Add_DragEx(hwnd, mbLeft, [], StartX, StartY, StopX, StopY, 10, DefaultDelay);
end;

// x, y are in Screen coordinates
procedure TMsgSimulator.Add_Screen_Click(x, y: integer);
var
   hwnd : THandle;
begin
   hwnd := Windows.WindowFromPoint(Point(x, y));
   Add_ClickEx(hwnd, mbLeft, [], x, y, DefaultDelay);
end;

// x, y are in Screen coordinates
procedure TMsgSimulator.Add_Screen_Drag(StartX, StartY, StopX, StopY: integer);
var
   hwnd : THandle;
begin
   hwnd := Windows.WindowFromPoint(Point(StartX, StartY));
   Add_DragEx(hwnd, mbLeft, [], StartX, StartY, StopX, StopY, 10, DefaultDelay);
end;

procedure TMsgSimulator.Add_ASCII_Keys(const Keystrokes: string);
var
   i     : integer;
   c     : byte;
   Shift : boolean;
begin
   for i := 1 to Length(Keystrokes) do begin
      c := VkKeyScan(Keystrokes[i]) and 255;
      Shift := (VkKeyScan(Keystrokes[i]) and 256) <> 0;
      if Shift then Add_Raw_Message(mmKeyDown, 0, 0, VK_SHIFT, 1 {DefaultDelay}, 0, mbLeft);
      Add_Raw_Message(mmKeyDown, 0, 0, c, DefaultDelay, 0, mbLeft);
      Add_Raw_Message(mmKeyUp, 0, 0, c, 1 {DefaultDelay}, 0, mbLeft);
      if Shift then Add_Raw_Message(mmKeyUp, 0, 0, VK_SHIFT, 1 {DefaultDelay}, 0, mbLeft);
   end;
end;

procedure TMsgSimulator.Play;
begin
   Play_Async;

   Assert(Application <> nil, 'TMsgSimulator.Play:  Application = nil'); 
   while (not Application.Terminated) and (not AbortSim) and (not PlayDone) do begin
      Application.ProcessMessages;
      Sleep(1);
   end;
end;

procedure UnHook;
begin
   Win32Check(UnhookWindowsHookEx(CurSim.play_hk));
   CurSim.play_hk  := 0;
   CurSim.PlayDone := True;
   CurSim.StopTime := GetTickCount;
   CurSim.FRunning := False;
   CurSim := nil;
end;

function JournalPlaybackProc(code: integer; wp: WParam; lp: LPARAM): LResult; stdcall;
var
   pe : PEventMsg;
begin
   Assert(CurSim <> nil, 'CurSim = nil!');
   Assert(CurSim.PlayDone = False, 'Still Playing?');

   Result := CallNextHookEx(CurSim.play_hk, code, wp, lp);
   if code < 0 then exit;

   if CurSim.AbortSim then begin
      UnHook;
      exit;
   end;

   if code = HC_GETNEXT then begin
      pe := @CurSim.Messages[Cur].em;
      PEventMsg(lp)^ := pe^;
      Result := 0;
      if (NumCur = 0) and (Cur > 0) then begin
         Result := CurSim.Messages[Cur].em.time - CurSim.Messages[Cur-1].em.time;
      end;

      NumCur := NumCur + 1;
      exit;
   end;

   if code = HC_SKIP then begin
      Cur := Cur + 1;
      NumCur := 0;
      if Cur = CurSim.Messages.Count then begin
         UnHook;
      end;
      exit;
   end;
end;

procedure TMsgSimulator.FixUp_Playback_Delays;
var
   i : integer;
begin
   for i := 0 to Messages.Count-1 do begin
      Messages[i].Fill_EM_From_Props;

      if i = 0 then Messages[i].em.time := 0
         else Messages[i].em.time := Messages[i-1].em.time + Messages[i].Delay;

      // TODO:  Fix up HWNDs? -bpz
   end;
end;

// This function returns immediately
procedure TMsgSimulator.Play_Async;
begin
   StartTime := GetTickCount;
   StopTime  := StartTime;
   if Messages.Count = 0 then exit;

   FRunning  := True;
   AbortSim  := False;
   PlayDone  := False;

   Assert(CurSim = nil, 'A TMsgSimulator is already playing or recording!');
   CurSim := Self;

   FixUp_Playback_Delays;

   // Set up the JournalPlayback Hook
   Cur       := 0;
   NumCur    := 0;
   play_hk   := SetWindowsHookEx(WH_JOURNALPLAYBACK, JournalPlaybackProc, HInstance, 0);
end;

function TMsgSimulator.GetElapTime: integer;
begin
   if Running then
      Result := GetTickCount - StartTime
   else
      Result := StopTime - StartTime;
end;

procedure TMsgSimulator.Abort;
begin
   Assert(Running, 'Must be running to Abort!');
   AbortSim := True;
end;

function JournalRecordProc(code: integer; wp: WParam; lp: LPARAM): LResult; stdcall;
var
   pe : PEventMsg;
   mi : TMessageItem;
begin
   Result := 0;
   case code of
      HC_ACTION : if (CurSim.StopRec = 0) then begin
         pe := PEventMsg(lp);
         if (pe.message = WM_KEYDOWN) and ((pe.paramL and 255) = VK_CANCEL) then begin
            CurSim.Stop_Record;
            exit;
         end;

         mi := CurSim.Messages.Add;
         mi.em := pe^;
         mi.Fill_Props_From_EM;
         end;
      HC_SYSMODALON  : Inc(CurSim.StopRec);
      HC_SYSMODALOFF   : Dec(CurSim.StopRec);
   end;
end;

procedure TMsgSimulator.Record_Input;
begin
   Assert(CurSim = nil, 'A TMsgSimulator is already playing or recording!');
   CurSim  := Self;
   StopRec := 0;

   Messages.Clear;
   FRecording := True;

   rec_hk := SetWindowsHookEx(WH_JOURNALRECORD, JournalRecordProc, HInstance, 0);
end;

procedure TMsgSimulator.FixUp_Record_Delays;
var
   i : integer;
begin
   for i := 0 to Messages.Count-1 do begin
      if i = Messages.Count-1 then Messages[i].Delay := 0
         else Messages[i].Delay := Messages[i+1].em.time - Messages[i].em.time;
   end;
end;

procedure TMsgSimulator.Stop_Record;
begin
   if Recording then begin
      Win32Check(UnhookWindowsHookEx(CurSim.rec_hk));
      rec_hk  := 0;
      CurSim := nil;
      FRecording := False;

      FixUp_Record_Delays;

      if Assigned(OnStopRecord) then
         OnStopRecord(Self);           // This is useful when the user hits CTRL-BREAK to stop recording rather than pressing a "Stop" button
   end;
end;

procedure TMsgSimulator.FocusWin(hwnd: THandle);
var
   tmp : THandle;
begin
   // Get the top-level window
   tmp := hwnd;
   while GetParent(tmp)<>0 do
      tmp := GetParent(tmp);

   SetForegroundWindow(tmp);
   Windows.SetFocus(hwnd);
end;

function EnumWindowsProc(hwnd: THandle; lp: LParam): boolean; stdcall;
var
   buf : array[0..MAX_PATH] of char;
   ms  : TMsgSimulator;
begin
   Result := True;
   ms := TMsgSimulator(lp);
   Assert(ms<>nil);

   GetWindowText(hwnd, buf, sizeof(buf));
   if Pos(ms.FindText, buf)<>0 then ms.FindHandle := hwnd;
end;

function TMsgSimulator.FindTopLevelWin(const FindText: string): THandle;
begin
   Self.FindText := FindText;
   FindHandle := DWORD(-1);
   EnumWindows(@EnumWindowsProc, LParam(Self));
   Result := FindHandle;
end;


initialization
   CurSim := nil;
end.

lg. Astat

[XXcD]

Ok danke, aber ich glaube das ist nicht das richtige ich will keine Messages senden sondern empfangen.

Ich habe nämlich ein Problem ich habe keine Explorer.exe sondern nur mein Media Center und da lässt sich die Laustärke nicht einstellen.
Ich vermute mal, dass der Explorer dafür verantwortlich ist.

Jetzt wollte ich mal schauen ob eine Message gesendet wird wenn man lauter oder leiser machen will und dann einfach die Message abfangen und manuell die Lautstärke über mein Programm einstellen.