type
  TGenericLogger = class(TObject)
  private
    FEventEnabled : boolean;
    FEnableLevel : integer;
    FEnableFlags : cardinal;
    FTraceSession : TRACEHANDLE;
    FRegistrationHandle : TRACEHANDLE;
    FProviderGUID : TGUID;
    FEventClass : TGUID;
    FRegistrationEventClass : TRACE_GUID_REGISTRATION;
  protected
    // Indique si le message de niveau Level doit être écrit dans la trace en
    // cours. Cette fonction teste si une trace a été activée ainsi que son
    // niveau d'activation.
    function MessageEnabled(Level : byte) : boolean;

    // Active la génération des événements.
    procedure EnableEvents(Header : pointer);

    // Désactive la génération des événements.
    procedure DisableEvents(Header : pointer);

    // Handle de la session de trace active.
    property TraceSession : TRACEHANDLE read FTraceSession;

    // Handle d'enregistrement du provider.
    property RegistrationHandle : TRACEHANDLE read FRegistrationHandle;
  public
    // Déclare le provider auprès de ETW.
    // <aProviderGUID> : GUID du provider.
    // <aEventClass> : GUID de la classe des événements générés par le provider.
    constructor Create(aProviderGUID : TGUID; aEventClass : TGUID);

    // Détruit la classe et annule l'enregistrement du provider auprès de ETW.
    destructor Destroy; override;

    // Ecrit le message <msg> dans la trace.
    procedure Trace(msg : string); overload;

    // Ecrit le message <msg> dans la trace.
    // Le message sera mémorisé avec le type d'événement <EventType>, pour le
    // niveau de trace <msgLevel>, avec une information de durée <OperationTime>
    procedure Trace(EventType : integer; msg : string;
      msgLevel : integer = TRACE_LEVEL_INFORMATION;
      OperationTime : int64=0); overload;

    // Ecrit le début d'une opération dans la trace :
    // Le message <msg> est écrit dans la trace, avec le type d'événement
    // <EventType> et le niveau de trace <msgLevel>.
    // En sortie, currentTime est initialisée avec un TimeStamp correspondant à
    // l'heure courante au moment de l'appel.
    procedure TraceBegin(EventType : integer; msg : string;
      var currentTime : int64;
      msgLevel : integer = TRACE_LEVEL_INFORMATION);

    // Ecrit la fin d'une opération dans la trace :
    // Le message <msg> est écrit dans la trace, avec le type d'événement
    // <EventType> et le niveau de trace <msgLevel>.
    // TraceEnd doit avoir été précédé d'un appel à TraceBegin pour définir le
    // début de l'opération. <currentTime> doit contenir la valeur retournée par
    // le paramètre <currentTime> de TraceBegin.
    // TraceEnd calcule alors le temps écoulé (en ms) entre TraceEnd et
    // TraceBegin et écrit ce temps passé dans le champ OperationTime de la
    // trace.
    // En sortie, currentTime contient le temps écoulé depuis l'appel à
    // TraceBegin
    procedure TraceEnd(EventType : integer; msg : string; var currentTime : int64;
      msgLevel : integer = TRACE_LEVEL_INFORMATION);

    // Ecrit l'exception <e> dans la trace, avec le niveau de trace <msgLevel>
    procedure TraceException(e : exception;
      msgLevel : integer = TRACE_LEVEL_ERROR);

    // Identifiant du provider.
    property ProviderGUID : TGUID read FPRoviderGUID;

    // Classe de l'événement généré par le provider.
    property EventClass : TGUID read FEventClass;

    // Indique si la trace est actuellement active
    property EventEnabled : boolean read FEventEnabled write FEventEnabled;

    // Indique le niveau de trace qui a été défini au moment de l'activation
    // de la trace.
    property EnableLevel : integer read FEnableLevel;

    // Indique les flags définis au moment de l'activation de la trace
    property EnableFlags : cardinal read FEnableFlags;
  end;

// Déclare le provider auprès de ETW.
// <aProviderGUID> : GUID du provider.
// <aEventClass> : GUID de la classe d'événements généré par le provider.
constructor TGenericLogger.Create(aProviderGUID: TGUID; aEventClass : TGUID);
begin
  FProviderGUID := aProviderGUID;
  FEventClass := aEventClass;
  FRegistrationEventClass.Guid := @FEventClass;
  FRegistrationEventClass.RegHandle := 0;

  // la déclaration du provider consiste à appeler RegisterTraceGuids.
  if RegisterTraceGuids(@TraceControlCallBack, // Méthode callback pour
                                               // contrôler la trace
    Self, // On définit le pointeur sur l'instance comme contexte utilisateur.
    @FProviderGUID, // Pointeur sur l'identifiant du provider
    1, // Nombre d'événements déclarés
    @FRegistrationEventClass, // Pointeur sur la liste des classes d'événements
                              // générés par le provider
    nil, // On ne définit pas d'informations MOF
    nil, // On ne définit pas d'informations MOF
    FRegistrationHandle)<>ERROR_SUCCESS
  then RaiseLastOSError;
