Jak odczytać uID ikony tray innej aplikacji?

0

Jak w temacie, kiedyś był taki fajny programik Traysaver, ale już nie jest dostępny https://web.archive.org/web/20131108122942/http://www.mlin.net/other.shtml
Może znacie jakiś software albo jak to zrobić w kodzie delphi?

1

BYŁO! A wystarczyło poszukać. Ech, te lenistwo - link: http://4programmers.net/Forum/Newbie/211506-winapi_pobieranie_tekstu_z_ikony_w_trayu - jednak jak w wątku doszliśmy do tego razem z @kAzek - są problemy pod 64 bitowymi Windowsami z odczytaniem tekstu i takie tam. Może to do czego tam doszedł zwłaszcza @kAzek się Tobie do czegoś przyda.

5

Działający na 64 bitowym systemie kod pobierania ikony, podpowiedzi i nazwy aplikacji z Traya:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, PSApi, CommCtrl, ImgList, ComCtrls;

type
  TForm1 = class(TForm)
    btnLoadTrayIconsInfo: TButton;
    ListView1: TListView;
    ImageList1: TImageList;
    procedure btnLoadTrayIconsInfoClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//zwraca sciezkę i nazwe proceu parametr to PID
function GetFilenameFromPid(PID: Cardinal): string;
type
  TQueryFullProcessImageName =  function (hProcess: THandle; dwFlags: DWORD;
    lpExeName: PChar; nSize: PDWORD ): BOOL; stdcall;
var
  QueryFullProcessImageName: TQueryFullProcessImageName;
  hProcess: THandle;
  nLen: Cardinal;
  szPatch: array[0..MAX_PATH] of Char;
begin
  result:= '';
  hProcess:= OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PID);
  if (hProcess > 0) then
  begin
    nLen:= MAX_PATH;
    ZeroMemory(@szPatch, MAX_PATH);
    @QueryFullProcessImageName:= GetProcAddress(GetModuleHandle('kernel32'),
       'QueryFullProcessImageName' + {$IFDEF UNICODE} 'W' {$ELSE} 'A' {$ENDIF});
    if Assigned(QueryFullProcessImageName) then
    begin
      if QueryFullProcessImageName(hProcess, 0, szPatch, @nLen) then
        result:= string(szPatch);
    end
    else
    begin
      if GetModuleFileNameEx(hProcess, 0, szPatch, nLen) > 0 then
        result:= string(szPatch);
    end;
    CloseHandle(hProcess);
  end;
end;

//zwraca uchwyt toolbara traya
function FindTrayToolbarWindow: Cardinal;
const
  WND_CLASS_ARRAY: array [0..3] of
       {$IFDEF UNICODE} PWideChar {$ELSE} PAnsiChar {$ENDIF} =
      ('Shell_TrayWnd', 'TrayNotifyWnd', 'SysPager', 'ToolbarWindow32');
var
  i: Integer;
begin
  i:= Low(WND_CLASS_ARRAY);
  result:= FindWindow(WND_CLASS_ARRAY[i], nil);
  Inc(i);
  while ((result > 0) and (i <= High(WND_CLASS_ARRAY))) do
  begin
    result:= FindWindowEx(result, 0, WND_CLASS_ARRAY[i], nil);
    Inc(i);
  end;
end;

function IsWow64: Boolean;
type  //tak to musi byc bo inaczej sie wyklada w nowych Delphi
  TIsWow64Process = function(hProcess : THANDLE; var Wow64Process: BOOL): BOOL; stdcall;
var
  IsWow64: BOOL;
  IsWow64Process: TIsWow64Process;
begin
  result:= False;
  @IsWow64Process := GetProcAddress(GetModuleHandle('kernel32'), 'IsWow64Process');
  if Assigned(IsWow64Process) then
  begin
    IsWow64Process(GetCurrentProcess, IsWow64);
    result:= IsWow64;
  end;
end;

