Sign Up

Sign Up to our social questions and Answers Engine to ask questions, answer people’s questions, and connect with other people.

Have an account? Sign In

Have an account? Sign In Now

Sign In

Login to our social questions & Answers Engine to ask questions answer people’s questions & connect with other people.

Sign Up Here

Forgot Password?

Don't have account, Sign Up Here

Forgot Password

Lost your password? Please enter your email address. You will receive a link and will create a new password via email.

Have an account? Sign In Now

You must login to ask a question.

Forgot Password?

Need An Account, Sign Up Here

Please briefly explain why you feel this question should be reported.

Please briefly explain why you feel this answer should be reported.

Please briefly explain why you feel this user should be reported.

Sign InSign Up

The Archive Base

The Archive Base Logo The Archive Base Logo

The Archive Base Navigation

  • SEARCH
  • Home
  • About Us
  • Blog
  • Contact Us
Search
Ask A Question

Mobile menu

Close
Ask a Question
  • Home
  • Add group
  • Groups page
  • Feed
  • User Profile
  • Communities
  • Questions
    • New Questions
    • Trending Questions
    • Must read Questions
    • Hot Questions
  • Polls
  • Tags
  • Badges
  • Buy Points
  • Users
  • Help
  • Buy Theme
  • SEARCH
Home/ Questions/Q 8139659
In Process

The Archive Base Latest Questions

Editorial Team
  • 0
Editorial Team
Asked: June 6, 20262026-06-06T11:54:11+00:00 2026-06-06T11:54:11+00:00

I am trying to write a script in Perl to read all the icons

  • 0

I am trying to write a script in Perl to read all the icons in the system tray, grab their co-ordinates & find out who owns them. I am pretty much trying to translate this code here.

Here is my code so far:

use strict;
use warnings;

use Win32::API;
use Win32::OLE qw(in);
use Data::Dumper;

use constant wbemFlagReturnImmediately => 0x10;
use constant wbemFlagForwardOnly       => 0x20;

use constant SYNCHRONIZE => 0x00100000;
use constant STANDARD_RIGHTS_REQUIRED => 0x000F0000;
use constant PROCESS_ALL_ACCESS => (STANDARD_RIGHTS_REQUIRED | SYNCHRONIZE | 0xFFF);

my $TB_BUTTONCOUNT     = 0x0418;
my $TB_GETBUTTONTEXT   = 0x041B;
my $TB_GETBUTTONINFO   = 0x0441;
my $TB_GETITEMRECT     = 0x041D;
my $TB_GETBUTTON       = 0x0417;

sub get_windows_details {
    my ($self) = @_;
    my $ret;

    my $objWMIService =
      Win32::OLE->GetObject("winmgmts:\\\\localhost\\root\\CIMV2")
      or die "WMI connection failed.\n";
    my $colItems =
      $objWMIService->ExecQuery("SELECT * FROM Win32_OperatingSystem",
                               "WQL",
                               wbemFlagReturnImmediately | wbemFlagForwardOnly);

    my $objItem;
    foreach $objItem (in $colItems) {
        $ret->{'osname'} = $objItem->{Caption};
    }

    $colItems =
      $objWMIService->ExecQuery("SELECT * FROM Win32_Processor",
                               "WQL",
                               wbemFlagReturnImmediately | wbemFlagForwardOnly);

    foreach $objItem (in $colItems) {
        $ret->{'osbit'} = $objItem->{AddressWidth};
    }

    return $ret;
}

sub get_autoit_tray_handle {
    my $autoit = Win32::OLE->new("AutoItX3.Control")
        or return 0;
    my $tray_hwnd = $autoit->ControlGetHandle("[Class:Shell_TrayWnd]", "", "[Class:ToolbarWindow32;Instance:1]");
    return hex $tray_hwnd;
}

sub get_tray_icon_count {
    #my $hWnd = get_tray_handle(); 
    my $hWnd = get_autoit_tray_handle(); 
    my $send_message = Win32::API->new("user32", "SendMessage", "NNII", "I");
    return $send_message->Call($hWnd, $TB_BUTTONCOUNT, 0, 0);
}



# Randomly chosen icon index.
my $iIndex = 6;