end;

// Cette fonction est appelée automatiquement par ETW pour controler la trace :
// <RequestCode> indique le type d'opération désirée :
// - WMI_ENABLE_EVENTS : Nous informe que le provider vient d'être activé.
// - WMI_DISABLE_EVENTS : Nous informe que le provider vient d'être arrêté.
// <RequestContext> Contient un pointeur sur les données utilisateur fournies
//                  au moment de l'enregistrement de la trace avec
//                  RegisterTraceGuid.
//                  On l'utilise pour connaitre l'instance de TGenericLogger
//                  concernée.
// <BufferSize> Spécifique Vista. On l'ignore.
// <Buffer> pointe sur une structure WNODE_HEADER contenant des informations
//          sur la trace concernée.
// En retour cette fonction doit renvoyer ERROR_SUCCESS pour indiquer que tout
// s'est bien passé.
function TraceControlCallBack(RequestCode : WMIDPREQUESTCODE;
    RequestContext : pointer;
    BufferSize : cardinal;
    Buffer : pointer) : cardinal; stdcall;
begin
  // En fonction de l'opération demandée, on active ou désactive la trace.
  case RequestCode of
    WMI_ENABLE_EVENTS: TGenericLogger(RequestContext).EnableEvents(Buffer);
    WMI_DISABLE_EVENTS: TGenericLogger(RequestContext).DisableEvents(Buffer);
  end;
  result := ERROR_SUCCESS;
end;

type
  TGenericEvent = packed record
    Header : EVENT_TRACE_HEADER; // en-tête du message
    Data : array[0..1] of MOF_FIELD; // Informations à écrire dans la trace.
  end;

// Ecrit le message <msg> dans la trace.
// Le message sera mémorisé avec le type d'événement <EventType>, pour le
// niveau de trace <msgLevel>, avec une information de durée <OperationTime>
procedure TGenericLogger.Trace(EventType: integer; msg: string;
    msgLevel: integer;
    OperationTime: int64);
    const EmptyStr : char = #0;
    var Event : TGenericEvent;
    EventSize : cardinal;
begin
  // Il faut commencer par tester si la trace a été activée et si le niveau de
  // trace défini est compatible avec le message à tracer. Sinon on
  // n'enregistre pas le message dans la trace.
  if MessageEnabled(msgLevel)
  then begin
    // Initialisation d'une structure TGenericEvent qui sera écrite dans la
    // trace.
    EventSize := Sizeof(Event);
    fillchar(Event, EventSize, 0);

    // Initialisation de l'en-tête de l'événement.
    Event.Header.Size := EventSize; // Taille de la structure.

    // On indique que le champs Guid a été défini et qu'on utilise un tableau
    // de structure MOF_FIELD pour définir les informations écrites dans la
    // trace.
    Event.Header.Flags := WNODE_FLAG_TRACED_GUID or WNODE_FLAG_USE_MOF_PTR;

    // On définit les identifiants de l'événement qui sera généré dans la trace.
    // Ces identfiants permettront au programme client de décoder les
    // informations définies dans Data.
    Event.Header.Guid := FEventClass; // Définition de la classe d'événement
    Event.Header.Version := 0; // Numéro de version de l'événement
    Event.Header.Type_ := EventType; // Définition du type de l'événement

    Event.Header.Level := msgLevel; // Niveau de trace de l'événement.

    // Une fois l'en-tête définie, on définit les informations à écrire dans la
    // trace.
    // On veut écrire un enregistrement composé des champs <OperationTime,
    // msg> Pour celà, on initialise l'adresse et la longueur de chaque champ.
    Event.Data[0].DataPtr := @OperationTime;
    Event.Data[0].Length := sizeof(OperationTime);
    if msg<>''
    then begin
      Event.Data[1].DataPtr := @msg[1];
      Event.Data[1].Length := length(msg)+1; // Longueur de la chaîne plus zéro
                                             // terminal.
    end
    else begin
      // Si msg est une chaine vide, msg est en réalité un pointeur qui vaut nil
      // Il ne s'agit donc plus d'une chaine asciiz et la chaine ne s'enregistre
      // pas correctement. Il faut donc qu'on écrive explicitement un zéro
      // terminal.
      Event.Data[1].DataPtr := @EmptyStr;
      Event.Data[1].Length := 1;
    end;

    // Enfin on écrit le message dans la trace.
    TraceEvent(TraceSession, @Event);
  end;
