ni hao

Question

如何编写在记录键盘和鼠标的程序，在线等待，成功即结贴 ！谢谢

Answer 1

const
  ApplicationName = 'recorder';
var
  ApplicationDir_ : array [0..255] of char;
  PrivateProfileFileName_ : string;{$R *.DFM}
{~t}
(**************)
(* ExecDialog *)
(**************)function ExecDialog(D : TOpenDialog; const Key : string) : boolean;
  var
    IniFile : TIniFile;
begin
  IniFile := TIniFile.Create(PrivateProfileFileName_);
  try
    if D.FileName = '' then
      D.FileName := IniFile.ReadString('LastFile',Key,'');
    Result := D.Execute;
    if Result then
      IniFile.WriteString('LastFile',Key,D.FileName);
  finally
    IniFile.Free;
  end {try};
end {ExecDialog};
(***********************)
(* TForm1.BTNLoadClick *)
(***********************)procedure TForm1.BTNLoadClick(Sender: TObject);
  var
    F : TFileStream;
begin
  if ExecDialog(OpenDialog, '1') then begin
    F :=  TFileStream.Create(OpenDialog.FileName, fmOpenRead);
    try
      TheRecorder.Stream.Size := 0;
      TheRecorder.Stream.CopyFrom(F, F.Size);
      OnRecorderStateChange(rsIdle);
    finally
      F.Free;
    end;
  end {if};
end {TForm1.BTNLoadClick};
(***********************)
(* TForm1.BTNPlayClick *)
(***********************)procedure TForm1.BTNPlayClick(Sender: TObject);
begin
  TheRecorder.DoStop;
  TheRecorder.DoPlay;
end {TForm1.BTNPlayClick};
(*************************)
(* TForm1.BTNRecordClick *)
(*************************)procedure TForm1.BTNRecordClick(Sender: TObject);
begin
  TheRecorder.DoStop;
  TheRecorder.DoRecord(false)
end {TForm1.BTNRecordClick};
(***********************)
(* TForm1.BTNSaveClick *)
(***********************)procedure TForm1.BTNSaveClick(Sender: TObject);
  var
    F : TFileStream;
begin
  if ExecDialog(SaveDialog, '1') then begin
    F :=  TFileStream.Create(SaveDialog.FileName, fmCreate);
    try
      TheRecorder.Stream.Seek(0, soFromBeginning);
      F.CopyFrom(TheRecorder.Stream, TheRecorder.Stream.Size);
    finally
      F.Free;
    end;
  end {if};
end {TForm1.BTNSaveClick};
(***********************)
(* TForm1.BTNStopClick *)
(***********************)procedure TForm1.BTNStopClick(Sender: TObject);
begin
  TheRecorder.DoStop;
end {TForm1.BTNStopClick};
(*********************)
(* TForm1.FormCreate *)
(*********************)procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := HandleMessage;
  TheRecorder.OnStateChange := OnRecorderStateChange;
  SpinEdit1.Value := TheRecorder.SpeedFactor;
  OnRecorderStateChange(rsIdle);
