| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

JournalRecord [D4, D6, D7, WinXP]

OSokin ©   (2004-04-24 21:02:00) 

Извините за дурацкий вопрос, но как сделать запись и воспроизведение с помощью этих функций?

---

OSokin   (2004-06-13 17:40:00) [1]

А где его можно достать (Torry etc.)?

---

Игорь Шевченко   (2004-06-08 18:13:00) [2]

OSokin ©   (08.06.04 16:55)


> Кстати, а что за MarsMessages???


Unit, где описаны пользовательские сообщения. Можно выбросить

---

OSokin   (2004-06-08 16:55:00) [3]

Кстати, а что за MarsMessages???

---

Cobalt   (2004-05-21 19:01:00) [4]

http://www.delphimaster.ru/cgi-bin/forum.pl?id=1083574310&n=2

---

Andrushk   (2004-05-21 18:09:00) [5]

Извините что влезаю в чужую тему,но мне показалось что мой вопрос близок ней.
Мне надо Журнал событий (поправте меня если я неправильно называю то что отображается в SystemTools->EventViewer) записывать в текстовый файл. Т.е., появилось новое событие в журнале - записать в файл. Где можно почитать на эту тему поподробнее?

---

OSokin   (2004-05-03 13:35:00) [6]

Спасибо огромное!!!

---

Игорь Шевченко   (2004-04-26 23:14:00) [7]

продолжение
function JournalRecordFunc(ACode: Integer; AwParam: WPARAM; AlParam: LPARAM): LRESULT; stdcall;
var
 lpEvent: PEventMsg;
 EventItem: PEventItem;
begin
 if ACode >= 0 then begin
   //
   // Skip recording while playing back
   // This is not a limitation of the hooks.
   // This is only because of the simple event storage used in this example
   //
   if HookStates[jhJournalPlayback] then begin
     Result := 0;
     Exit;
   end;

   lpEvent := PEventMsg(AlParam);
   // Stop recording ?
   if (lpEvent^.message = WM_KEYDOWN) and
      (LOBYTE(lpEvent^.paramL) = VK_F11) and
      (GetKeyState(VK_SHIFT) < 0) then begin
     InstallFilter(jhJournalRecord, False);
     Result := 0;
     Exit;
   end;

   New(EventItem);
   with EventItem^, EventItem^.Event do begin
     message := lpEvent^.message;
     paramL  := lpEvent^.paramL;
     paramH  := lpEvent^.paramH;
     time    := lpEvent^.time;
     hwnd    := lpEvent^.hwnd;
     Code := ACode;
   end;
   Journal.Add(EventItem);
   with lpEvent^ do
     WriteToFile('default.jrn', Format('0x%.8x;0x%.8x;0x%.8x;%d;0x%.8x;%s',
       [message, paramL, paramH, time, hwnd, DecodeHookAction(ACode)]));

   Result := 0;
   Exit;
 end;
 Result := CallNextHookEx(hhookHooks[jhJournalRecord], ACode, AWParam, ALParam);
end;

{ TEventsJournal }

function TEventsJournal.Add(AItem: PEventItem): Integer;
begin
 Result := FList.Add(AItem);
end;

procedure TEventsJournal.Clear();
var
 I: Integer;
 EI: PEventItem;
begin
 for I:=Pred(FList.Count) downto 0 do begin
   EI := PEventItem(FList[I]);
   Dispose(EI);
   FList.Delete(I);
 end;
end;

constructor TEventsJournal.Create();
begin
 FList := TList.Create();
end;

destructor TEventsJournal.Destroy();
begin
 Clear();
 FList.Free();
 inherited;
end;

function TEventsJournal.GetEventsCount(): Integer;
begin
 Result := FList.Count;
end;

function TEventsJournal.IsEmpty(): Boolean;
begin
 Result := FList.Count = 0;
end;

procedure TEventsJournal.SaveToFile(const AFileName: String);
var
 I: Integer;
 F: TextFile;
begin
 AssignFile(F, AFileName);
 try
   Rewrite(F);
   for I:=0 to Pred(EventsCount) do
     with Items[I]^, Items[I]^.Event do
       Writeln(F, Format('0x%.8x;0x%.8x;0x%.8x;%d;0x%.8x;%s',
         [message, paramL, paramH, time, hwnd, DecodeHookAction(Code)]));
 finally
   CloseFile(F);
 end;
end;

function HexStrToDec(const S: String): Longint;
var
 HexStr: String;
 L: Integer;