procedure TForm1.btnLoadTrayIconsInfoClick(Sender: TObject);
type
  {$IFNDEF _TBBUTTON}
  _TBBUTTON = packed record
    iBitmap: Integer;
    idCommand: Integer;
    fsState: Byte;
    fsStyle: Byte;
    bReserved: array[1..2] of Byte;
    dwData: Longint;
    iString: Integer;
  end;
  {$ENDIF}

  {$IFNDEF _TBBUTTON64}
  _TBBUTTON64 = packed record
    iBitmap: Integer;
    idCommand: Integer;
    fsState: Byte;
    fsStyle: Byte;
    bReserved: array[1..6] of Byte;
    dwData: UINT64;
    iString: UINT64;
  end;
  {$ENDIF}

  _EXTRADATA = packed record
    hWnd: THandle;
    uID: UINT;
    uCallbackMessage: UINT;
    Reserved: array [1..2] of DWORD;
    hIcon: HICON;
  end;

  _WOW64_EXTRADATA = packed record
    hWnd: THandle;
    Reserved2: array [1..1] of DWORD;
    uID: UINT;
    uCallbackMessage: UINT;
    Reserved: array [1..2] of DWORD;
    hIcon: HICON;
  end;

const
  {$IFNDEF TB_GETBUTTON}
  TB_GETBUTTON = WM_USER + 23;
  {$ENDIF}
  {$IFNDEF TB_BUTTONCOUNT}
  TB_BUTTONCOUNT = WM_USER + 24;
  {$ENDIF}
var
  pTrayBtnData: Pointer;
  dwTrayBtnDataSzie: Cardinal;
  pButtonData: Pointer;

  hTray, hProcessExplorer: Cardinal;
  dwExplorerProcessID, dwTrayButtonCount: Cardinal;
  {nie wiem dokladnie od jakiej wersji musi byc NativeUInt zakladam w ciemno że od XE}
  {$IF CompilerVersion >= 22}
  dwBytesRead: NativeUInt;
  {$ELSE}
  dwBytesRead: Cardinal;
  {$IFEND}

  pExtraData: Pointer;
  ToolTip: array [0..1024] of WideChar;
  pIconInfo: _ICONINFO;
  i: Integer;

  dwInfoProcessID: Cardinal;
  sInfoProcessName: string;
  sInfoToolTip: string;
  sInfoID: string;
  hInfoIcon: Cardinal;

  li: TListItem;
  ico: TIcon;

  nDataOffset: Integer;
  nStrOffset: Integer;


  bIs64bit, bIsWow64, bSuccess: Boolean;
