#!perl -w
use strict;
use warnings;
#
# Application to display control information, demosntrating AxWindow
# usage for Webbrowser, as well as providing useful information for
# anyone wanting to use other controls
#
# If you're randomly browsing controls, don't be surprised to find some
# that crash perl.
#
# Select an AxtiveX Object from the dropdown ...
#
# Author: Robert May
#
use Win32::GUI qw(WS_CLIPCHILDREN WS_EX_CLIENTEDGE);
use Win32::GUI::AxWindow();
use Win32::OLE();
use Win32::TieRegistry();
# Info about the currently inspected control
my %INFO;
# main Window
my $mw = new Win32::GUI::Window (
-name => "MW",
-title => "Win32::GUI::AxWindow Control Navigator",
-size => [600,400],
-addstyle => WS_CLIPCHILDREN,
-onResize => \&mwResize,
) or die "new Window";
$mw->Center();
$mw->AddLabel(
-name => "PROGID_Prompt",
-pos => [10,13],
-height => 20,
-text => "Select PROGID :",
) or die "new Label";
$mw->AddCombobox(
-name => "PROGID",
-top => 10,
-left => $mw->PROGID_Prompt->Left()+$mw->PROGID_Prompt->Width()+10,
-size => [300,200],
-vscroll => 1,
-onChange => \&loadInfo,
-dropdownlist => 1,
) or die "new Combobox";
$mw->AddTreeView(
-name => 'TV',
-top => $mw->PROGID_Prompt->Height()+20,
-width => 180,
-height => $mw->ScaleHeight()-$mw->PROGID_Prompt->Height()-20,
-rootlines => 1,
-lines => 1,
-buttons => 1,
-onNodeClick => \&dispInfo,
) or die "new TreeView";
Win32::GUI::AxWindow->new(
-parent => $mw,
-control => "Shell.Explorer",
-name => 'BW',
-left => $mw->TV->Left() + $mw->TV->Width()+5,
-top => $mw->PROGID_Prompt->Height()+20,
-width => $mw->ScaleWidth()-$mw->TV->Width()-5,
-height => $mw->ScaleHeight()-$mw->PROGID_Prompt->Height()-20,
-addexstyle => WS_EX_CLIENTEDGE,
) or die "new AxWindow";
# Load a blank page
$mw->BW->CallMethod("Navigate", "about:blank");
$mw->Show();
$mw->Disable();
# Ref to list of controls
my $controls = getInstalledControls();
exit(0) if not defined $controls; # Abort
#Populate combo selection
$mw->PROGID->Add(sort {lc $a cmp lc $b} @{$controls});
$mw->Enable();
$mw->BringWindowToTop();
Win32::GUI::Dialog();
$mw->Hide();
undef $mw;
exit(0);
sub mwResize {
my $win = shift;
my ($width, $height) = ($win->GetClientRect())[2..3];
$win->TV->Height($height-$win->TV->Top());
$win->BW->Width($width-$win->BW->Left());
$win->BW->Height($height-$win->BW->Top());
return 1;
}
sub loadInfo {
Update_Treeview($mw->TV);
return 1;
}
sub Update_Treeview {
my $tv = shift;
# reset information
%INFO = ();
$tv->DeleteAllItems();
Display("");
$INFO{progid} = $mw->PROGID->Text();
$INFO{progid} =~ s/\s.*$//;
# Determine if we can create the object:
# This is pretty heavy handed, but I can't think of a better
# way to prevent us falling back on Shell.Explorer if we can't
# load the requested ActiveX object
{
my $oleobj;
{
local $SIG{__WARN__} = sub {};
$oleobj = Win32::OLE->new($INFO{progid});
}
if (not defined $oleobj) {
Display("<p style='color:red;'>ERROR creating $INFO{progid} (OLE)</p>");
return 0;
}
}
# Create invisible AxWindow control
my $C = new Win32::GUI::AxWindow(
-parent => $mw,
-name => "Control",
-control => $INFO{progid},
);
if (not defined $C) {
Display("<p style='color:red;'>ERROR creating $INFO{progid} (Control)</p>");
return 0;
}
# Get Property info
foreach my $id ($C->EnumPropertyID()) {
my %property = $C->GetPropertyInfo($id);
$INFO{Properties}->{$property{-Name}} = \%property;
}
# Get Method info
foreach my $id ($C->EnumMethodID()) {
my %method = $C->GetMethodInfo($id);
$INFO{Methods}->{$method{-Name}} = \%method;
}
# Get Event info
foreach my $id ($C->EnumEventID()) {
my %event = $C->GetEventInfo ($id);
$INFO{Events}->{$event{-Name}} = \%event;
}
# Update the tree view
# Insert the nodes
for my $pnode_text qw(Properties Methods Events) {
next if not defined $INFO{$pnode_text};
my $pnode = $tv->InsertItem(-text => $pnode_text);
for my $prop_name (sort keys %{$INFO{$pnode_text}}) {
$tv-> InsertItem(
-parent => $pnode,
-text => $prop_name,
);
}
}
return 1;
}
sub dispInfo {
my ($tv, $node) = @_;
my $pnode = $tv->GetParent($node);
# Don't do anything for the top level nodes
return 1 if $pnode == 0;
my %pitem_info = $tv->GetItem($pnode);
my $type = $pitem_info{-text};
my %item_info = $tv->GetItem($node);
my $name = $item_info{-text};
my $info = $INFO{$type}->{$name};
my $html;
if ($type eq "Properties") {
$html = property_html($info);
}
elsif ($type eq "Methods") {
$html = method_html($info);
}
elsif ($type eq "Events") {
$html = event_html($info);
}
else {
$html = "<p>Unknown type: $type (you shouldn't see this)</p>";
}
Display($html);
return 1;
}
sub Display{
my $html = shift;
# Clear the document window and send the new contents
# Ask Microsoft why they don't support the
# document.clear method
$mw->BW->GetOLE()->{Document}->open("about:bank", "_self");
$mw->BW->GetOLE()->{Document}->write($html);
$mw->BW->GetOLE()->{Document}->close();
}
sub property_html {
my $prop = shift;
my $html = "<h2>Property: $prop->{-Name}</h2>";
$html .= "<p>$prop->{-Description}</p>";
$html .= "<table>";
$html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>";
$html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>";
$html .= "<tr><td>VarType:</td><td>$prop->{-VarType}</td></tr>";
$html .= "<tr><td>Readonly:</td><td>".($prop->{-ReadOnly}?"Yes":"No")."</td></tr>";
$html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>";
$html .= "</table>";
my $enumstr = $prop->{-EnumValue};
if (length($enumstr) > 0) {
$html .= "<h3>Enumerated values</h3>";
$html .= "<table border='1' cellspacing='0'>";
for my $pair (split /,/, $enumstr) {
my ($name, $value) = split /=/, $pair;
$html .= "<tr><td>$name</td><td>$value</td></tr>";
}
$html .= "</table>";
}
return $html;
}
sub method_html {
my $prop = shift;
my $html = "<h2>Method: $prop->{-Name}</h2>";
$html .= "<p>$prop->{-Description}</p>";
$html .= "<table>";
$html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>";
$html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>";
$html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>";
$html .= "</table>";
return $html;
}
sub event_html {
my $prop = shift;
my $html = "<h2>Event: $prop->{-Name}</h2>";
$html .= "<p>$prop->{-Description}</p>";
$html .= "<table>";
$html .= "<tr><td>Name:</td><td>$prop->{-Name}</td></tr>";
$html .= "<tr><td>Prototype:</td><td>$prop->{-Prototype}</td></tr>";
$html .= "<tr><td>ID:</td><td>$prop->{-ID}</td></tr>";
$html .= "</table>";
return $html;
}
# Enumerate registry key HKCR\CLSID. All classes with a 'Control'
# subkey are ActiveX controls
sub getInstalledControls {
my $abort = 0;
LoadingWindow::Show($mw);
my @controls = ();
my $clsidkey = Win32::TieRegistry->new(
"HKEY_CLASSES_ROOT/CLSID/",
{ Access => "KEY_READ", Delimiter => '/', }
);
my $r = $clsidkey->TiedRef();
LoadingWindow::SetRange(scalar keys %$r);
while(my ($key, $value) = each %$r) {
$abort = LoadingWindow::Step();
last if $abort;
# next, unless we have an ActiveX control
next unless ref($value) and exists $value->{Control};
my $ProgID = $value->{ProgID}->{'/'};
# Some controls appear to have an empty name
next unless defined $ProgID and length $ProgID > 0;
my $VIProgID = $value->{VersionIndependentProgID}->{'/'};
$ProgID .= " ($VIProgID)" if defined $VIProgID and length $VIProgID > 0;
push @controls, $ProgID;
}
LoadingWindow::Close();
return $abort ? undef : \@controls;
}
# package to wrap the progress bar that we show while
# loading stuff from the registry
package LoadingWindow;
our ($win,$terminate);
# Initialise and show the progress bar mini-window
sub Show {
my $parent = shift;
$terminate = 0;
$win = Win32::GUI::Window->new(
-parent => $parent,
-title => "Loading ...",
-size => [200,50],
-toolwindow => 1,
-onTerminate => sub {$terminate = 1; 1;},
) or die "new Lwindow";
$win->Center($parent);
$win->AddProgressBar(
-name => 'PB',
-size => [$win->ScaleWidth(),$win->ScaleHeight()],
-smooth => 1,
) or die "new Lprogress";
$win->PB->SetStep(1);
$win->Show();
Win32::GUI::DoEvents();
return 1;
}
# Set the max ranges of the progress bar
# (to the number of itertations of the
# loop we will do)
sub SetRange {
$win->PB->SetRange(0, shift) if $win;
return 1;
}
# Step the progress bar. Return 1 if we expect
# the caller to abort
sub Step {
return 1 if $terminate;
$win->PB->StepIt() if $win;
Win32::GUI::DoEvents();
return 0;
}
# Hide the min-window, and free any resources
# it is using; prepare for it to be used again
sub Close {
if($win) {
Win32::GUI::DoEvents();
$win->Hide();
Win32::GUI::DoEvents();
undef $win;
undef $terminate;
}
return 1;
}