begin
 L := Length(S);
 if Copy(S, 1, 2) = '0x' then begin
   HexStr := Copy(S, 3, L -2 );
   HexStr := '$' + HexStr;
 end;
 Result := StrToIntDef(HexStr, 0);
end;

procedure TEventsJournal.LoadFromFile(const AFileName: String);
var
 F: TextFile;
 S, W: String;
 EI: PEventItem;
begin
 Clear();
 if not FileExists(AFileName) then
   raise Exception.CreateFmt('Файл %s не найден', [AFileName]);
 AssignFile(F, AFileName);
 try
   Reset(F);
   while not EOF(F) do begin
     ReadLn(F, S);
     New(EI);
     try
       W := ExtractDelimited(1, S, [';']);
       EI^.Event.message := HexStrToDec(W);
       W := ExtractDelimited(2, S, [';']);
       EI^.Event.paramL := HexStrToDec(W);
       W := ExtractDelimited(3, S, [';']);
       EI^.Event.paramH := HexStrToDec(W);
       W := ExtractDelimited(4, S, [';']);
       EI^.Event.time := StrToInt(W);
       W := ExtractDelimited(5, S, [';']);
       EI^.Event.hwnd := HexStrToDec(W);
     except
       Dispose(EI);
     end;
     Add(EI);
   end;
 finally
   CloseFile(F);
 end;
end;

function TEventsJournal.GetItems(I: Integer): PEventItem;
begin
 Result := PEventItem(FList[I]);
end;

procedure TEventsJournal.SetItems(I: Integer; const Value: PEventItem);
begin
 with Items[I]^ do begin
   Event := Value^.Event;
   Code  := Value^.Code;
 end;
end;

initialization
 lpfnHookProcs[jhJournalPlayback] := JournalPlaybackFunc;
 lpfnHookProcs[jhJournalRecord]   := JournalRecordFunc;
 Journal := TEventsJournal.Create;
finalization
 Journal.Free;
end.



Использование:
procedure TfMain.JournalRecordActionExecute(Sender: TObject);
begin
 Journal.Clear();
 InstallFilter(jhJournalRecord, True);
end;

procedure TfMain.JournalPlaybackActionExecute(Sender: TObject);
begin
 CurrentEventIndex := 0;
 InstallFilter(jhJournalPlayback, True);
end;

procedure TfMain.JournalLoadActionExecute(Sender: TObject);
begin
 OpenDialog.InitialDir := FOptions.WorkingDir;
 if OpenDialog.Execute() then
   Journal.LoadFromFile(OpenDialog.FileName);
end;

procedure TfMain.JournalSaveActionExecute(Sender: TObject);
begin
 SaveDialog.InitialDir := FOptions.WorkingDir;
 if SaveDialog.Execute() then
   Journal.SaveToFile(SaveDialog.FileName);
end;

procedure TfMain.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
 if Msg.message = WM_CANCELJOURNAL then begin
   SendMessage(Application.MainForm.Handle, WM_SHOWSTATUS, 0, 0);
   InitHookStates();
   Handled := True;
 end;
end;


---

Игорь Шевченко   (2004-04-26 23:13:00) [8]

Разбирайся:
unit JournalHooks;

interface
uses
 Windows, Classes;

type
 TJournalHook = (jhJournalPlayback, jhJournalRecord);

 //Строка журнала
 PEventItem = ^TEventItem;
 TEventItem = record
   Event: TEventMsg;
   Code: Integer;
 end;

 //Журнал событий
 TEventsJournal = class
 private
   FList: TList;
   function GetEventsCount(): Integer;
   function GetItems(I: Integer): PEventItem;
   procedure SetItems(I: Integer; const Value: PEventItem);
 public
   constructor Create();
   destructor Destroy(); override;
   property Items[I: Integer]: PEventItem read GetItems write SetItems; default;
   procedure Clear();
   function IsEmpty(): Boolean;
   property EventsCount: Integer read GetEventsCount;
   function Add(AItem: PEventItem): Integer;
   procedure SaveToFile(const AFileName: String);
   procedure LoadFromFile(const AFileName: String);
 end;

var
 Journal: TEventsJournal;
 CurrentEventIndex: Integer;

procedure InstallFilter(AJournalHook: TJournalHook; ACode: Boolean);
procedure InitHookStates();

implementation

uses
 SysUtils, Messages, StrUtils, MarsMessages, Forms;

var
 // Hook Handles
 hhookHooks: array[TJournalHook] of THandle;
 // State Table of my hooks
 HookStates: array[TJournalHook] of Boolean = (False, False);
 lpfnHookProcs: array[TJournalHook] of TFNHookProc = (nil, nil);