begin
  bIsWow64:= IsWow64;
  {$IFNDEF WIN64} //czy 64bit wersja aplikacji
  bIs64bit:= False;
  {$ELSE} //no bez jaj pod Mac OS to i tak nie pojdzie wiec nie ma co sie p...c
  bIs64bit:= True;
  {$ENDIF}

  if (bIs64bit or bIsWow64) then
    dwTrayBtnDataSzie:= SizeOf(_TBBUTTON64)
  else
    dwTrayBtnDataSzie:= SizeOf(_TBBUTTON);

  ImageList1.Clear;
  ListView1.Clear;

  //widoczne ikony
  hTray:= FindTrayToolbarWindow;

  //ukryte ikony w Windows 7 (i 8?) sa zupelnie gdzie indziej
  //trzeba znalezc inne okno i jego ToolBar dalej pobiera sie tak samo
  //hTray:= FindWindow('NotifyIconOverflowWindow', nil);
  //hTray:= FindWindowEx(hTray, 0, 'ToolbarWindow32', nil);

  if hTray = 0 then exit;
  if (GetWindowThreadProcessId(hTray, dwExplorerProcessID) = 0) then exit;
  hProcessExplorer:= OpenProcess(PROCESS_ALL_ACCESS, False, dwExplorerProcessID);
  if (hProcessExplorer = 0) then exit;
  pTrayBtnData:= VirtualAllocEx(hProcessExplorer, nil, dwTrayBtnDataSzie,
    MEM_COMMIT, PAGE_READWRITE);
  if (Assigned(pTrayBtnData)) then
  begin
    pButtonData:= AllocMem(dwTrayBtnDataSzie);
    dwTrayButtonCount:= SendMessage(hTray, TB_BUTTONCOUNT, 0, 0);
    for i:= 0 to dwTrayButtonCount - 1 do
    begin
      SendMessage(hTray, TB_GETBUTTON, i, Longint(pTrayBtnData));
      if ReadProcessMemory(hProcessExplorer, pTrayBtnData, pButtonData,
           dwTrayBtnDataSzie, dwBytesRead) and (dwBytesRead = dwTrayBtnDataSzie) then
      begin
        if (bIs64bit or bIsWow64) then
        begin
          nDataOffset:= _TBBUTTON64(pButtonData^).dwData;
          nStrOffset:= _TBBUTTON64(pButtonData^).iString;
        end
        else
        begin
          nDataOffset:= _TBBUTTON(pButtonData^).dwData;
          nStrOffset:= _TBBUTTON(pButtonData^).iString;
        end;

        dwInfoProcessID:= 0;
        sInfoProcessName:= '';
        hInfoIcon:= 0;

        if (not bIsWow64) then
        begin
          pExtraData:= AllocMem(SizeOf(_EXTRADATA));
          bSuccess:= ReadProcessMemory(hProcessExplorer, Pointer(nDataOffset),
             pExtraData, SizeOf(_EXTRADATA), dwBytesRead) and
             (dwBytesRead = SizeOf(_EXTRADATA));
        end
        else
        begin
          pExtraData:= AllocMem(SizeOf(_WOW64_EXTRADATA));
          bSuccess:= ReadProcessMemory(hProcessExplorer, Pointer(nDataOffset),
             pExtraData, SizeOf(_WOW64_EXTRADATA), dwBytesRead) and
             (dwBytesRead = SizeOf(_WOW64_EXTRADATA));
        end;

        if bSuccess then
        begin
          GetWindowThreadProcessId(_EXTRADATA(pExtraData^).hWnd, dwInfoProcessID);
          sInfoProcessName:= GetFilenameFromPid(dwInfoProcessID);
          if not bIsWow64 then
            hInfoIcon:= _EXTRADATA(pExtraData^).hIcon
          else
            hInfoIcon:= _WOW64_EXTRADATA(pExtraData^).hIcon;
        end;
        FreeMem(pExtraData);

        sInfoToolTip:= '';
        if ReadProcessMemory(hProcessExplorer, Ptr(nStrOffset),
            @ToolTip, 1024, dwBytesRead) and (dwBytesRead = 1024) then
          sInfoToolTip:= WideCharToString(ToolTip);

        li:= ListView1.Items.Add;
        li.SubItems.Add(sInfoToolTip);
        li.SubItems.Add(sInfoProcessName);
        li.ImageIndex:= -1;
        if GetIconInfo(hInfoIcon, pIconInfo) then
        begin
          ico:= TIcon.Create;
          try
          ico.Handle:= hInfoIcon;
          li.ImageIndex:= ImageList1.AddIcon(ico);
          finally
          ico.Free;
          end;
        end;

      end;
    end;

    FreeMem(pButtonData);
    VirtualFreeEx(hProcessExplorer, pTrayBtnData, 0, MEM_RELEASE);
  end;
  CloseHandle(hProcessExplorer);
end;

end.

Kod jest przeróbką mojego wcześniejszego kodu z tematu do którego link podał @olesio i był testowany na Windows 7 x64 (kompilowany w Delphi 7 i XE5 Trial jako aplikacja x86 i x64). Starałem się go przerobić tak aby działał również na 32 bitowych systemach ale tego nie gwarantuję że gdzieś się nie pomyliłem, bo nie miałem jak przetestować (najwyżej kod z tamtego tematu działa na 100% na 32 bit więc w razie W można zobaczyć co jest źle).

PS: Sorry że trochę nie uporządkowany ale mi się ze względu na godzinę nie chciało.

0

Dzięki panowie, powyższy kod działa na win 7 x64, tylko żeby odczytywało uID program musi być skompilowany w 64bit. Pozdrawiam

2

Rumcajs napisał(a):

tylko żeby odczytywało uID program musi być skompilowany w 64bit.

A bo akurat na to uID nie zwracałem uwagi i błędnie zdefiniowałem _WOW64_EXTRADATA aby uID było poprawne zarówno w programie skompilowanym 32 i 64 bit trzeba zmienić:

_WOW64_EXTRADATA = packed record
    hWnd: THandle;
    Reserved2: array [1..1] of DWORD;
    uID: UINT;
    uCallbackMessage: UINT;
    Reserved: array [1..2] of DWORD;
    hIcon: HICON;
  end;

W poprzednim moim poście też poprawiłem.

0

Tak, teraz działa także po skompilowaniu w 32bit, jeszcze raz wielkie dzięki :)

Jak odczytać uID ikony tray innej aplikacji?

Rumcajs napisał(a):

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami