Hint von einem TNA - Icon auslesen

[MathiasSimmack]

Hi Yheeky.

Ich hatte mal im Entwickler-Forum eine Funktion gefunden, die generell alle TNA-Programme ausliest. Bisher habe ich sie nie gebraucht, das Programm liegt noch unfertig bei mir rum. Vielleicht hilft´s dir weiter?!

Selbst wenn nicht, das hindert mich jetzt nicht am Posten.

Du brauchst ein Formular mit einer ListView (lv1) im Report-Modus und einer ImageList (lvimg). Du setzt die Eigenschaft "SmallImages" auf die Imageliste. (Das Formular heißt in meinem Fall "HTIMainForm"; das aber nur nebenbei - du müsstest die Namen dann anpassen, wenn du eigene benutzt.)
Die ListView hat vier Spalten (Hint, Wnd, ProcessId, Anwendung) - eine Sortierfunktion kannst du ja selbst einfügen.

1. Diese Units sind erforderlich:

Code:

uses
  ShellAPI, CommCtrl, tlhelp32, psapi;

2. Die "pathfinder"-Funktion brauchen wir, um den Pfad der Anwendung herauszufinden, die das Icon erzeugt. Schließlich soll das Programm ja mehr zeigen als nur den Hint:

Code:

function pathfinder(pid: dword): string;
var
  aSnapshotHandle : THandle;
  ContinueLoop    : boolean;
  aProcessEntry32 : TProcessEntry32;
  i               : integer;
  pidNeeded       : dword;
  PIDList         : array[0..1000] of integer; // Obergrenze !!!
  PIDName         : array [0..MAX_PATH - 1] of char;
  PH              : THandle;
begin
  Result := ''; // default

  if(Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then
    begin
      aSnapShotHandle := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS,0);
      if(aSnapShotHandle = INVALID_HANDLE_VALUE) then exit;

      aProcessEntry32.dwSize := sizeof(aProcessEntry32);
      ContinueLoop := Process32First(aSnapshotHandle,aProcessEntry32);
      while(integer(ContinueLoop) <> 0) do
        begin
          if(aProcessEntry32.th32ProcessID = pid) then
            begin
              Result := aProcessEntry32.szExeFile; break;
            end;
          ContinueLoop := Process32Next(aSnapshotHandle,aProcessEntry32);
        end;

      CloseHandle(aSnapshotHandle);
    end
  else
    begin
      if(psapi.EnumProcesses(@PIDList,1000,pidNeeded)) then
        begin
          for i:= 0 to (pidNeeded div sizeof(integer) - 1) do
            if(PIDList[i] = pid) then
              begin
                PH := OpenProcess(PROCESS_QUERY_INFORMATION or
                  PROCESS_VM_READ,false,PIDList[i]);
                if(PH > 0) then
                  try
                    if(psapi.GetModuleFileNameEx(PH,0,PIDName,sizeof(PIDName)) > 0) then
                      begin
                        Result := string(PIDName);
                      end;
                  finally
                    CloseHandle(PH);
                  end;
              end
        end;
    end;
end;

3. Zu guter Letzt, die private (!) Prozedur aus dem EF, die die Icons ausliest und in der Liste anzeigt.

Code:

procedure THTIMainForm.enumTrayIcons;
type
  TAPointer     = array [0..maxInt shr 2 - 1] of Pointer;
  TPAPointer    = ^TAPointer;
  TTrayIconInfo =
    record
      imageIndex: Cardinal;
      case Boolean of
        false: (notifyIconDataA: TNotifyIconDataA);
        true : (notifyIconDataW: TNotifyIconDataW);
    end;
  TTrayIconsInfo =
    record
      iconCount: Integer;
      trayIconInfos: TPAPointer;
    end;
  TTrayWindowInfo =
    record
      dummy: array [0..6] of Cardinal;
      iconsInfo: ^TTrayIconsInfo;
      iconList: Cardinal;
    end;
var
  wnd  : HWND;
  p1   : POINTER;
  pid,
  ph   : cardinal;
  twi  : TTrayWindowInfo;
  c1   : cardinal;
  il   : array[0..$3FF] of char;
  tisi : TTrayIconsInfo;
  i    : integer;
  tii  : TTrayIconInfo;
  tip  : string;
  ico  : TIcon;
  idx  : integer;
begin
  lv1.Items.Clear; // TListView leeren
  lvimg.Clear; // TImageList leeren
  lv1.Items.BeginUpdate;

  wnd := FindWindowEx(FindWindow('Shell_TrayWnd',nil),0,
    'TrayNotifyWnd',nil);
  p1  := POINTER(GetWindowLong(wnd,0));

  if(p1 <> nil) then
    begin
      GetWindowThreadProcessId(wnd,@pid);
      ph := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,
        false,pid);
      if(ph <> 0) then
        try
          try
            ReadProcessMemory(ph,p1,@twi,sizeof(TTrayWindowInfo),c1);
            ReadProcessMemory(ph,POINTER(twi.iconList),@il,sizeof(il),c1);
            ReadProcessMemory(ph,twi.iconsInfo,@tisi,sizeof(TTrayIconsInfo),c1);

            for i := 0 to tisi.IconCount - 1 do
              begin
                ReadProcessMemory(ph,tisi.trayIconInfos^[i],
                  @tii,sizeof(TTrayIconInfo),c1);

                if(Win32Platform = VER_PLATFORM_WIN32_WINDOWS) then
                  begin
                    tii.notifyIconDataA.cbSize := sizeof(TNotifyIconDataA);
                    tip := tii.notifyIconDataA.szTip;
                  end
                else
                  begin
                    tii.notifyIconDataW.cbSize := sizeof(TNotifyIconDataW);
                    tip := tii.notifyIconDataW.szTip;
                  end;

                GetWindowThreadProcessId(tii.notifyIconDataA.wnd,
                  @pid);

                // Icon holen
                idx := -1;
                ico := TIcon.Create;
                try
                  ico.Handle := ImageList_ExtractIcon(0,
                    cardinal(@il),tii.imageIndex);
                  idx := HTIMainForm.lvimg.AddIcon(ico);
                finally
                  ico.Free;
                end;

                // Daten eintragen
                with lv1 do
                  begin
                    Items.Add;
                    Items[Items.Count-1].Caption := tip;
                    Items[Items.Count-1].SubItems.Add(lowercase('$' +
                      inttohex(tii.notifyIconDataA.Wnd,8)));
                    Items[Items.Count-1].SubItems.Add(lowercase('$' +
                      inttohex(pid,8)));
                    Items[Items.Count-1].SubItems.Add(lowercase(
                      pathfinder(pid)));
                    Items[Items.Count-1].ImageIndex := idx;
                  end;
              end;
          except
          end;
        finally
          CloseHandle(ph);
        end;
    end;

  lv1.Items.EndUpdate;
end;

Schön lang.

Diese "enumTrayIcons"-Prozedur rufst du z.B. im "OnCreate"-Ereignis auf. Zusätzlich - so hab´ ich´s gemacht - solltest du den Shortcut F5 für die Form definieren, so dass du den Status auch zur Laufzeit neu einlesen kannst, ohne das Programm beenden zu müssen.

Gruß,
Mathias.