const
 HookCodes: array[TJournalHook] of Integer = (
          WH_JOURNALPLAYBACK,
          WH_JOURNALRECORD   );

function DecodeHookAction(const ACode: Integer): String;
const
 HookCodes : array[HC_ACTION..HC_SYSMODALOFF] of String = (
     'HC_ACTION', 'HC_GETNEXT', 'HC_SKIP', 'HC_NOREMOVE', 'HC_SYSMODALON',
     'HC_SYSMODALOFF' );
begin
 if ACode < HC_ACTION then
   Result := '**less than zero'
 else if ACode > High(HookCodes) then
   Result := Format('Unknown_0x%.x', [ACode])
 else
   Result := HookCodes[ACode];
end;

procedure InstallFilter(AJournalHook: TJournalHook; ACode: Boolean);
const
 MessArr: array[TJournalHook] of String =
   ('Идет воспроизведение журнала событий',
   'Идет запись журнала событий (остановить запись - Shift+F11)');
begin
 if ACode then begin
   hhookHooks[AJournalHook] := SetWindowsHookEx(HookCodes[AJournalHook],
                         lpfnHookProcs[AJournalHook], hInstance, 0);
   if hhookHooks[AJournalHook] = 0 then
    RaiseLastWin32Error();
   HookStates[AJournalHook] := True;
   SendMessage(Application.MainForm.Handle, WM_SHOWSTATUS,
      0, LPARAM(PChar(MessArr[AJournalHook])));
 end else begin
   UnhookWindowsHookEx(hhookHooks[AJournalHook]);
   HookStates[AJournalHook] := False;
   SendMessage(Application.MainForm.Handle, WM_SHOWSTATUS, 0, 0);
 end;
end;

procedure InitHookStates();
var I: TJournalHook;
begin
 for I:=Low(TJournalHook) to High(TJournalHook) do
   HookStates[I] := False;
end;

procedure WriteToFile(const AFileName, S: String);
var
 Exists: Boolean;
 F: TextFile;
begin
 Exists := FileExists(AFileName);
 AssignFile(F, AFileName);
 try
   if Exists then
     Append(F)
   else
     Rewrite(F);
   WriteLn(F, S);
 finally
   CloseFile(F);
 end;
end;

var
 dwTimeAdjust: DWORD = 0;

function JournalPlaybackFunc(ACode: Integer; AwParam: WPARAM; AlParam: LPARAM): LRESULT; stdcall;
var
 lpEvent: PEventMsg;
begin
 if ACode > 0 then begin
   if Journal.IsEmpty() or HookStates[jhJournalRecord] then begin
     InstallFilter(jhJournalPlayback, False);
     //Нет записей в журнале или идет запись журнала
     Result := CallNextHookEx(hhookHooks[jhJournalPlayback], ACode, AWParam, ALParam);
     Exit;
   end;

   //Это первый элемент списка?
   if CurrentEventIndex = 0 then
     dwTimeAdjust := GetTickCount() - Journal[CurrentEventIndex].Event.time;

   if ACode = HC_SKIP then begin
    //Список обработан?
     if CurrentEventIndex >= Pred(Journal.EventsCount) then begin
       InstallFilter(jhJournalPlayback, False);
       CurrentEventIndex := 0;
     end else begin
       Inc(CurrentEventIndex);
     end;
   end else if ACode = HC_GETNEXT then begin

     lpEvent := PEventMsg(AlParam);

     lpEvent^.message := Journal[CurrentEventIndex].Event.message;
     lpEvent^.paramL  := Journal[CurrentEventIndex].Event.paramL;
     lpEvent^.paramH  := Journal[CurrentEventIndex].Event.paramH;
     lpEvent^.time    := Journal[CurrentEventIndex].Event.time + dwTimeAdjust;

     Result := lpEvent^.time - GetTickCount();
     if Result < 0 then begin
       Result := 0;
       lpEvent^.time := GetTickCount();
     end;
     Exit;
   end;
 end;
 Result := CallNextHookEx(hhookHooks[jhJournalPlayback], ACode, AWParam, ALParam);
end;



продолжение следует

---

OSokin   (2004-04-26 18:38:00) [9]

Да у меня у самого есть две демки, но исходников нет... Там компонент используется. Хотя, поищу на Torry.

---

Игорь Шевченко   (2004-04-24 23:18:00) [10]

В MSDN Magazine RE была неплохая демка на эту тему, там же приводилась ссылка на пример.

---

Наверх