end;

const
  // Identifiant du provider générique.
  DefaultLogger : TGUID = '{708A0B60-6786-460B-96A1-2C569C7B0B4C}';

  // Identifiant des classes de messages générés par le Logger générique.
  DefaultEventClass : TGUID = '{D3E38F07-FB65-4456-82B4-053A40FF72BD}';

const
  EVENT_INFO = 0;
  EVENT_START = 1;
  EVENT_END = 2;
  EVENT_ERROR = 3;

uses uLogger;
...
begin
  ...
  GenericLogger.Trace('Message à écrire dans la trace.');
  ...
end;

const
  // Identifiant du provider SQL.
  SQLLoggerGUID : TGUID = '{E356181E-4059-4BBA-BA4A-87280762A798}';
  
  // Identifiant des classes de messages générés par le provider SQL.
  SQLEventClass : TGUID = '{815AA09D-DBC9-45FE-982E-0243FDF363ED}';
  
// Constantes pour les types d'événements
const
  EVENT_SQL_INFO = 0; // Message d'information
  EVENT_SQL_START = 1; // Début d'exécution d'une requête SQL
  EVENT_SQL_END = 2; // Fin d'exécution d'une requête SQL
  EVENT_SQL_ERROR = 3; // Erreur survenue avec une requête SQL
  EVENT_BEGINTRAN = 4; // Début d'une transaction.
  EVENT_ROLLBACKTRAN = 5; // Rollback d'une transaction.
  EVENT_COMMITTRAN = 6; // Commit d'une transaction.
  EVENT_SQL_FORMAT_START = 7; // Début de la mise en forme des paramètres
  EVENT_SQL_FORMAT_END = 8; // Fin de la mise en forme des paramètres.
  EVENT_SQL_CONNECT = 9; // Connexion au SGBD
  EVENT_SQL_DISCONNECT = 10; // Déconnexion du SGBD

