Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Re: Ideas for implementing pShell

by PodMaster (Abbot)
on Apr 03, 2004 at 23:38 UTC ( #342377=note: print w/replies, xml ) Need Help??


in reply to Ideas for implementing pShell

I got tired of seing 20 cmd.exe windows in my taskbar, so I set out to steal them. This is my proof of concept (what you want to focus on is Win32:: and EVT_ calls )
#!/usr/bin/perl -w -- # generated by wxGlade 0.3.2 on Thu Mar 18 03:31:22 2004 # To get wxPerl visit http://wxPerl.sourceforge.net/ #include <winbase.h> //to get these #define NORMAL_PRIORITY_CLASS 0x00000020 #define IDLE_PRIORITY_CLASS 0x00000040 #define HIGH_PRIORITY_CLASS 0x00000080 #define REALTIME_PRIORITY_CLASS 0x00000100 # Win2000 #define BELOW_NORMAL_PRIORITY_CLASS 0x00004000 #define ABOVE_NORMAL_PRIORITY_CLASS 0x00008000 BEGIN { use Win32::API; Win32::API::->Import("kernel32","HANDLE GetCurrentProcess()"); Win32::API::->Import("kernel32","BOOL SetPriorityClass(HANDLE hPro +cess, DWORD dwPriorityClass)"); SetPriorityClass(GetCurrentProcess(),0x00000040);#0x00004000); } use Wx 0.15 qw[:allclasses]; use strict; package MyFrame; use Wx qw[:everything]; use base qw(Wx::Frame); use strict; sub new { my( $self, $parent, $id, $title, $pos, $size, $style, $name ) = @_ +; $parent = undef unless defined $parent; $id = -1 unless defined $id; $title = "" unless defined $title; $pos = wxDefaultPosition unless defined $pos; $size = wxDefaultSize unless defined $size; $name = "" unless defined $name; # begin wxGlade: MyFrame::new $style = wxCAPTION|wxMINIMIZE_BOX|wxMAXIMIZE|wxMAXIMIZE_BOX|wxSYST +EM_MENU|wxRESIZE_BORDER unless defined $style; $self = $self->SUPER::new( $parent, $id, $title, $pos, $size, $sty +le, $name ); $self->{notebook_1} = Wx::Notebook->new($self, -1, wxDefaultPositi +on, wxDefaultSize, 0); $self->{frame_1_statusbar} = $self->CreateStatusBar(1, 0); $self->{panel_1} = Wx::ScrolledWindow->new($self->{notebook_1}, -1 +, wxDefaultPosition, wxDefaultSize, wxNO_BORDER|wxTAB_TRAVERSAL|wxCLI +P_CHILDREN); $self->{panel_3} = Wx::ScrolledWindow->new($self->{notebook_1}, -1 +, wxDefaultPosition, wxDefaultSize, wxNO_BORDER|wxTAB_TRAVERSAL|wxCLI +P_CHILDREN); $self->__set_properties(); $self->__do_layout(); return $self; # end wxGlade } sub __set_properties { my $self = shift; # begin wxGlade: MyFrame::__set_properties $self->SetTitle("Window Thief"); $self->SetSize(428, 280); $self->{frame_1_statusbar}->SetStatusWidths(-1); my( @frame_1_statusbar_fields ) = ( "frame_1_statusbar" ); if( @frame_1_statusbar_fields ) { $self->{frame_1_statusbar}->SetStatusText($frame_1_statusbar_f +ields[$_], $_) for 0 .. $#frame_1_statusbar_fields ; } $self->{panel_1}->SetBackgroundColour(Wx::Colour->new(255, 255, 25 +5)); $self->{panel_1}->SetScrollRate(1, 1); $self->{panel_3}->SetScrollRate(1, 1); $self->{notebook_1}->SetBackgroundColour(Wx::Colour->new(255, 255, + 255)); # end wxGlade } sub __do_layout { my $self = shift; # begin wxGlade: MyFrame::__do_layout $self->{sizer_1} = Wx::BoxSizer->new(wxVERTICAL); $self->{notebook_1}->AddPage($self->{panel_1}, "tab1"); $self->{notebook_1}->AddPage($self->{panel_3}, "ASDasd"); $self->{sizer_1}->Add(Wx::NotebookSizer->new($self->{notebook_1}), + 1, wxEXPAND, 0); $self->SetAutoLayout(1); $self->SetSizer($self->{sizer_1}); $self->Layout(); $self->Centre(); # end wxGlade } # end of class MyFrame 1; package MyApp; use Win32::API; use Win32::GuiTest qw( FindWindowLike PostMessage ); use Win32::Process; use Data::Dumper; local $Data::Dumper::Indent=1; my $SetParent = Win32::API::->new("user32","SetParent","NN","N") or die "Failed to load SetParent from user32"; use base qw(Wx::App); use strict; sub OnInit { my( $self ) = shift; Wx::InitAllImageHandlers(); my $frame_1 = MyFrame->new(); $self->SetTopWindow($frame_1); $frame_1->Show(1); for( 1 .. 3 ){ Win32::Process::Create( my $cmdp, "$ENV{WINDIR}\\system32\\cmd.exe", "/K title steal_me_$_ ", 0,# don't inherit nothing NORMAL_PRIORITY_CLASS | CREATE_NEW_CONSOLE, '.' ) or die "EEEEK! \$!=q{ $! } \$^E=q{ $^E } $/"; push @::cmdp, $cmdp; } sleep 2; my $parent = $frame_1->{panel_1}->GetHandle(); my( @cmd ) = FindWindowLike(undef,'steal_me','ConsoleWindowClass', +0,0); for(@cmd){ $SetParent->Call($_,$parent); } $SetParent->Call($cmd[-1],$frame_1->{panel_3}->GetHandle()); #use Wx::Event qw'EVT_PAINT'; use Win32::GUI; $_ = bless( { '-type' => 0, '-name' => 'TheDangCMD', '-handle' => $_, '-accel' => 0 }, 'Win32::GUI::Window' ) for @cmd; #### when our scrolledwindows need their background repainted, #### we make sure our stolen windows are repainted also (smart) use Wx::Event qw( EVT_ERASE_BACKGROUND ); EVT_ERASE_BACKGROUND( $frame_1->{panel_1}, sub { $_[1]->Skip(); for(@cmd[0,1]){ $_->InvalidateRect(1); $_->DrawMenuBar(); $_->Update(); } 1;}); EVT_ERASE_BACKGROUND( $frame_1->{panel_3}, sub { $_[1]->Skip(); for(@cmd[-1]){ $_->InvalidateRect(1); $_->DrawMenuBar(); $_->Update(); } 0;}); $frame_1->{panel_1}->SetExtraStyle( Wx::wxWS_EX_BLOCK_EVENTS() ); $frame_1->{panel_3}->SetExtraStyle( Wx::wxWS_EX_BLOCK_EVENTS() ); $frame_1->{panel_1}->SetVirtualSize( 1000, 1000 ); $frame_1->{panel_3}->SetVirtualSize( 1000, 1000 ); $frame_1->{panel_1}->SetScrollRate(1, 1); $frame_1->{panel_3}->SetScrollRate(1, 1); $frame_1->{panel_1}->Validate(); $frame_1->{panel_3}->Validate(); $frame_1->Validate(); return 1; } # end of class MyApp package main; unless(caller){ eval { my $app = MyApp->new(); $app->MainLoop(); 1; } or warn "crapola $@"; } warn "killing ...$/"; $_->Kill(0) for @::cmdp;
While experimenting with this I wanted a way to map processes to top level windows, this is about as good as it gets
# $Id: spy--.pl,v 1.1 2001/06/17 09:17:10 erngui Exp $ # # MS has a very nice tool (Spy++). # This is Spy-- # use strict; use warnings; use Win32::GuiTest qw/ IsWindowVisible IsWindowEnabled FindWindowLike GetWindowText GetClassName GetChildDepth GetDesktopWindow /; use Win32::API; BEGIN { Win32::API::->Import("user32","DWORD GetWindowThreadProcessId( HWN +D hWnd, LPDWORD lpdwProcessId)") or die $^E; } # desireable windows # top level windows (children of desktop , depth 1) # visible, enabled, have window title my $DesktopWindow = GetDesktopWindow(); for (FindWindowLike((undef) x 4, 1)) { next unless IsWindowEnabled($_) or IsWindowVisible($_); my $s = sprintf "0x%08X %8d %-30s '%s'", $_, GetWindowThreadProcessId($_,undef), GetClassName($_), GetWindowText($_) || next; print "+" x GetChildDepth($DesktopWindow, $_), $s, "\n"; }

MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
** The third rule of perl club is a statement of fact: pod is sexy.

Replies are listed 'Best First'.
Re: Re: Ideas for implementing pShell
by Jouke (Curate) on Apr 04, 2004 at 10:24 UTC
    Great! This is useable code for this project! PodMaster++


    Jouke Visser, Perl 'Adept'
    Using Perl to help the disabled: pVoice and pStory
      Another thing I've just discovered is that you cannot wrap
      Win32::API::->Import( "user32", "DWORD GetWindowThreadProcessId( HWND hWnd, LPDWORD lpdwPr +ocessId)" ) or die $^E;
      in a begin block. If you do, it won't work properly. For example if you tried GetWindowThreadProcessId($handle, $procid); $procid would not be populated with the process id as is expected. This drove me crazy 10min ago.

      update: also, be sure the new parent window has wxCLIP_CHILDREN on, otherwise flicker galore

      MJD says "you can't just make shit up and expect the computer to know what you mean, retardo!"
      I run a Win32 PPM repository for perl 5.6.x and 5.8.x -- I take requests (README).
      ** The third rule of perl club is a statement of fact: pod is sexy.

        I am completely Lost now,.... Blackadder

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://342377]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (5)
As of 2018-07-19 23:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    It has been suggested to rename Perl 6 in order to boost its marketing potential. Which name would you prefer?















    Results (421 votes). Check out past polls.

    Notices?