my $os = get_windows_details();
if ($os->{'osbit'} == 64) {
    Win32::API::Struct->typedef('TBBUTTON', qw { int       iBitmap;
                                                 int       idCommand;
                                                 BYTE      fsState;
                                                 BYTE      fsStyle;
                                                 BYTE      bReserved[6];
                                                 DWORD_PTR dwData;
                                                 INT_PTR   iString;
                                               }
                                ) or die "Typedef error $!\n";
} else {
    Win32::API::Struct->typedef('TBBUTTON', qw { int       iBitmap;
                                                 int       idCommand;
                                                 BYTE      fsState;
                                                 BYTE      fsStyle;
                                                 BYTE      bReserved[2];
                                                 DWORD_PTR dwData;
                                                 INT_PTR   iString;
                                               }
                                ) or die "Typedef error $!\n";
}

# Get tray handle & it's proc id
my $tb_button = Win32::API::Struct->new('TBBUTTON');
my $tray_hwnd = get_autoit_tray_handle();
print "tray hwnd: $tray_hwnd\n";
my $window_thread_proc_id = Win32::API->new('user32', "GetWindowThreadProcessId", 'LP', 'N');
my $lpdwPID = pack 'L', 0;
my $pid = $window_thread_proc_id->Call($tray_hwnd, $lpdwPID);
my $dwPID = unpack 'L', $lpdwPID;
print "proc id: $dwPID\n";

# read the tray process memory to get the tray button info
my $open_process = Win32::API->new('kernel32', 'OpenProcess', 'NIN', 'N') || die $!;
my $proc_hwnd = $open_process->Call(PROCESS_ALL_ACCESS, 0, $dwPID);
print "proc hwnd: $proc_hwnd\n";

my $virtual_alloc = Win32::API->new('kernel32', 'VirtualAllocEx', 'NNLNN', 'N');
my $lp_data = $virtual_alloc->Call($proc_hwnd, 0, $tb_button->sizeof(), 0x1000, 0x04);
print "Error allocating memory: $!\n" if $!;
print "Allocated addresss: $lp_data\n";

my $send_message = Win32::API->new('user32', 'SendMessage', 'NNIN','I');
my $get_button_status = $send_message->Call($tray_hwnd, $TB_GETBUTTON, $iIndex, $lp_data);
print "TB_GETBUTTON Status: $get_button_status\n";

my $read_process = Win32::API->new('kernel32', 'ReadProcessMemory', 'NNSNP','I');
my $bytes_read = pack 'L', 0;
$read_process->Call($proc_hwnd, $lp_data, $tb_button, $tb_button->sizeof(), $bytes_read);
print "dwData: $tb_button->{'dwData'} \n";

I am using autoit COM DLL to get the system tray handle. Once I have the have the tray handle, I try to get it’s process id & then read the process memory to get the TBBUTTON structure, which is defined as follows:

if ($os->{'osbit'} == 64) {
    Win32::API::Struct->typedef('TBBUTTON', qw { int       iBitmap;
                                                 int       idCommand;
                                                 BYTE      fsState;
                                                 BYTE      fsStyle;
                                                 BYTE      bReserved[6];
                                                 DWORD_PTR dwData;
                                                 INT_PTR   iString;
                                               }
                                ) or die "Typedef error $!\n";
} else {
    Win32::API::Struct->typedef('TBBUTTON', qw { int       iBitmap;
                                                 int       idCommand;
                                                 BYTE      fsState;
                                                 BYTE      fsStyle;
                                                 BYTE      bReserved[2];
                                                 DWORD_PTR dwData;
                                                 INT_PTR   iString;
                                               }
                                ) or die "Typedef error $!\n";
}

When you execute the above code, at least on my system, here is the output I see:

tray hwnd: 401922
proc id: 11040
proc hwnd: 704
Allocated addresss: 32702464
TB_GETBUTTON Status: 1
dwData: 10293610267052867588 

As you can see – the “dwData” seems to be wrong. Looks like I’m doing something wrong here:

my $read_process = Win32::API->new('kernel32', 'ReadProcessMemory', 'NNSNP','I');
my $bytes_read = pack 'L', 0;
$read_process->Call($proc_hwnd, $lp_data, $tb_button, $tb_button->sizeof(), $bytes_read);
print "dwData: $tb_button->{'dwData'} \n";

Any suggestions on what I’m doing wrong there? Thanks.

  • 1 1 Answer
  • 0 Views
  • 0 Followers
  • 0
