Envoyer des chaînes ou des structures par PostMessage

Il est fréquent de vouloir notifier à l'utilisateur l'avancement d'une tâche en lui présentant un certain nombre d'informations à l'écran. Malheureusement, la plupart des méthodes proposées sont synchrones, que ce soit par Synchronize, WM_COPYDATA, fichier mappé et par conséquent entraîne un arrêt du thread secondaire le temps du traitement par le thread principal.

Ce tutoriel va vous expliquer comment mettre en œuvre une façon simple d'envoyer n'importe quel type de données en asynchrone par PostMessage à l'aide de la table d'atomes.

Qu'est-ce qu'un atome ? Un atome est un identificateur sur 16 bits d'une chaîne de caractères. La table d'atomes est donc simplement une liste de chaînes.

La chaîne peut être « numérique » si le texte est de la forme #1234. L'atome représente alors cette valeur. Sinon elle est de type « texte ». Les atomes « textes » et « numériques » ont chacun leur zone propre dans la table atomique. Les « numériques » vont de $0001 à $BFFF (MAXINTATOM -1) alors que les « textes » de $C000 (MAXINTATOM) à $FFFF.

Chaque chaîne est unique. Enregistrer plusieurs fois la même chaîne, indépendamment de la casse, renverra toujours le même atome. La table d'atomes nous permet ainsi de partager une même chaîne par l'intermédiaire de son identificateur.

Une chaîne est limitée à 255 octets. Soit 255 caractères en ANSI ou 127 en Unicode.

À l'instar de la gestion des chaînes sous Delphi, un compteur de référence est utilisé. Chaque ajout doit donc obligatoirement être suivi d'une libération. L'atome n'est effectivement supprimé que lorsque le compteur est à 0. Ce compteur ne s'applique qu'aux chaînes « textes ». Les « numériques » n'en possèdent pas.

Les tables sont gérées par le système. Il y en a une globale au système et une par processus. La taille d'une table est de 64 ko (atome max. = $FFFF).

Même sans le savoir, nous utilisons régulièrement la table atomique pour :

• stocker les formats du presse-papier ;
• la communication DDE  ;
• les messages enregistrés par RegisterWindowMessage  ;
• etc.

Il y a deux groupes de fonctions : un pour les atomes locaux (propres au processus) et son pendant pour les globaux :

AddAtom (GlobalAddAtom), DeleteAtom (GlobalDeleteAtom), GetAtomName (GlobalGetAtomName), etc.

Nous ne nous intéresserons ici qu'à la table globale. Nous pourrons ainsi aussi envoyer des informations entre processus.

Le principe est très simple : la source ajoute une chaîne à la table et envoie l'atome à la cible. La cible récupère la chaîne associée à l'atome et la supprime de la table.

III-A. Ajouter et envoyer une chaîne courte▲

procedure PostText(aWnd :hWnd; aText :string);
var
  Atom :TAtom;

begin
  Atom := GlobalAddAtom(PChar(aText));

  if not PostMessage(aWnd, WM_USER, Atom, 0) then
     GlobalDeleteAtom(Atom);
end;

III-B. Lire et libérer▲

type
  TForm1 = class(TForm)
  protected
    procedure WMGetTextMessage(var Message :TMessage); message WM_USER;
  end;

procedure TForm1.WMGetTextMessage(var Message: TMessage);
var
  Len  :byte;
  Atom :TAtom;
  Text :string;

begin
  //Chaîne de max 255 octets
  SetLength(Text, MAXBYTE div SizeOf(Char));

  //Lecture de la table et récupération de la longueur réelle
  Len := GlobalGetAtomName(Message.WParam, PChar(Text), Length(Text));

  //Longeur réelle
  SetLength(Text, Len);

  //Supression de la chaîne
  GlobalDeleteAtom(Message.WParam);

  //Traitement
end;

Nous avons vu jusqu'ici comment envoyer une chaîne courte. Voyons maintenant comment envoyer une chaîne de plus de 255 octets ou carrément une structure plus complexe comme un record ou un stream.

