delphi 获取系统托盘程序列表

uses CommCtrl;

function TForm1.GetIconsCount: Integer;

begin

Result := SendMessage(FindTrayToolbar, TB_BUTTONCOUNT, 0, 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

ListTips;

end;

function TForm1.FindTrayToolbar: HWND;

begin

Result := FindWindow('Shell_TrayWND', nil);

Result := FindWindowEx(Result, 0, 'TrayNotifyWnd', nil);

Result := FindWindowEx(Result, 0, 'SysPager', nil);

Result := FindWindowEx(Result, 0, 'ToolbarWindow32', nil);

end;

procedure TForm1.ListTips;

var

dwTray: DWORD;

wndTray: HWND;

hTray: THandle;

remoteTray: Pointer;

tdata: TTBBUTTON;

i: Integer;

btsread:DWORD;

str:Pchar;

begin

wndTray := FindTrayToolbar;

GetWindowThreadProcessId(wndTray, @dwTray);

hTray := OpenProcess(PROCESS_ALL_ACCESS, false, dwTray);

if hTray <> 0 then

begin

remoteTray := VirtualAllocEx(hTray, nil, Sizeof(tdata), MEM_COMMIT,

PAGE_READWRITE);

for i := 0 to GetIconsCount - 1 do

begin

SendMessage(FindTrayToolbar,TB_GETBUTTON,wparam(i),lparam(remotetray));

ReadProcessMemory(hTray,remotetray,@tdata,sizeof(tdata),btsread);

GetMem(str,255);

ReadProcessMemory(hTray,Ptr(tdata.iString),str,255,btsread);

ListBox1.Items.Add(str);

end;

end

else ShowMessage('Could not locate tray icons');

end;

end.

推荐分享