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?
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.
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.
Dzięki panowie, powyższy kod działa na win 7 x64, tylko żeby odczytywało uID program musi być skompilowany w 64bit. Pozdrawiam
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.
Tak, teraz działa także po skompilowaniu w 32bit, jeszcze raz wielkie dzięki :)