Utilizamos cookies propias y de terceros. [Más información sobre las cookies].
Política de cookies
Proyecto AjpdSoft

· Inicio
· Buscar
· Contactar
· Cookies
· Descargas
· Foros
· Historia
· Nosotros
· Temas
· Top 10
· Trucos
· Tutoriales
· Wiki
Escribir en el Visor de Sucesos de Windows - Delphi
Lenguaje de programación Borland Delphi


Este ejemplo muestra cómo escribir sucesos desde nuestra aplicación en el Visor de sucesos de Windows. Para que el mensaje que se envíe se muestre correctamente en el Visor de sucesos, es necesario crear un fichero .mc y compilarlo con una herramienta de Microsoft "mc.exe", el fichero compilado deberemos incluirlo en el fichero .rc (resources) de nuestra aplicación, a continuación mostramos el código fuente/Source code completo en Delphi 6:

unit UnidadMenuPrincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, registry, shellapi, jpeg, ExtCtrls;

type
  TformMenuPrincipal = class(TForm)
    bEnviarMensaje: TButton;
    txtMensaje: TEdit;
    Label1: TLabel;
    mMensaje: TMemo;
    Button1: TButton;
    dlGuardar: TSaveDialog;
    txtMCCompilar: TEdit;
    Button2: TButton;
    StaticText1: TStaticText;
    Image1: TImage;
    procedure bEnviarMensajeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  formMenuPrincipal: TformMenuPrincipal;

implementation

{$R *.dfm}

procedure escribirClavesNecesarias ();
var
  Reg : TRegistry;
  RegKey : String;
  AppPath : String;
  AppName : String;
  NumCategories : Integer;
  EventLog : Thandle;
begin
  Reg := TRegistry.Create;
  try
    AppPath := Application.ExeName;
    AppName := 'AjpdSoft Escribir log';
    Delete(AppName, Length(AppName) - 4, 4); //eliminamos la extensión
    NumCategories := 2;
    RegKey :=Format('SYSTEM\CurrentControlSet\Services\Eventlog\Application\%s',[AppName]);
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    Reg.OpenKey(RegKey,True);
    Reg.WriteString('CategoryMessageFile', AppPath);
    Reg.WriteString('EventMessageFile', AppPath);
    Reg.WriteInteger('CategoryCount', NumCategories); //número máximo de categorías
    Reg.WriteInteger('TypesSupported', EVENTLOG_SUCCESS or EVENTLOG_ERROR_TYPE or EVENTLOG_WARNING_TYPE or EVENTLOG_INFORMATION_TYPE); //permitimos cualquier tipo
    Reg.CloseKey;
    EventLog := RegisterEventSource(nil, PChar(AppName));
  finally
    Reg.Free;
  end;
end;

procedure TformMenuPrincipal.Button2Click(Sender: TObject);
var
  resultado : THandle;
begin
  resultado :=  ShellExecute(Handle, Nil, PChar('mc'),
      pchar(txtMCCompilar.text), Nil, SW_SHOWNORMAL);
  if resultado <> 0 then
    ShowMessage('El fichero NO ha sido compilado.')
  else
    ShowMessage('Fichero compilado correctamente.');
end;

procedure TformMenuPrincipal.bEnviarMensajeClick(Sender: TObject);
var
  EventLog : Thandle;
  MyMsg:Array[0..2] Of PChar;
begin
  escribirClavesNecesarias;
  
  EventLog := RegisterEventSource(nil, PChar('AjpdSoft Escribir log'));
  MyMsg[0]:= pchar(txtMensaje.text);
  ReportEvent(EventLog, EVENTLOG_INFORMATION_TYPE, 1, 0, nil, 1, 0, @MyMsg, nil);
end;

procedure TformMenuPrincipal.Button1Click(Sender: TObject);
begin
  dlGuardar.Title := 'Fichero mc a guardar...';
  dlGuardar.FileName := 'ejemplo';
  dlGuardar.Filter := 'MC (Microsoft Message *.mc)|*.mc|Todos los archivos (*.*)|*.*';
  dlGuardar.DefaultExt := 'mc';
  if dlGuardar.Execute then
  begin
    mMensaje.Lines.SaveToFile(dlGuardar.FileName);
    txtMCCompilar.Text := dlGuardar.FileName;
  end;
end;

end.
Si es usuario registrado puede descargar/download el código fuente del truco pulsando aquí.




Publicado el: 2005-03-25

Visita nuestro nuevo sitio web con programas y contenidos actualizados: Proyecto A