end {TForm1.FormCreate};
(************************)
(* TForm1.HandleMessage *)
(************************)procedure TForm1.HandleMessage(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_CANCELJOURNAL then
    TheRecorder.DoStop;
end {TForm1.HandleMessage};
(********************************)
(* TForm1.OnRecorderStateChange *)
(********************************)procedure TForm1.OnRecorderStateChange(NewState: TRecorderState);
begin
  case NewState of
    rsIdle : Caption := 'Idle';
    rsRecording : Caption := 'Recording';
    rsPlaying : Caption := 'Playing'
  end {case};
  BTNPlay.Enabled := (NewState in [rsIdle]) and (TheRecorder.Stream.Size > 0);
  BTNRecord.Enabled := NewState in [rsIdle];
  BTNStop.Enabled := NewState in [rsRecording];
  BTNSave.Enabled := (NewState in [rsIdle]) and (TheRecorder.Stream.Size > 0);
  BTNLoad.Enabled := NewState in [rsIdle];
end {TForm1.OnRecorderStateChange};
(**************************)
(* TForm1.SpinEdit1Change *)
(**************************)procedure TForm1.SpinEdit1Change(Sender: TObject);
begin
  TheRecorder.SpeedFactor := SpinEdit1.Value;
end {TForm1.SpinEdit1Change};
{~b}initialization
  GetModuleFileName(hInstance,ApplicationDir_,SizeOf(ApplicationDir_));
  StrPCopy(ApplicationDir_,ExtractFilePath(StrPas(ApplicationDir_)));
  PrivateProfileFileName_ := StrPas(ApplicationDir_)+ApplicationName+'.ini';

Answer 2

function PlayProc(Code : integer; Undefined : WPARAM; P : LPARAM) : LRESULT; stdcall;
begin
  if Code < 0 then
    Result := CallNextHookEx(TheRecorder.HookHandle, Code, Undefined, P)
  else begin
    case Code of
      HC_SKIP: begin
        if TheRecorder.FStream.Position < TheRecorder.FStream.Size then begin
          TheRecorder.FStream.Read(TheRecorder.EventMsg, SizeOf(EventMsg));
          TheRecorder.EventMsg.Time := TheRecorder.SpeedFactor*(TheRecorder.EventMsg.Time div 100);
          TheRecorder.EventMsg.Time := TheRecorder.EventMsg.Time + TheRecorder.BaseTime;
        end else
          TheRecorder.SetState(rsIdle);
      end;      HC_GETNEXT: begin
        Result := TheRecorder.EventMsg.Time - GetTickCount();
        if Result < 0 then
          Result := 0;
        PEVENTMSG(P)^ := TheRecorder.EventMsg;
      end;
    else
      PEVENTMSG(P)^ := TheRecorder.EventMsg;
      Result := CallNextHookEx(TheRecorder.HookHandle, Code, Undefined, P)
    end {case};
  end {if};
end {PlayProc};
(**************)
(* RecordProc *)
(**************)function RecordProc(Code : integer; Undefined : WPARAM; P : LPARAM) : LRESULT; stdcall;
begin
  if Code < 0 then
    Result := CallNextHookEx(TheRecorder.HookHandle, Code, Undefined, P)
  else begin
    case Code of
      HC_ACTION: begin
        TheRecorder.EventMsg := PEVENTMSG(P)^;
        TheRecorder.EventMsg.Time := TheRecorder.EventMsg.Time-TheRecorder.BaseTime;
        if (TheRecorder.EventMsg.Message >= WM_KEYFIRST) and (TheRecorder.EventMsg.Message <= WM_KEYLAST) and
          (LoByte(TheRecorder.EventMsg.ParamL) = VK_CANCEL) then begin
          // Recording aborted by ctrl-Break
          TheRecorder.SetState(rsIdle);
        end {if};
        TheRecorder.FStream.Write(TheRecorder.EventMsg, sizeOf(TheRecorder.EventMsg));
      end;
      HC_SYSMODALON:;
      HC_SYSMODALOFF:
    end {case};
  end {if};
end {RecordProc};
(********************)
(* TRecorder.Create *)
(********************)constructor TRecorder.Create;
begin
  if TheRecorder = nil then begin
    FStream := TMemoryStream.Create;
    FSpeedFactor := 100;
  end else
    Fail;
end {TRecorder.Create};
(*********************)
(* TRecorder.Destroy *)
(*********************)destructor TRecorder.Destroy;
begin
  DoStop;
  FStream.Free;
  inherited;
end {TRecorder.Destroy};
(********************)
(* TRecorder.DoPlay *)
(********************)procedure TRecorder.DoPlay;
begin
  if State <> rsIdle then
    raise Exception.Create('Recorder: Not ready to play.')
  else if FStream.Size = 0 then
    raise Exception.Create('Recorder: Nothing to play')
  else begin
    FStream.Seek(0,0);
    FStream.Read(EventMsg, SizeOf(EventMsg));
    HookHandle := SetWindowsHookEx(WH_JOURNALPLAYBACK, @PlayProc, hInstance, 0);
    if HookHandle = 0 then
      raise Exception.Create('Playback hook cannot be created')
    else begin
      BaseTime := GetTickCount();
      SetState(rsPlaying);
    end {if};
  end {if};
end {TRecorder.DoPlay};
(**********************)
(* TRecorder.DoRecord *)
(**********************)procedure TRecorder.DoRecord(Append : boolean);
begin
  if State <> rsIdle then
    raise Exception.Create('Recorder: NotReady to record.')
  else begin
    if not Append then begin
      FStream.Size := 0;
      BaseTime := GetTickCount();
    end else begin
      EventMsg.Time := 0;
      if FStream.Size > 0 then begin
        FStream.Seek(-SizeOf(EventMsg),soFromCurrent);
        FStream.Read(TheRecorder.EventMsg, SizeOf(EventMsg));
      end {if};
      BaseTime := GetTickCount() - EventMsg.Time;
    end {if};
    HookHandle := SetWindowsHookEx(WH_JOURNALRECORD, @RecordProc, hInstance, 0);
    if HookHandle = 0 then
      raise Exception.Create('JournalHook cannot be created')
    else begin
      SetState(rsRecording);
    end {if};
  end {if};
end {TRecorder.DoRecord};
(********************)
(* TRecorder.DoStop *)
(********************)procedure TRecorder.DoStop;
begin
 SetState(rsIdle);
end {TRecorder.DoStop};
(****************************)
(* TRecorder.SetSpeedFactor *)
(****************************)procedure TRecorder.SetSpeedFactor(const Value: integer);
begin
  if Value > 0 then
    FSpeedFactor := Value;
end {TRecorder.SetSpeedFactor};
(**********************)
(* TRecorder.SetState *)
(**********************)procedure TRecorder.SetState(const Value: TRecorderState);
begin
  if (Value = rsIdle) and (HookHandle <> THandle(0)) then begin
    UnhookWindowsHookEx(HookHandle);
    HookHandle := THandle(0);
  end {if};
  if Value <> FState then begin
    FState := Value;
    if Assigned(FOnStateChange) then
      FOnStateChange(FState)
  end {if};
end {TRecorder.SetState};
{~b}
initialization
  TheRecorder := nil;
  TheRecorder := TRecorder.Create;
finalization
  TheRecorder.Free;