Evenlog hint

Der fremgår ikke af artiklen, men det eneste det kan være er en boolean variabel (defineret som en variabel tilhørende formen eller som en global variabel) der sættes til true et andet sted når brugeren ønsker at stoppe programmet eller repeat loopet.

Hmm ok, hvor ville det være hensigtsmæssigt at starte selve proceduren?

Så hvis jeg erklærer en global variabel med navn lTerminated af typen boolean med værdi false. Og så sætte den til true når jeg ikke ønsker at køre mere så spiller det?

Hmm kan simpelthen ikke få det til at virke. Programmet fryser bare og foretager sig ingenting. Temmelig irriterende.

Nogen der har en ide hvordan man kan få notifications fra eventloggen? Så ens program får at vide så snart der skrives til den? Og derefter læse hvad der er blevet skrevet?

Nu har jeg læst artiklen og der står jo hvordan man læser fra loggen.

Hvad angår notification-delen, så har jeg lavet det til en tråd:

uses
  Classes, Windows, SysUtils;

type
  TEventNotification = class(TThread)
  private
    fLog : TStrings;
  protected
    procedure Log;
    procedure Execute; override;
  public
    constructor Create(aLog : TStrings); reintroduce;
  end;

implementation

{ TEventNotification }

constructor TEventNotification.Create(aLog: TStrings);
begin
  fLog := aLog;
  FreeOnTerminate := true;
  inherited Create(false);
end;

procedure TEventNotification.Execute;
var
  lLog: THandle;
  lEvent: THandle;
begin
  lLog := OpenEventLog(nil, PChar('Application'));
  lEvent := CreateEvent(nil, True, False, nil);
  NotifyChangeEventLog(lLog, lEvent);
  ResetEvent(lEvent);
  repeat
    if WaitForSingleObject(lEvent, INFINITE)=WAIT_OBJECT_0 then
      Synchronize(Log);
  until Terminated;
end;

procedure TEventNotification.Log;
begin
  fLog.Add('Changed at ' + DateTimeToStr(Now()));
end;

Mit main-program kører en rettet version af Serge Dosyukovs "skriv til log" procedure. Bemærk, at 'Application' er loggen. Dette angives både i tråd og nedenfor.

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  fThread := TEventNotification.Create(mLog.Lines);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  fThread.Terminate;
end;

procedure TfrmMain.btnWriteToLogClick(Sender: TObject);
var
  lEventLog  : THandle;
  lValue      : PChar;
  lLength    : integer;
  lSomeString : string;
begin
  // when application is started
  lEventLog := RegisterEventSource(nil, PChar('Application'));

  // this is just temp varuable
  lSomeString := 'A test event message';
  lLength := Length(lSomeString) + 2;
  // Allocate memory and copy string
  lValue := AllocMem(lLength);
  StrPCopy(lValue, lSomeString);
  // Information type record is created
  ReportEvent(lEventLog, EVENTLOG_INFORMATION_TYPE, 0, 0, nil, 1, 0, @lValue, nil);

  // when application is about to be closed
  if (lEventLog <> 0) then
    DeregisterEventSource(lEventLog);
end;

Umiddelbart så er det et skridt på vejen, men mine notifications kommer ikke i samme hast som jeg banker data ind i loggen. Interessant emne. Arbejder videre på det om jeg får tid

Nå. Trådens loop fik lige en loop(0) sat ind.

Main-delen ser nu således ud (kunne bl.a. ikke lide variabelnavnene).

type
  TfrmMain = class(TForm)
    btnWriteToLog: TButton;
    mLog: TMemo;
    eLogText: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnWriteToLogClick(Sender: TObject);
  private
    fEventLog : THandle;
    fThread : TEventNotification;
  public
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  fThread := TEventNotification.Create(mLog.Lines);
  fEventLog := RegisterEventSource(nil, PChar('Application'));
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  fThread.Terminate;
  if (fEventLog <> 0) then
    DeRegisterEventSource(fEventLog);
end;

procedure TfrmMain.btnWriteToLogClick(Sender: TObject);
var
  buffer : PChar;
  lgd : integer;
  st : string;
begin
  st := eLogText.Text;
  lgd := Length(st) + 2; // én burde da være nok, men jeg gider ikke tjekke
  buffer := AllocMem(lgd);
  try
    StrPCopy(buffer, st);
    ReportEvent(fEventLog, EVENTLOG_INFORMATION_TYPE, 0, 0, nil, 1, 0, @buffer, nil);
    Application.ProcessMessages;
  finally
    FreeMem(buffer);
  end;
end;

end.

Når der sættes data ind i loggen, så styres notifikationen af en funktion der hedder PulseEvent (Microsoft) og det sker kun hvert 5 sekund. Ved flere events indenfor dette 5s slot trigger altså kun den første. Derfor ustabiliteten.

Kig evt. http://msdn.microsoft.com/library/default.asp?url=/library/en-us/debug/base/notifychangeeventlog.asp