#!/usr/bin/perl
#
# GetHostInfoTk_1.0.pl
#
# Version 1.0 2007.04.23 - 2007.10.24
# (c) 2007 por Javier Pérez Montes - el.maquinas@terra.es
#
##########
# MODULOS
#
use strict;
use Tk;
use Tk::DialogBox;
use Win32::TieRegistry( Delimiter=>"#", ArrayValues=>0 );
sub ObtenerInformacion;
sub ObtenerSoftware;
sub Borrar;
#############
# CONSTANTES
#
my $VERSION       = "1.0";
my $DELIMITADOR = '/';
my $HOSTNAME = 'espmadf022208';
# Construcción de la ventana y eventos
my $mw = MainWindow->new(-width=>700);
$mw->title("Win32 GetHostInfoTk ".$VERSION);
$mw->configure( -width=>200, -height=>300);
$mw->resizable( 0, 0 ); # not resizable in any direction
# Construyo los campos
my $frame1 = $mw->Frame()->pack(-expand => '1', -fill => 'both', -side => 'top');
$frame1->Label(-text => "Nombre de equipo (hostname):")->pack(-side => 'left', -padx => '4');
my $hostname = $frame1->Entry(-width => '15', -relief => 'sunken')->pack(-side => 'left', -expand => '0', -fill => 'x', -padx => '4', -pady => '10');
# Marco 2
my $frame2 = $mw->Frame()->pack(-expand => '1', -fill => 'both', -side => 'bottom', -padx => '4', -pady => '10');
$frame2->Label(-text => "Resultado:")->pack(-side => 'top', -padx => '4');
my $vscrollbar = $frame2->Scrollbar(-orient => 'vertical');
my $hscrollbar = $frame2->Scrollbar(-orient => 'horizontal');
my $texto = $frame2->Text(wrap => 'none', -xscrollcommand => ['set' , $hscrollbar], -yscrollcommand => ['set' , $vscrollbar]);
$vscrollbar->configure(-command => ['yview', $texto]);
$vscrollbar->pack(-side => 'right', -fill => 'y');
$hscrollbar->configure(-command => ['xview', $texto]);
$hscrollbar->pack(-side => 'bottom', -fill => 'x');
$texto->pack(-expand => '1', -fill => 'both', -side => 'bottom', -padx => '4', -pady => '10');
$texto->tagConfigure('normal', -font => [-size => '10', -weight => 'normal']);
$texto->tagConfigure('bold', -font => [-size => '10', -weight => 'bold']);
# Marco 3
my $frame3 = $mw->Frame()->pack(-expand => '1', -fill => 'both', -side => 'bottom', -padx => '4', -pady => '10');
$frame3->Button(-text => "Aceptar", -underline => '0', -command => sub { ObtenerInformacion; })->pack(-side => "left");
$frame3->Button(-text => "Borrar", -underline => '0', -command => sub { Borrar; })->pack(-side => "left", -padx => '4');
$frame3->Button(-text => "Salir", -underline => '0', -command => sub { exit; })->pack(-side => "right");
# Remapeado de teclas.
$mw->bind('<KeyPress-Return>' => sub { ObtenerInformacion; });
$mw->bind('<KeyPress-Escape>' => sub { exit; });
#
$hostname->focus;
MainLoop;

exit(0);
############
# FUNCIONES
#

sub Borrar {
    $hostname -> delete(0,length($hostname -> get)) if (length($hostname -> get) > 0);
}

sub ObtenerSoftware {
    # Obtengo el contenido de la rama Uninstall
    my $RAMA = 'LMachine/Software/Microsoft/Windows/CurrentVersion/Uninstall/';
    my $CLAVE = 'DisplayName';
    my $pound= $Registry->Delimiter($DELIMITADOR);
    #
    $texto->insert("end", "Software instalado en $HOSTNAME.\n\n", ['bold']);
    print "Software installed on $HOSTNAME.\n\n";
    my $uninstKey= $Registry->{"//$HOSTNAME/$RAMA"} or  die "No puedo leer //$HOSTNAME/$RAMA: $^E\n";
    my %myhash = %$uninstKey;
    my @lista;
    foreach my $entry ( sort keys(%myhash) ) {
        # Compruebo si la referencia esta vacia
        if ($myhash{$entry} ne '') {
            push @lista, $myhash{$entry}{$CLAVE} if (exists($myhash{$entry}{$CLAVE}));
        }
    }
    foreach(sort { "\L$a" cmp "\L$b" } @lista){
        $texto->insert("end", $_."\n",['normal']); 
        print $_."\n";
    }
}