Share
  • Facebook
  • Report

Leave an answer
Cancel reply

You must login to add an answer.

Forgot Password?

Need An Account, Sign Up Here

1 Answer

  • Voted
  • Oldest
  • Recent
  • Random
  1. Editorial Team
    Editorial Team
    2026-06-06T11:54:12+00:00Added an answer on June 6, 2026 at 11:54 am

    I decided to try to minimize the amount of uncertainty introduced by the various things you are pulling in, and just use the functionality provided by Win32::GuiTest. I also cheated with regard to bitness and structs so as to get something running on my 32-bit WinXP SP3 laptop. Here’s something that runs and produces some output.

    I am not sure if this is the right output, but it should at least point you in a simpler direction:

    #!/usr/bin/env perl
    
    use feature 'say';
    use strict; use warnings;
    
    use Const::Fast;
    use Devel::CheckOS;
    use Win32::GuiTest qw(
        AllocateVirtualBuffer
        FreeVirtualBuffer
        ReadFromVirtualBuffer
        FindWindowLike
        SendMessage
    );
    
    use YAML;
    
    const my %TB => (
        BUTTONCOUNT => 0x0418,
        GETBUTTONTEXT => 0x041B,
        GETBUTTONINFO => 0x0441,
        GETITEMRECT => 0x041D,
        GETBUTTON => 0x0417,
    );
    
    const my %TBUTTON => (
        32 => 'iiCCCCLL',
        64 => 'iiCCCCCCCCLL',
    );
    
    my ($tray_handle) = FindWindowLike(undef, undef, 'TrayNotifyWnd');
    
    my ($toolbar_handle) = FindWindowLike($tray_handle, undef, 'ToolbarWindow');
    
    say for ($tray_handle, $toolbar_handle);
    
    my $button_count = SendMessage($toolbar_handle, $TB{BUTTONCOUNT}, 0, 0);
    
    unless (defined($button_count) and $button_count > 0) {
        die "Can't find buttons\n"
    }
    
    my $buf = AllocateVirtualBuffer($toolbar_handle, 0x20);
    
    print Dump $buf;
    
    my $index = int(rand $button_count);
    
    say "Trying button = $index\n";
    
    my $status = SendMessage(
        $toolbar_handle,
        $TB{GETBUTTON},
        $index,
        $buf->{ptr}
    );
    
    say "TB_GETBUTTON status = $status";
    
    my $result = ReadFromVirtualBuffer($buf, 0x20);
    
    FreeVirtualBuffer($buf);
    
    print Dump [ map sprintf('%X', $_), unpack $TBUTTON{32}, $result ];
    

    Also, not that you shoud define things like Win32::API functions and structs in one place and only once.

    Sample output:

    655544
    393294
    ---
    process: 1920
    ptr: 28835840
    Trying button = 19
    
    TB_GETBUTTON status = 1
    ---
    - 7
    - 9
    - C
    - 0
    - 0
    - 0
    - 1DA23C8
    - 2B70590
    • 0
    • Reply
    • Share
      Share
      • Share on Facebook
      • Share on Twitter
      • Share on LinkedIn
      • Share on WhatsApp
      • Report

Sidebar

Related Questions

So I'm trying to write a perl script to read in a file encoded
I'm trying to write a perl script to search through a text file, find
I have been trying to write a perl script to get all of the
I'm trying to write a Perl script that will parse the output of the
I'm trying to write a Perl CGI script to handle XML-RPC requests, in which
I'm trying to write a Perl script that will work better with KDE's kwrited
I am trying to write a simple Perl script that reads a *.csv, places
I have a Perl script and I am trying to make it print out
Trying to figure this out. I am trying to execute a perl script within
I'm trying to write a perl script than can open a dir and delete

Explore

  • Home
  • Add group
  • Groups page
  • Communities
  • Questions
    • New Questions
    • Trending Questions
    • Must read Questions
    • Hot Questions
  • Polls
  • Tags
  • Badges
  • Users
  • Help
  • SEARCH

Footer

© 2021 The Archive Base. All Rights Reserved
With Love by The Archive Base

Insert/edit link

Enter the destination URL

Or link to existing content

    No search term specified. Showing recent items. Search or use up and down arrow keys to select an item.