Hint von einem TNA - Icon auslesen

[Yheeky]

Hi,

das Topic sagt eigentlich schon alles. Ich habe von einem Programm den Namen der Exedatei und möchte damit das TNA - Icon finden. Davon möchte ich dann den Hint auslesen. Wie kann ich das machen?

Gruß Yheeky

[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. :twisted:

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. :wink:

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.

[Yheeky]

Danke erstmal für den Code!

Ich habe da aber ein Problem. Wenn ich die Funktion bei OnCreate aufrufe, sehe ich das Programm nicht. Wenn ich das Ereignis mit einem Button ausführen möchte, kommt sogar eine Zugriffsverletzung. Mache ich da was falsch?

Gruß Yheeky

[jbg]

Du machst nicht unbedingt was falsch.
Das da oben ist schon eine sehr "brutale" Methode um diese Informationen zu bekommen. Bei ReadProcessMemory ist die Change eine Schutzverletzung zu erhalten sehr groß.
PS: Ich wüsste aber auch keine andere Methode an die Informationen heranzukommen.

[MathiasSimmack]

Brutal ist das richtige Wort. Unter Win XP sehe ich nämlich mit diesem Code gar keine Infos. Den Fehler im "OnCreate" kann ich unter Win98 daher nicht nachvollziehen. Funktioniert problemlos.

[Yheeky]

Yep, das kann sein...ich habe WinXP. Gibt´s da vielleicht eine XP Lösung?

Gruß Yheeky

[jbg]

Ich habe da so eine Funktion gefunden, mit der man sich das Recht ergattert, in einem anderen Prozess herumzufuhrwerken. Rufe diese Funktion einmal auf, bevor du enumTrayIcons() aufrufst. Es könnte damit unter WinXP funktionieren (habe es nicht ausprobiert), aber dann nur unter WinNT/2k/XP.

Code:

procedure EnableDebugPriv;
var
  hToken: THandle;
  sedebugnameValue: Int64;
  tkp: TTokenPrivileges;
  ReturnLength: Cardinal;
begin
  // enable the SeDebugPrivilege
  if (not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)) then
    raise Exception.CreateFmt('OpenProcessToken() failed, Error = %d SeDebugPrivilege is not available.', [GetLastError]);

  try
    if (not LookupPrivilegeValue(nil, SE_DEBUG_NAME, sedebugnameValue)) then
      raise Exception.CreateFmt('LookupPrivilegeValue() failed, Error = %d SeDebugPrivilege is not available.', [GetLastError]);

    tkp.PrivilegeCount := 1;
    tkp.Privileges[0].Luid := sedebugnameValue;
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

    ReturnLength := 0;
    if (not AdjustTokenPrivileges(hToken, False, tkp, SizeOf(tkp), nil, ReturnLength)) then
      raise Exception.CreateFmt('AdjustTokenPrivileges() failed, Error = %d SeDebugPrivilege is not available.', [GetLastError]);

  finally
    CloseHandle(hToken);
  end;
end;

[Yheeky]

Danke erstmal für die Hilfe!
Der Compiler findet aber noch einen Fehler. Es wird SE_DEBUG_NAME als undefinierter Bezeichner markiert. Ich habe diese Zeile auch schonmal in Kommentare gesetzt (die Zeile unten drunter auch noch), aber dann geht es nicht...scheint also wichtig zu sein. Es ist bestimmt nur eine Datei, die ich bei Uses hinzufügen muss, aber welche? Wäre gut, wenn du mir das noch sagen könntest!

Gruß Yheeky

[jbg]

Den Fehler hatte ich auch, hab mir dann aber eine Konstante deklariert, die so lautet:

Code:

const SE_DEBUG_NAME = 'SeDebugPrivilege';

Beim Copy hab ich dann wohl vergessen diese mitzumarkieren. Naja jetzt hast du sie ja.

[Yheeky]

Kommt leider immer noch ein Zugriffsfehler :(