// TSQLLogger implémente un provider ETW pour générer des traces d'exécution de
// requêtes SQL.
type
  TSQLLogger = class(TGenericLogger)
  private
    // Retourne la valeur du paramètre <Param> sous la forme d'une chaîne de
    // caractères.
    function ParamStr(Param : TParam) : string;

    // Ecrit la valeur des paramètres <Params> de la requête <SQL> dans la
    // trace. Cette écriture s'effectue sous la forme de la requête <SQL> dans
    // laquelle les spécificateurs de paramètres ont été remplacés par la valeur
    // du paramètre correspondant.
    procedure FormatParams(SQL : string; params : TParams);
  public
    // Trace le début d'exécution de la requête <SQL>.
    // En sortie, <Time> contient le timestamp du début d'exécution de la
    // requête <Params> doit contenir la valeur des paramètres de la requête.
    // Ces derniers peuvent être définis soit sous la forme d'un ? soit sous la
    // forme :NomdeParametre.
    // <msgLevel> doit indiquer le niveau de trace du message.
    // Si la trace est activée au niveau VERBOSE, les valeurs des paramètres de
    // la requête seront écrites dans la trace.
    procedure TraceSQLBegin(SQL : string; var Time : int64; Params : TParams=nil;
      msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace la fin d'exécution de la requête <SQL>.
    // <Time> doit contenir le timestamp du début d'exécution de la requête
    // renvoyé par TraceSQLBegin.
    // En sorti, <Time> contiendra le temps écoulé depuis l'appel à
    // TraceSQLBegin.
    // <Params> doit contenir la valeur des paramètres de la requête.
    // Ces derniers peuvent être définis soit sous la forme d'un ? soit sous la
    // forme :NomdeParametre.
    // <msgLevel> doit indiquer le niveau de trace du message.
    // Si la trace est activée au niveau VERBOSE, les valeurs des paramètres de
    // la requête seront écrites dans la trace.
    procedure TraceSQLEnd(SQL : string; var Time : int64; Params : TParams=nil;
      msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace le début d'une transaction SQL.
    // En sortie, <Time> contient le timestamp du début de la transaction
    // <msgLevel> indique le niveau de trace du message.
    procedure TraceStartTransaction(var Time : int64;
      msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace la validation d'une transaction SQL.
    // <Time> doit contenir le timestamp du début de la transaction renvoyé par
    // TraceStartTransaction.
    // <msgLevel> indique le niveau de trace du message.
    procedure TraceCommitTransaction(Time : int64;
      msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace le rollback d'une transaction SQL.
    // <Time> doit contenir le timestamp du début de la transaction renvoyé par
    // TraceStartTransaction.
    // <msgLevel> indique le niveau de trace du message.
    procedure TraceRollbackTransaction(Time : int64;
      msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace la connexion au SGBD.
    procedure TraceConnect(msgLevel : byte = TRACE_LEVEL_INFORMATION);

    // Trace la déconnexion du SGBD.
    procedure TraceDisconnect(msgLevel : byte = TRACE_LEVEL_INFORMATION);
  end;

select * from MaTable where Id = ?

select * from MaTable where Id = :MonId

#pragma namespace("\\\\.\\root\\wmi")
[dynamic: ToInstance, Description("Generic Trace"),
  Guid("{708A0B60-6786-460B-96A1-2C569C7B0B4C}")]
class DefaultProvider : EventTrace
{
};
[dynamic: ToInstance, Description("MSGEVENT"): Amended,
  Guid("{D3E38F07-FB65-4456-82B4-053A40FF72BD}"),
  DisplayName("MSG"),
  EventVersion(0)]
class DefaultEventClass : DefaultProvider
{
};

[dynamic: ToInstance, Description("MSG"): Amended,
  EventType{0, 1, 2, 3},
  EventTypeName{"INFO",
                "START",
                "END",
                "ERROR"}]
class DefaultEventClass_EventType1 : DefaultEventClass
{
  [WmiDataId(1), Extension("Noprint"), Description("OperationTime"): Amended, read]
  sint64 OperationTime;

  [WmiDataId(2), Description("TextData"): Amended, read,
  StringTermination("NullTerminated")]
  string TextData;
};

Mofcomp Logger.mof

#pragma namespace("\\\\.\\root\\wmi")
[dynamic: ToInstance, Description("SQL Trace"),
  Guid("{E356181E-4059-4BBA-BA4A-87280762A798}")]
class SQLLogger : EventTrace
{
};

[dynamic: ToInstance, Description("SQL Trace"): Amended,
  Guid("{815AA09D-DBC9-45FE-982E-0243FDF363ED}"),
  DisplayName("SQL Trace")]
class SQLLoggerClass : SQLLogger
{
};

[dynamic: ToInstance, Description("Trace SQL"): Amended,
  EventType{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10},
  EventTypeName{"INFO",
                "START",
                "END",
                "ERROR",
                "BEGIN TRAN",
                "ROLLBACK",
                "COMMIT",
                "PARAMETER START",
                "PARAMETER END",
                "LOGIN",
                "LOGOUT"}]
class SQLLoggerClass_EventType1 : SQLLoggerClass
{
  [WmiDataId(1), Extension("NoPrint"), Description("OperationTime"): Amended, read]
  sint64 OperationTime;
  [WmiDataId(2),Description("TextData"): Amended, read, StringTermination("NullTerminated")]
  string TextData;
};

// TETWTraceControler
// Cette classe représente une session de trace active.
// On démarre une trace en instanciant la classe.
// Lorsque l'instance est détruite, la trace est automatiquement stoppée.
TETWTraceControler = class(TObject)
private
  FRunningSession : TRACEHANDLE;// Handle de la trace en cours.
  FName : string; // Nom utilisé pour créer la trace.
  FFileName : string; // Nom du fichier de trace si on trace dans un
                      // fichier.
  FControlGuid : TGUID; // GUID utilisé pour créer la trace.
  FTrcProps : TTraceProperties; // Propriétés de la trace en cours.
  FEnabledProviders : TStrings; // Liste des providers activés pour la trace.
public
  // Crée et initialise une nouvelle instance de la classe TETWTraceControler.
  // Cette opération a pour effet de démarrer une nouvelle trace dans ETW.
  // <aName> désigne le nom de la trace. Les noms doivent être uniques.
  // <aFileName> indique le nom du fichier dans lequel la trace doit être
  // écrite. Si aucun nom de fichier n'est précisé, une trace
  // temps réel est lancée.
  // Une fois la trace démarrée, il faut activer les providers avec
  // EnableProvider.
  constructor Create(aName : string; aFileName : string);

  // Détruit la classe et libère les resources associées. La trace est alors
  // arrêtée.
  destructor Destroy; override;

  // Désactive le provider <Guid> pour la session de trace. Ce dernier n'écrit
  // plus d'événement dans la trace.
  procedure DisableProvider(Guid : TGUID);

  // Active le provider <Guid> pour la session de trace, avec le niveau de
  // trace <EnableLevel> et les flags <EnableFlags>.
  // Attention, avec ETW, un provider ne peut être activé que pour une seule
  // trace à la fois. On obtiendra une erreur si le provider est déjà actif
  // dans une autre trace.
  procedure EnableProvider(Guid : TGUID; EnableLevel : byte;
    EnableFlags : cardinal);

  // Provoque l'écriture immédiate des buffers dans la trace. Pour une trace
  // temps réel, celà permet d'envoyer les événements au client avant que les
  // buffers ne soient plein.
  // Par contre, il est préférable de ne pas faire de Flush avec une trace
  // fichier car ce sont les buffers complets qui sont écrits sur disque, même
  // s'ils ne sont pas pleins.
  procedure Flush;

  // Décode la chaîne de caractères <provider> pour en extraire le GUID d'un
  // provider ainsi que son état d'activation.
  // <provider> est une chaîne retournée par EnumerateRegisteredProviders.
  // <providerGUID> : en sortie, ce paramètre contient le GUID du provider.
  // <Enabled> : En sortie, indique si le provider est actuellement en cours
  // d'utilisation dans une trace. Un provider ne peut être activé
  // que dans une seule trace à la fois.
  class procedure DecodeProviderInfo(provider : string;
    var providerGUID : string;
    var Enabled : boolean);

  // Retourne dans <aList> la liste des providers disponibles dans ETW, c'est
  // à dire, ceux qui se sont déclarés avec RegisterTraceGuids.
  class procedure EnumerateRegisteredProviders(aList : TStrings);

  // Retourne dans <aList> la liste des traces en cours d'exécution sur la
  // machine.
  // La liste est renvoyé sous la forme : SessionName + #9 + FileName
  class procedure EnumerateRunningTraces(aList : TStrings);
end;

// Crée et initialise une nouvelle instance de la classe TETWTraceControler.
// Cette opération a pour effet de créer une nouvelle session de trace dans
// ETW, et de démarrer la trace.
// <aName> désigne le nom de la trace. Les noms doivent être uniques.
// <aFileName> indique le nom du fichier dans lequel la trace doit être écrite.
//             si aucun nom de fichier n'est précisé, une trace temps réel
//             est lancée.
// Une fois la trace démarrée, il faut activer les providers avec EnableProvider.
constructor TETWTraceControler.Create(aName: string; aFileName : string);
begin
  // On mémorise les paramètres d'appel.
  FName := aName;
  FFileName := aFileName;
  FControlGuid := ETWTraceControlerGuid;
  // Il faut toujours commencer par initialiser la structure à 0.
  fillchar(FTrcProps, sizeof(FTrcProps), 0);
  FTrcProps.Props.Wnode.BufferSize := sizeof(FTrcProps); // On définit la taille
  // de la structure.
  FTrcProps.Props.Wnode.Flags := WNODE_FLAG_TRACED_GUID; // Valeur obligatoire.
  FTrcProps.Props.Wnode.ClientContext := 1; // Les TimeStamp seront définis
  // avec les compteurs de performance
  // windows.
  FTrcProps.Props.Wnode.Guid := FControlGuid; // Identifiant de la session.
  FTrcProps.Props.BufferSize := 64; // Taille des buffers en Ko.
  FTrcProps.Props.MinimumBuffers := 8; // Nombre de buffer à pré allouer.
  FTrcProps.Props.MaximumBuffers := 16; // Nombre maximum de buffers.
  
  // LoggerNameOffset doit être initialisé avec l'offset de SessionName
  // par rapport à la structure EVENT_TRACE_PROPERTIES. Ca aurait dû être
  // sizeof(FTrcProps.Props). Cependant, avec cette valeur, StartTrace renvoie
  // toujours ERROR_INVALID_PARAMETER.
  // Par contre une valeur de 128 (>à la position normale) est acceptée.
  // Il s'agit peut être d'un problème d'alignement des adresses en mémoire.
  // C'est pourquoi j'ai ajouté un champ Filler pour aligner SessionName sur
  // l'offset 128.
  FTrcProps.Props.LoggerNameOffset := sizeof(FTrcProps.Props) +
    sizeof(FTrcProps.filler);
  FTrcProps.Props.LogFileNameOffset := FTrcProps.Props.LoggerNameOffset +
    sizeof(FTrcProps.SessionName);

  // On définit le nom du fichier de trace.
  // Attention, pour TETWTraceControler, un nom de fichier vide signifie une trace
  // temps réel. Cependant avec ETW, il est possible de définir une trace temps
  // réel et un nom de fichier. En principe, ETW envoie alors les événements au
  // client en temps réel, tout en les écrivant sur disque.
  strcopy(@FTrcProps.FileName[0], PChar(FFileName));

  if aFileName = '' // Pas de nom de fichier, on crée une trace temps réel.
  then begin
    FTrcProps.Props.LogFileMode := EVENT_TRACE_REAL_TIME_MODE or
      EVENT_TRACE_USE_PAGED_MEMORY;
    FTrcProps.Props.LogFileNameOffset := FTrcProps.Props.LoggerNameOffset +
      sizeof(FTrcProps.SessionName);
      
    FTrcProps.Props.FlushTimer := 1; // Les buffers doivent être écrits toutes
    // les secondes.
  end
  else begin
    // On a un nom de fichier, on crée une trace fichier.
    FTrcProps.Props.LogFileMode := EVENT_TRACE_FILE_MODE_CIRCULAR or
      EVENT_TRACE_USE_PAGED_MEMORY;
    FTrcProps.Props.MaximumFileSize := 100;
  end;
  
  // Commence par essayer d'arrêter la trace pour le cas où il existerait déjà
  // une trace avec le même nom. C'est par exemple le cas si on a démarré une
  // trace temps réel et que le contrôleur n'a pas été fermé proprement.
  StopTrace(0, PChar(FName), @FTrcProps);
  
  // On demande à ETW de démarrer la trace.
  if StartTrace(FRunningSession, PChar(FName), @FTrcProps)<>ERROR_SUCCESS
    then raiseLastOSError;

  FEnabledProviders := TStringList.Create;
end;

TTraceProperties = packed record
  Props : EVENT_TRACE_PROPERTIES;
  filler : array[0..11] of char;
  SessionName : array[0..511] of char;
  FileName : array[0..511] of char;
end;

// Détruit la classe et libère les ressources associées. La trace est alors
// arrêtée.
destructor TETWTraceControler.Destroy;
var i : integer;
begin
  // On commence par désactiver tous les providers qui ont été activés.
  if Assigned(FEnabledProviders)
  then begin
    // On parcourt la liste à l'envers car DisableProvider va retirer le
    // provider de la liste au fur et à mesure que ces derniers sont désactivés.
    for i := FEnabledProviders.Count -1 downto 0 do
    begin
      DisableProvider(StringToGuid(FEnabledProviders[i]));
    end;
    FEnabledProviders.Free;
  end;
  // Arrête la trace en lui envoyant l'événement EVENT_TRACE_CONTROL_STOP
  // FTrcProps a été initialisé au moment de la création de la trace.
  ControlTrace(FRunningSession, nil, @FTrcProps, EVENT_TRACE_CONTROL_STOP);
end;

// Désactive le provider <Guid> pour la session de trace. Ce dernier n'écrit
// plus d'événement dans la trace.
procedure TETWTraceControler.DisableProvider(Guid: TGUID);
var idx : integer;
begin
  // Arrêt du provider dans ETW.
  if EnableTrace(TRACE_OFF, 0, 0, @GUID, FRunningSession)<>ERROR_SUCCESS
  then RaiseLastOSError;
  
  // On doit à présent retirer le provider de la liste des providers actifs.
  idx := FEnabledProviders.IndexOf(GuidToString(Guid));
  if idx<>-1
  then FEnabledProviders.Delete(idx);
end;

// Active le provider <Guid> pour la session de trace, avec le niveau de trace
// <EnableLevel> et les flags <EnableFlags>.
procedure TETWTraceControler.EnableProvider(Guid : TGUID; EnableLevel : byte;
  EnableFlags : cardinal);
begin
  // On commence par vérifier si le provider n'a pas déjà été activé.
  if FEnabledProviders.IndexOf(GuidToString(Guid)) = -1
  then begin
    // Activation du provider.
    if EnableTrace(TRACE_ON, EnableFlags, EnableLevel,
      @GUID, FRunningSession)<>ERROR_SUCCESS
    then RaiseLastOSError;

    // On ajoute le provider à la liste des providers déjà activés.
    FEnabledProviders.Add(GuidToString(Guid));
  end;
end;

// Retourne dans <aList> la liste des providers disponibles dans ETW, c'est
// à dire, ceux qui se sont déclarés avec RegisterTraceGuids.
class procedure TETWTraceControler.EnumerateRegisteredProviders(
  aList: TStrings);
var nbProviders : cardinal;
    Properties : array of TRACE_GUID_PROPERTIES;
    PropertiesPtr : array of PTRACE_GUID_PROPERTIES;
    MaxProv : cardinal;
    i : integer;
    result : cardinal;
    s : string;

    // Initialise les tableaux <Properties> et <PropertiesPtr> pour stocker un
    // maximum de <nbProv>.
    procedure InitTabs(nbProv : integer);
    var i : integer;
    begin
      // Properties est un tableau linéaire de structures TRACE_GUID_PROPERTIES.
      // PropertiesPtr est un tableau qui pointe sur les éléments de Properties
      // un à un.
      SetLength(Properties, nbProv);
      SetLength(PropertiesPtr, nbProv);

      // On commence par initialiser les tableaux à 0.
      fillchar(Properties[0], sizeof(TRACE_GUID_PROPERTIES) * nbProv, 0);

      // Il ne reste plus qu'à initialiser chaque élément de PropertiesPtr pour les
      // faire pointer sur un élément de Properties.
      for i := 0 to nbProv -1 do
      begin
        PropertiesPtr[i] := @Properties[i];
      end;
    end;

begin
  Assert(Assigned(aList)); // aList doit avoir été initialisé créé par
                           // l'appelant.
  aList.Clear;

  // Par défaut, on prévoie de lire 50 providers.
  MaxProv := 50;
  nbProviders := MaxProv;

  // On prépare un tableau pour MaxProv fournisseurs au maximum.
  InitTabs(MaxProv);

  // On demande à ETW d'énumérer les providers déclarés.
  // EnumerateTraceGuids va remplir le tableau Properties avec la liste des
  // providers disponibles. <MaxProv> indique la taille maximal du tableau.
  // En retour <nbProviders> contiendra le nombre total de provider déclaré dans
  // ETW.
  // Si le tableau Properties est trop petit (il y a plus 50 providers déclaré)
  // EnumerateTraceGuids renverra le code de retour ERROR_MORE_DATA. Dans ce cas
  // il faut recommencer l'opération avec un tableau plus grand.
  result := EnumerateTraceGuids(PropertiesPtr, MaxProv, nbProviders);
  case result of
    ERROR_SUCCESS:; // Tout est Ok.
    ERROR_MORE_DATA: // Il y a plus de provider que prévu, il faut agrandir le
                     // tableau.
      begin
        MaxProv := nbProviders;
        InitTabs(MaxProv); // On redéfinit les tableaux. Cette fois on connait le
        // nombre exact de providers qui seront renvoyés.
        // Il ne reste plus qu'à refaire la lecture.
        if EnumerateTraceGuids(PropertiesPtr, MaxProv, nbProviders)<>ERROR_SUCCESS
        then raiseLastOSError;
      end;
    else RaiseLastOSError;
  end;

  // Les informations ont été obtenues dans Properties. On met le résultat en
  // forme pour remplir <aList>.
  for i := 0 to nbProviders-1 do
  begin
    s := GuidToString(Properties[i].Guid);
    if Properties[i].IsEnable<>0
    then s := s + '=1'
    else s := s + '=0';
    aList.Add(s);
  end;
end;

type
  // TETWClient
  // Cette classe permet de lire une trace existante et traiter ses événements.
  TETWClient = class(TObject)
  private
    FWorkerThread : TThread;
    FTrace : EVENT_TRACE_LOGFILE; // en-tête de la trace qui a été ouverte.
    FList : TList; // Liste des événements de la trace.
    FSession : TRACEHANDLE; // Handle de la trace ouverte.
    FTraceMutex : Cardinal;
  protected
    // ProcessEvent est appelée par la fonction callback chaque fois qu'un
    // événement de la trace est lu. Cette méthode s'occupe de décoder
    // l'enregistrement et de le mémoriser.
    procedure ProcessEvent(pEvent : PEVENT_TRACE); virtual;

  public
    // Crée et initialise une nouvelle instance de la classe TETWClient :
    // Ouvre une trace existante et commence à lire ses événement. On peut lire
    // une trace fichier ou une trace temps réel.
    // Si on ouvre une trace fichier, le constructeur rend la main une fois que
    // tous les événements de la trace ont été lus.
    // Si on ouvre une trace temps réel, le constructeur rend immédiatement la
    // main, les événements seront lus au fur et à mesure de leur réception en
    // tâche de fond.
    // <Name> : Si on veut ouvrir une trace fichier, <Name> doit contenir le nom
    //          du fichier .etl à ouvrir. Si on veut ouvrir une trace temps réel,
    //          <Name> doit contenir le nom de la session de trace à ouvrir.
    // <IsRealTime> : Indique si on veut ouvrir une trace temps réel (true) ou
    //                une trace fichier (false).
    // ATTENTION: TETWClient ne peut traiter qu'une seule trace à la fois.
    //            Ca ne pose pas de problème avec les traces fichiers puisque
    //            le constructeur ne rend la main qu'une fois le traitement de
    //            la trace terminé.
    //            En revanche, si on lit une trace temps réel, on ne pourra pas
    //            lire d'autres traces tant que la trace n'aura pas été arrêtée !
    constructor Create(Name : string; IsRealTime : boolean);

    // Détruit la classe et libère les ressources.
    destructor Destroy; override;

    // Fonction utilitaire permettant de convertir les timestamps de la trace
    // en Date et Heure Delphi.
    function GetDateTime(ClockTime : int64) : TDateTime;

    // Efface les événements de la trace.
    procedure ClearTrace;

    // Ajoute l'événement Event dans la trace.
    procedure AddEvent(Event : TEventTrace);

    // Indique que l'on veut modifier la trace. Cette méthode permet d'obtenir
    // un accès exclusif à la trace.
    procedure Lock;

    // Indique que l'on a finit de modifier la trace.
    procedure UnLock;

    // Trie la trace par ordre chronologique.
    procedure SortTrace;

    // Liste des événements lus depuis la trace.
    property Trace : TList read FList;
  end;

constructor TETWClient.Create(Name: string; IsRealTime: boolean);
var result : cardinal;
begin
  // On ne peut traiter qu'une seule trace à la fois. Il faut donc commencer
  // par vérifier qu'aucune autre trace n'est en cours de traitement.
  if Assigned(ActiveClient)
  then raise Exception.Create('Il y a déjà une trace en cours de traitement.');

  // On prépare une structure EVENT_TRACE_LOGFILE pour ouvrir la trace.
  fillchar(FTrace, sizeof(FTrace), 0); // Initialise la structure à 0.

  if isRealTime
  then begin
    // Pour les traces temps réel, il faut initialiser LoggerName avec le nom
    // de la trace.
    FTrace.LoggerName := PChar(Name);

    // Le mode de traitement de la trace doit également être Temps réel.
    FTrace.LogFileMode := EVENT_TRACE_REAL_TIME_MODE;
  end
  else begin
    // Pour les traces fichiers, il faut indiquer le nom du fichier à traiter
    // dans LogFileName.
    FTrace.LogFileName := PChar(Name);
  end;

  // On définit la méthode Callback pour traiter les événements.
  FTrace.EventCallback := EventCallback;

  // Il ne reste plus qu'à ouvrir la trace.
  FSession := OpenTrace(@FTrace);
  if FSession = INVALID_HANDLE_VALUE
  then raiseLastOSError;

  // Pour les traces temps réel, l'information TimeZone n'est pas écrite dans
  // L'en-tête. Il faut la lire auprès du système.
  if IsRealTime
  then GetTimeZoneInformation(FTrace.LogfileHeader.TimeZone);

  // Remarque : Dans ETW, il est possible de lire plusieurs fichiers de trace
  //            en appelant plusieurs fois OpenTrace avec des fichiers
  //            différents.
  //            Les événements provenant de chaque fichier sont alors mélangés
  //            et ordonnés d'après leur timestamp pour être restitués dans
  //            l'ordre au client.
  //            Cependant notre implémentation ne traite qu'un seul fichier à
  //            la fois.

  FList := TList.Create; // Initialise la liste des événements de la trace.

  // Maintenant il faut lancer le traitement des événements. Pour une trace
  // temps réel, on délègue cette opération à un thread distinct. Pour une trace
  // fichier on effectue le traitement immédiatement.
  if IsRealTime
  then FWorkerThread := TWorkerThread.create(self)
  else begin
    // On commence par se définir comme la trace en cours de traitement.
    ActiveClient := self;
    try
      // L'appel de ProcessTrace demande à ETW de commencer à lire les
      // événements et d'appeler la méthode Callback.
      result := ProcessTrace(@FSession, // Session à traiter.
                             1,         // Une seule session à traiter.
                             nil,       // Pas de date de début.
                             nil);      // Ni de date de fin.
      if (result<>ERROR_SUCCESS) and (result<>ERROR_CANCELLED)
      then raiseLastOSError;
    finally
      // Le traitement de la trace est terminé.
      ActiveClient := nil;
    end;
  end;
end;