sub ObtenerDatosGenerales {
    my $RAMA = 'LMachine/SYSTEM/CurrentControlSet/Control/ComputerName/ActiveComputerName/';
    my $pound= $Registry->Delimiter($DELIMITADOR);
    $texto->insert('end', "\nInformación general de $HOSTNAME.\n\n", ['bold', 'blue']); 
    my $hardware = $Registry->{"//$HOSTNAME/$RAMA"} or  die "No puedo leer //$HOSTNAME/$RAMA: $^E\n";
    my %myhash = %$hardware;
    $texto->insert("end", "Nombre de equipo: ".$myhash{'/ComputerName'}."\n",['normal']);
    #
    $RAMA = 'LMachine/Software/Microsoft/Windows NT/CurrentVersion/';
    $hardware = $Registry->{"//$HOSTNAME/$RAMA"} or  die "No puedo leer //$HOSTNAME/$RAMA: $^E\n";
    %myhash = %$hardware;
    $texto->insert("end", 'S.O.: '.$myhash{'/ProductName'}."\n",['normal'],'Versión: '.$myhash{'/CurrentVersion'}."\n",['normal'], 'CSDVersion: '.$myhash{'/CSDVersion'}."\n", ['normal']);
    #
    $RAMA = 'LMachine/HARDWARE/Description/System/CentralProcessor/';
    $hardware = $Registry->{"//$HOSTNAME/$RAMA"} or  die "No puedo leer //$HOSTNAME/$RAMA: $^E\n";
    %myhash = %$hardware;
    my $k=0;
    foreach (keys(%myhash) ) { $k++ if ($_ =~ /^\d+\/$/); }
    $texto->insert("end", 'Número de procesadores: '.$k."\n",['normal']);
    $k = 1;
    foreach ( sort keys(%myhash) ) {
        my $aux = $myhash{$_};
        my %cpu = %$aux;
        s/\///;
        $texto->insert("end", "Procesador $k: ".$cpu{'/ProcessorNameString'}."\n",['normal'], "\tIdentificador: ".$cpu{'/Identifier'}."\n",['normal'], "\tIdentificador de fabricante: ".$cpu{'/VendorIdentifier'}."\n",['normal'], "\tVelocidad (MHz): ".hex($cpu{'/~MHz'})."\n",['normal']);
        $k++;
    }
    #CachePrimaryDomain
    $RAMA = 'LMachine/Software/Microsoft/Windows NT/CurrentVersion/Winlogon/';
    $hardware = $Registry->{"//$HOSTNAME/$RAMA"} or  die "No puedo leer //$HOSTNAME/$RAMA: $^E\n";
    %myhash = %$hardware;
    $texto->insert("end", "\nNombre del usuario que ha inciado sesión en el equipo: ".$myhash{'/DefaultUserName'}."\n",['normal'],"Dominio: ".$myhash{'/CachePrimaryDomain'}."\n",['normal']);
    #
    $texto->insert("end", "\n",['normal']);
}

sub ObtenerInformacion {
    $HOSTNAME = $hostname -> get;
    if (length($HOSTNAME) > 0) {
        ObtenerDatosGenerales;
        ObtenerSoftware;
    } else {
        warn "No introdujo ningún nombre de equipo.\n";
        my $dialog = $mw->DialogBox( -title   => "Advertencia", -buttons => [ "Aceptar" ]);
        $dialog->add("Label", -text => "No introdujo ningún nombre de equipo.\n")->pack;
        $dialog->Show;
    }
}

=head1 NAME

Win32_GetHostInfoTk.pl

=head1 DESCRIPTION

Sample script that grabs information from windows registry.
Script de ejemplo que extrae información del registro de windows.

=head1 README


Win32_GetHostInfoTk is sample Perl/Tk script that shows you
how to get information from Windows registry through
the module Win32::TieRegistry.

It has a simple user interface where you can place the computer
from wich you will get the information.

The script get some hardware information and the list of
installed applications.

Remember that user rights applies, if your users has not the
right rights you would not get the expected information.

Works only under Microsoft Windows.
Tested under Windows 2000 and XP operating systems.

Sorry English users this software was written in Spanish.
Feel free to contact the author for more information.


Win32_GetHostInfoTk es un script Perl/Tk de ejemplo
que le mostrará como obtener información del registro de
Windows por medio del módulo Win32::TieRegistry.

Tiene una sencilla interfaz de usuario donde puede introducir
el nombre del equipo del cual quiera obtener la información.

Obtiene datos hardware y la lista de software instalado.

Recuerde que los derechos de usuarios se aplican en este caso,
si su usuario de Window no tiene los derechos adecuado no
podrá obtener la información.

Sólo funciona bajo Windows.
Se ha probado bajo equipos con Windows 2000 y XP.

=head1 PREREQUISITES

This script requires the C<strict> module.  It also requires C<Tk>, C<Tk::DialogBox> and C<Win32::TieRegistry>.

=head1 COREQUISITES

=pod OSNAMES

MSWin32

=pod SCRIPT CATEGORIES

Educational
Win32
Win32/Utilities

=head1 AUTHOR

Win32_GetHostInfoTk.pl - Copyright 2007 Javier Pérez Montes,  All rights reserved.

This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
Este script es software libre, puede redistribuirlo y/o modificarlo bajo los mismo términos que Perl.

=cut