Witam
Jest możliwe wywołanie zdarzenia np. OnDoubleClick z poziomu kodu Delphi na dowolnej aplikacji (nazwa aplikacji/procesu podana w parametrze) uruchomionej w Tray?
Ta a skąd mamy wiedzieć do czego OnDoubleClick? Chodzi o podwójne kliknięcie na ikonę w trayu?
Tak
masz na mysli wykrywanie przez twoja aplikacje, ze ktos np kliknal dwa razy na ikonke skype'a w zasobniku a nastepnie wywolanie jakiegos swojego kodu? Wszystko jest mozliwe, ale tutaj jest troche roboty i pewnie jest jakis inny jest sposob na twoj cel. Co dokladnie chcesz osiagnac?
Opiszę dokładnie co chcę łopatologicznie:
Jest sobie jakiś uruchomiony program X.exe, który jest zminimalizowany do tray.
Program X.exe zainstalowany w: C:\Sciezka\X.exe
Chcę napisać program Y.exe, który ma jeden button, i pole edit, gdzie po uzupełnieniu w pole edit "C:\Sciezka\X.exe" i naciśnięciu buttona osiągnie się efekt taki jakbym kliknął na ikonie w trayu programu X.exe dwukrotnie myszką.
Nie wiem czy jest to w ogóle wykonalne.
zależy co chcesz osiągnać? dwuklik na ikonkę w trayu najczęściej pokazuje okno programu.
przywrócenie okna to można próbować robić przesyłająć jakiś komunikat systemowy do tego okna znając jego uchwyt.
jeżeli dwuklik robi cośzupełnie innego, nie wiadomo co w sumie, to możesz się bawić też ustawianiem kursora myszki, ale to jest baardzo naciągane.
Dwuklik myszki nie powoduje minimalizacji/maksymalizacji okna czy coś w tym stylu.
Dla tego przykładu przyjmijmy że uruchamia się timer zaszyty w programie X, ale nie o to chodzi co się wykona po kliknięciu 2 razy myszką na ikonie, tylko jak za pomocą kodu w innym programie kliknąć tą myszką dwukrotnie.
czyli chcesz symulowac wcisnisiecie przyciskow myszki. Zamiast klikac fizycznie?
tak.
to trzeba bylo Od razu tak. Czyli podajesz nazwe programu a dalej ma byc symulacja klikniecia na ikonke tego programu w zasobniku? Jesli tak to pozniej moge cos wkleic, cos podobnego nie dawno robilem aby odswiezyc martwe ikonki w zasobniku.
dobra teraz doczytalem twoj post z X i Y. Zawsze tak pisz, bez zadnych skrotow myslowych ;)
Dokladnie tak mca64, proszę zatem o pomoc jeśli jest to wykonalne.
Dla dowolnej aplikacji nie jest to takie łatwe ale już kiedyś bawiłem się wyciągnie info o ikonach w trayu więc dorobiłem do starego eksperymentalnego projektu tylko możliwość wysłania komunikatu. Na formie:
- ListView o nazwie ListView1 który ma 6 kolumn (Ikona, ID, CallBack, Handle, Tool Tip, Process Name)
- Button o nazwie btnLoadTrayIconsInfo
- Button o nazwie btnSendDblClickMessage
- ImageList o nazwie ImageList1
Kod całego unitu (trochę zamotany ale tak jak napisałem to był testowy projekt):
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;
btnSendDblClickMessage: TButton;
procedure btnLoadTrayIconsInfoClick(Sender: TObject);
procedure btnSendDblClickMessageClick(Sender: TObject);
private
{ Private declarations }
hTray: Cardinal;
public
{ Public declarations }
end;
var
Form1: TForm1;
function wsprintfa(Output: PAnsiChar; Format: PAnsiChar): Integer; cdecl; varargs;
external 'user32.dll' name 'wsprintfA';
function wsprintfw(Output: PWideChar; Format: PWideChar): Integer; cdecl; varargs;
external 'user32.dll' name 'wsprintfW';
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;
Reserved1: array [1..1] of DWORD;
uID: UINT;
uCallbackMessage: UINT;
Reserved2: array [1..2] of Cardinal;
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;
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}
//ExtraData: _WOW64_EXTRADATA;
pExtraData: Pointer;
ToolTip: array [0..1024] of WideChar;
pIconInfo: _ICONINFO;
i: Integer;
dwInfoProcessID: Cardinal;
sInfoProcessName: string;
sInfoToolTip: string;
sHWND: string;
sCallBack: string;
sInfoID: string;
hInfoIcon: Cardinal;
li: TListItem;
ico: TIcon;
nDataOffset: Integer;
nStrOffset: Integer;
bIs64bit, bIsWow64, bSuccess: Boolean;
ex2: _EXTRADATA;
ex: _WOW64_EXTRADATA;
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
begin
hInfoIcon:= _EXTRADATA(pExtraData^).hIcon;
ex2:= _EXTRADATA(pExtraData^);
SetLength(sInfoID, 10);
SetLength(sCallBack, 10);
SetLength(sHWND, 10);
wsprintfw(PWideChar(sInfoID), '%d', ex2.uID);
wsprintfw(PWideChar(sCallBack), '%d', ex2.uCallbackMessage);
wsprintfw(PWideChar(sHWND), '%d', ex2.hWnd);
end
else
begin
hInfoIcon:= _WOW64_EXTRADATA(pExtraData^).hIcon;
ex:= _WOW64_EXTRADATA(pExtraData^);
hInfoIcon:= ex.hIcon;
SetLength(sInfoID, 10);
SetLength(sCallBack, 10);
SetLength(sHWND, 10);
wsprintfw(PWideChar(sInfoID), '%d', ex.uID);
wsprintfw(PWideChar(sCallBack), '%d', ex.uCallbackMessage);
wsprintfw(PWideChar(sHWND), '%d', ex.hWnd);
end;
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(sInfoID); //kolumna ID
li.SubItems.Add(sCallBack); //kolumna CallBack
li.SubItems.Add(sHWND); //kolumna Handle
li.SubItems.Add(sInfoToolTip); //kolumna Tool Tip
li.SubItems.Add(sInfoProcessName); //kolumna Process Name
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;
procedure TForm1.btnSendDblClickMessageClick(Sender: TObject);
var
uHWND, uID, uCallBack: UINT;
begin
if ListView1.ItemIndex > -1 then
begin
uID:= StrToIntDef(ListView1.Items[ListView1.ItemIndex].SubItems[0], 0);
uCallBack:= StrToIntDef(ListView1.Items[ListView1.ItemIndex].SubItems[1], 0);
uHWND:= StrToIntDef(ListView1.Items[ListView1.ItemIndex].SubItems[2], 0);
PostMessage(uHWND, uCallBack, uID, WM_LBUTTONDBLCLK)
//pojedyncze klikniecie wysyla sie jak w komentarzu nizej
//PostMessage(uHWND, uCallBack, uID, WM_LBUTTONDOWN);
//PostMessage(uHWND, uCallBack, uID, WM_LBUTTONUP);
end;
end;
end.
W projekcie po kliknięciu buttona "Ładuj Info" ListView jest wypełniany informacjami o znajdujących sie w trayu ikonach (domyślnie widocznych aby były niewidoczne trzeba usunąć komentarz w opisanym w kodzie miejscu), po kliknięciu buttona "Wyślij Komunikat" wysyłany jest komunikat.
Dzięki wielkie, w poniedziałek ostro biorę się za analizę i modyfikacje :)
Niestety wywala mi się błędem po nacisnieciu buttona btnLoadTrayIconsInfo: access violation(w załączniku)
Podczas debugowania w tym miejscu:
if ReadProcessMemory(hProcessExplorer, Ptr(nStrOffset),
@ToolTip, 1024, dwBytesRead) and (dwBytesRead = 1024) then
sInfoToolTip:= WideCharToString(ToolTip);
Odwołuję alarm, jak podpiąłem w ListView ImageList zaczęło działać, natomiast po wywołaniu btnSendDblClickMessage nie uzyskuję efektu podwójnego kliknięcia na ikonie :(
Głupi przykład: po podwójnym kliknięciu na ikonę glośnika powinna się otworzyć regulacja głośności. Niestety nie otwiera się nic.
Nie _13th_Dragon, chodzi mi o ikonę głośnika Menadżer Realtek HD Audio - wywoływane podwójnym kliknięciem.
Pojedyncze kliknięcia
// pojedyncze klikniecie wysyla sie jak w komentarzu nizej
//PostMessage(uHWND, uCallBack, uID, WM_LBUTTONDOWN);
//PostMessage(uHWND, uCallBack, uID, WM_LBUTTONUP);
tez próbowałem na innych ikonach i tak samo bez rezultatu. Nic się nie działo. W debugerze jak patrzyłem odczytuje prawidłowo dane ikony ale zdarzenie się nie wykonuje.
Rzeczywiście wygląda na to że nie działa w przypadku ikon należących do procesu explorer.exe czyli właśnie min. regulacja głośności (jakiś dziwny przypadek) ale inne działają przynajmniej te u mnie. Jestem teraz zajęty wiec nie mam czasu dochodzić dlaczego nie działa akurat dla tego procesu ale trzeba by przede wszystkim sprawdzić czy uHWND (uchwyt okna explorera) i uCallBack (czyli po prostu komunikat WM_USER + co tam sobie programista wymyśli lub generowany funkcją RegisterWindowMessage) zgadza się z tym do którego wysyłany jest komunikat przy ręcznym kliknięciu.