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