atom table monitor

Outil de surveillance pour la table d'atomes globale et les identificateurs de registrewindowMessage.

"Une table atome est une table définie par système qui stocke les chaînes et les identificateurs correspondants. Une application place une chaîne dans une table d'atomes et reçoit un entier 16 bits, appelé atome, qui peut être utilisé pour accéder à la chaîne. Une chaîne qui a été placée dans une table atome est appelée un nom d'atomes"

Source : Microsoft - À propos des tables atomes

Avec le moniteur de table atome, tous les atomes créés à l'aide de laclasse de registre, RegisterClassex, GlobalAddatom, Adatom ou identificateurs des fonctions RegisterWindowMessage peuvent être surveillés et assurez-vous que nos applications ne fuisent pas des atomes / identificateurs.

Articles connexes:

• Surveillance du tableau des atomes mondiaux Partie I
• Surveillance du tableau des atomes mondiaux Partie II
• Surveillance du tableau des atomes mondiaux Partie III

Caractéristiques:

• Surveillez les entrées d'atomes globales de 0xc000 à 0xFFF à l'aide de GlobalGetAtomName.
• Monitor RegisterWindowMessage ATOM INTRIES (Identificateurs) de 0xc000 à 0xFFF à l'aide de GetClipboardFormatName.
• Mémoire affichée d'une manière agréable à l'aide d'une grille de mémoire.
• Faites correspondre le modèle en utilisant des expressions régulières.
• Graphique affichant les valeurs actuelles.
• Test des entrées de table à l'aide de fonctions GlobalAdDatom et RegisterwindowMessage.
• Surveillance des atomes de session utilisateur et des atomes de session de service.
• Prise en charge de Windows 10.

Notes:

• Il utilise * c: * lecteur pour une utilisation interne car il est codé dur. (Assurez-vous d'avoir ce lecteur dans votre système)

Version 1.6:

Tableau d'atomes mondiaux: Tableau RegisterwindowMessage: Afficher la liste des entrées: Modèles de chaîne correspondant: Compteurs: Écran de test: Sélection de l'écran de session: Surveillance des atomes de session de service:

Méthode des atomes de balayage:

 procedure ScanAtoms ;
var
  i: word;
  cstrAtomName: array [ 0 .. 1024 ] of char;
  cstrRWMName: array [ 0 .. 1024 ] of char;
  AtomName, RWMName: string;
  len, lenRWM: integer;
  Value : string;
  countAtom, countRWM: integer;
begin
  countAtom := 0 ;
  countRWM := 0 ;
  for i := $C000 to $FFFF do
  begin
    Value := ' ' ;
    len := GlobalGetAtomName(i, cstrAtomName, 1024 );
    lenRWM := GetClipboardFormatName(i, cstrRWMName, 1024 );
    if len > 0 then
    begin
      AtomName := StrPas(cstrAtomName);
      SetLength(AtomName, len);
      Value := AtomName;
      Inc(countAtom);
      FATomTable[i - $C000].atom[ 0 ] := Value + '  --GlobalAtom ' ;
    end ;
    if lenRWM > 0 then
    begin
      RWMName := StrPas(cstrRWMName);
      SetLength(RWMName, lenRWM);
      Value := RWMName;
      Inc(countRWM);
      FATomTable[i - $C000].atom[ 1 ] := Value + '  --RWM ' ;
    end ;
  end ;
end ;

Utilisation d'expressions régulières:

 function GetColor (Text: string): TColor;
  var
    i: integer;
    perl: TPerlRegEx;
    res: TColor;
  begin
    res := clGray;
    for i := 0 to FListPatterns.count - 1 do
    begin
      perl := TPerlRegEx.Create;
      try
        perl.RegEx := UTF8String(FListPatterns[i].RegularEx);
        perl.Subject := UTF8String(Text);
        if perl.Match then
        begin
          res := FListPatterns[i].color;
          Break;
        end ;
      finally
        perl.Free;
      end ;
    end ;
    result := res;
  end ;

Essai:

 procedure AddatomClick (Sender: TObject);
var
  i: integer;
begin
  try
    GlobalAddAtom(PChar(getRandomString(Edit4.Text)));
    if GetLastError <> 0 then
    begin
      ShowMessage(IntToStr(GetLastError) + ' ' + SysErrorMessage(GetLastError));
      Break;
    end ;
  Except
    on e: exception do
      ShowMessage(e.message + ' ' + IntToStr(GetLastError));
  end ;
end ;

procedure RWMAddAtom (Sender: TObject);
var
  i: integer;
  myString: string;
begin
  myString := getRandomString(Edit8.Text);
  try
    RegisterWindowMessage(PWideChar(myString));
    if GetLastError <> 0 then
    begin
      ShowMessage(IntToStr(GetLastError) + ' ' + SysErrorMessage(GetLastError));
      Break;
    end ;
  Except
    on e: exception do
      ShowMessage(e.message + ' ' + IntToStr(GetLastError));
  end ;
end ;

function getRandomString (header: string): string;
const
  Chars = ' 1234567890ABCDEFGHJKLMNPQRSTUVWXYZ!?/*+- ' ;
var
  S: string;
  i, N: integer;
begin
  Randomize;
  S := ' ' ;
  for i := 1 to 6 do
  begin
    N := Random(Length(Chars)) + 1 ;
    S := S + Chars[N];
  end ;
  result := header + S;
end ;

Tests à l'aide de registreclassex

 procedure btnCreateClick (Sender: TObject);
var
  WC: TWndclassEx;
  atom: word;
begin
  WC.lpszclassName := PWideChar(Edit10.Text);
  WC.cbSize := SizeOf(TWndclassEx);
  WC.style := CS_VREDRAW or CS_HREDRAW;
  WC.lpfnWndProc := @DefWindowProc;
  WC.cbClsExtra := 0 ;
  WC.cbWndExtra := 0 ;
  WC.hinstance := hinstance;
  WC.hIcon := Application.Icon.Handle;
  WC.hIconSm := Application.Icon.Handle;
  WC.hCursor := LoadCursor( 0 , IDC_ARROW);
  WC.lpszMenuName := nil ;
  WC.hbrBackground := (COLOR_BACKGROUND + 1 );

  atom := RegisterClassEx(WC);
  if atom <> 0 then
    ShowMessage( ' Atom Created at ' + IntToHex(atom, 4 ));
end ;

Testé sous:

• Windows XP, Vista, 7, Server 2003, Server 2008, Windows 10

Développé sous:

• Delphi 2010

Entrée StackOverflow:

• Erreur système. Code: 8. Pas assez de stockage est disponible pour traiter cette commande

Entrée de blog Microsoft Debug:

• Identifier les fuites de table d'atomes globales.

Sponsors

Pas encore de sponsors! Serez-vous le premier?