Une chaîne de caractères n'étant finalement rien d'autre qu'une suite d'octets, nous allons simplement mettre en place un système de sérialisation des données en découpant notre variable en bloc de N bytes et en y ajoutant un atome représentant le bloc suivant. Les fonctions attendant des PChar en paramètre, nous utiliserons des pointeurs non typés (@Data) pour passer au travers du compilateur.

Et puisque nous ne nous intéressons qu'à des octets, nous utiliserons les fonctions ANSI : GlobalAddAtomA, GlobalDeleteAtomA, etc.

La structure dans le cas d'une chaîne longue se présenterait donc ainsi :

const
  MaxChars = (MAXBYTE -SizeOf(TAtom)) div SizeOf(Char);

Type
  TData = packed record
    Next  :TAtom;
    Chars :array[0..MaxChars -1] of char;
  end;

Mais nous allons directement pousser plus loin le concept et créer une structure plus complète qui acceptera n'importe quel type de donnée.

const
  MaxBytes = (MAXBYTE -SizeOf(TAtom) -2) div 2;

type
  TData = packed record
    Next  :TAtom;
    Len   :byte;
    Bytes :string[MaxBytes *2];
    Null  :ansichar;
  end;

Le record contient un atome sur le bloc suivant (Next), la taille du bloc (Len), le bloc de données (Bytes) et un caractère de fin de chaîne #0 (Null).

Définir la longueur d'une chaîne dans la déclaration d'une variable (string[]) la transforme automatiquement en tableau de AnsiChar, même si l'application est Unicode !

Il ne faut pas oublier que les atomes représentent des chaînes à zéro terminal. À part la variable Null qui assure la validité de la pseudochaîne, aucun octet du record ne doit être à zéro sous peine de se retrouver avec une donnée tronquée, voire une violation d'accès !

Puisque notre pseudochaîne n'accepte pas les zéros, nous allons ajouter deux fonctions pour convertir nos octets en caractères « 0 » à « F » et inversement. Un octet de donnée réelle utilisera donc deux octets à l'envoi (d'où le div 2 pour le calcul de MaxBytes).

const
  Codes : array[0..$F] of ansichar = '0123456789ABCDEF';

function StrToByte(aText :string; aIndex :integer) :byte; inline;
begin
  Result := ((Pos(aText[aIndex], Codes) -1) shl 4) or
            (Pos(aText[aIndex+1], Codes) -1);
end;

function ByteToStr(aByte :byte) :string; inline;
begin
  Result := Codes[aByte shr 4]
           +Codes[aByte and $F];
end;

Pour la même raison, Next (l'atome suivant) ne peut pas être à zéro pour signifier la fin de la donnée. Nous ne pouvons pas non plus prendre n'importe quelle autre valeur pour ne pas accidentellement lire un atome sans rapport. La table utilisable allant de MAXINTATOM ($C000) à $FFFF, nous allons choisir MAXINTATOM -1 ($BFFF). Nous appellerons cette constante EOD (End Of Data).

const
  EOD = MAXINTATOM -1;  //End Of Data ($BFFF)

Par sécurité, nous déclarerons encore une table contenant tous les atomes créés. En cas de problème dans l'application, elle nous permettra de nettoyer la table à la fermeture et ainsi de ne pas obliger l'utilisateur à quitter sa session.

Chaque élément représente un compteur de référence de l'atome concerné. Il ne faut pas oublier que deux chaînes identiques renvoient le même atome et par conséquent, plusieurs de nos données en attente de traitement pourraient partager le même !

var
  GlobalAtoms :array[MAXINTATOM..$FFFF] of byte;

procedure ClearPostMessageTable;
var
  i :integer;

begin
  for i := Low(GlobalAtoms) to High(GlobalAtoms) do
    while GlobalAtoms[i] > 0 do
    begin
      GlobalDeleteAtom(i);
      Dec(GlobalAtoms[i]);
    end;
end;

initialization
  ZeroMemory(@GlobalAtoms, SizeOf(GlobalAtoms));

finalization
  if ClearTableOnExit then
    ClearPostMessageTable;

À la finalisation, ClearPostMessageTable est conditionné par une variable booléenne ClearTableOnExit au cas où les messages devaient persister après la sortie du programme. Par exemple pour une application console qui notifie un résultat et quitte immédiatement. ClearTableOnExit est fixé à vrai par défaut.

var
  ClearTableOnExit :boolean = TRUE;

V-A. Envoyer un buffer▲

function PostBufferMessage(aWnd :hWnd; aMessage :cardinal; aBuffer :PByte; aLen :integer) :integer;
var
  Data  :TData;
  Atoms :array of TAtom;
  Count :integer;
  i     :integer;

begin
  ZeroMemory(@Data, SizeOf(Data));

  //La donnée est traitée depuis la fin => Next = EOD
  Data.Next := EOD;

  try
    //S'il n'y a pas de donnée, envoie une chaîne vide
    if Assigned(aBuffer) then
    begin
      //Table d'atomes nécessaires à l'envoi de la donnée.
      //Si une erreur survient en cours de traitement, permet
      //de libérer les atomes déjà créés.
      SetLength(Atoms, aLen div MaxBytes +1);
      Count := 0;

      //Traîte la donnée depuis la fin. Le faire depuis le début
      //nous obligerait à utiliser une table temporaire et de
      //renuméroter les <Next> dans une deuxième passe.
      for i := aLen -1 downto 0 do
      begin
        //Conversion byte -> caractères
        Data.Bytes := ByteToStr(aBuffer[i]) +Data.Bytes;

        //Taille max atteinte => Stocke la chaîne
        if i mod MaxBytes = 0 then
        begin
          Data.Len  := Length(Data.Bytes) div 2;
          Data.Next := GlobalAddAtomA(@Data);

          //Si erreur, Next = 0. Sinon ajoute l'atome à nos listes
          if Data.Next <> 0 then
          begin
            Atoms[Count] := Data.Next;
            inc(GlobalAtoms[Data.Next]);
            inc(Count);

            //Reset pour prochaine boucle
            Data.Bytes := '';
          end
          else Exit(GetLastError);
        end;
      end;
    end;

    //Envoi
    if PostMessage(aWnd, aMessage, Data.Next, aLen)
    then Result := ERROR_SUCCESS
    else Result := GetLastError;

  finally
    //Libération des atomes déjà créés si erreur
    if Result <> ERROR_SUCCESS then
      for i := 0 to Count -1 do
      begin
        GlobalDeleteAtom(Atoms[i]);
        dec(GlobalAtoms[Atoms[i]]);
      end;
  end;
end;

type
  TRec = record
    Val1  :word;
    Val2  :dword;
    Val3  :extended;
    Val4  :array[0..100] of char;
  end;

var
  Rec :TRec;

procedure TForm1.Button1Click(Sender: TObject);
var
  Wnd   :hWnd;
  Error :integer;
begin
  Wnd := FindWindow('DestClass', 'DestName');

  if Wnd <> 0 then
  begin
    Error := PostBufferMessage(Wnd, WM_USER, @Rec, SizeOf(Rec));

    if Error <> ERROR_SUCCESS then
      Raise Exception.Create(SysErrorMessage(Error));
  end;
end;

V-B. Remplir un buffer▲

function GetBufferMessage(aAtom :TAtom; aBuffer :PByte; aLen :integer) :integer;
var
  Data :TData;
  i    :integer;

begin
  //Result renvoie la taille de la donnée
  Result := 0;

  //Lit tant que "End Of Data" n'est pas atteint
  while aAtom <> EOD do
    if GlobalGetAtomNameA(aAtom, @Data, SizeOf(Data)) <> 0 then
    begin
      inc(Result, Data.Len);

      //Si le buffer n'est pas spécifié (nil), l'atome n'est pas supprimé
      //et la fonction sert uniquement à récupérer la taille totale de la
      //donnée en vue de l'allocation d'un buffer
      if Assigned(aBuffer) then
      begin
        //Supprime l'atome
        GlobalDeleteAtom(aAtom);
        dec(GlobalAtoms[aAtom]);

        i := 1;

        if Data.Len < aLen then
          aLen := Data.Len;

        //Convertit la chaîne en octets
        while i < aLen *2 do
        begin
          aBuffer^ := StrToByte(Data.Bytes, i);
          inc(i, 2);
          inc(aBuffer);
        end;
      end;

      //Atome suivant
      aAtom := Data.Next;
    end
    else
    begin
      Result := 0;
      Break;
    end;
end;

  TForm1 = class(TForm)
  protected
    procedure WMGetBuffertMessage(var Message :TMessage); message WM_USER;
  end;

procedure TForm1.WMGetBuffertMessage(var Message: Tmessage);
var
  Rec :TRec;

begin
  GetBufferMessage(Message.WParam, @Rec, SizeOf(Rec));

  //Traitement
end;

Maintenant que les fonctions génériques par buffer sont créées, il est facile de les encapsuler pour d'autres types de données.

VI-A. Chaînes longues▲

function PostTextMessage(aWnd :hWnd; aMessage :Cardinal; aText :string) :integer;
begin
  Result := PostBufferMessage(aWnd, aMessage, @aText[1], Length(aText) *SizeOf(Char));
end;

function GetTextMessage(aAtom :TAtom) :string;
var
  Len :integer;

begin
  Len := GetBufferMessage(aAtom, nil, 0);
  SetLength(Result, Len div SizeOf(Char));
  GetBufferMessage(aAtom, @Result[1], Len);
end;

VI-B. Streams▲

function PostStreamMessage(aWnd :hWnd; aMessage :Cardinal; aStream :TStream) :integer;
var
  Buffer :array of byte;

begin
  SetLength(Buffer, aStream.Size);
  aStream.Position := 0;
  aStream.Read(Buffer[0], aStream.Size);

  Result := PostBufferMessage(aWnd, aMessage, @Buffer[0], aStream.Size);
end;

function GetStreamMessage(aAtom :TAtom; aStream :TStream) :integer;
var
  Buffer :array of byte;

begin
  Result := GetBufferMessage(aAtom, nil, 0);
  SetLength(Buffer, Result);
  GetBufferMessage(aAtom, @Buffer[0], Result);

  aStream.Write(Buffer[0], Result);
end;

Il n'y a en fait qu'une seule réelle limitation : le nombre d'atomes disponibles dans la table atomique.

S'il n'y avait aucun atome utilisé, la taille maximale de la donnée serait de $FFFF -$C000 (MAXINTATOM) *125 (MaxBytes) +1, soit 2 048 000 octets. Dans la réalité, ce ne sera évidemment pas le cas. D'autres applications en auront déjà consommé quelques-uns et il n'y a aucun moyen de savoir combien !

Une table atomique pleine renverra l'erreur 8 (ERROR_NOT_ENOUGH_MEMORY) : Espace insuffisant pour traiter cette commande.

À prendre aussi en considération :

• le broadcasting (HWND_BROADCAST) n'est pas supporté par cette méthode puisque le premier « lecteur » va effacer la donnée ;
• le principe du codage/décodage est assez lent (pourrait être optimisé) et même s'il est théoriquement possible d'envoyer jusqu'à 2 MB, je ne conseille pas de dépasser les quelques centaines de kilos. Asynchrone oui, mais faut pas pousser !

Ce tutoriel est maintenant terminé !

Je pense que nombre d'entre vous auront découvert les atomes et certainement cette façon détournée de les utiliser.

L'unité MessageEx.pas est disponible au format ZIP. Il vous suffit de l'ajouter à la clause uses pour l'utiliser dans votre application et de laisser aller votre imagination pour envoyer du texte, des images et tout ce qui vous passera par la tête !

MessagesEx.zip

Un grand merci à ClaudeLELOUP pour la relecture orthographique.

MSDN : About Atom Tables