[Perl Tk] Mysql Manager

Iniciado por BigBear, Agosto 19, 2011, 11:30:07 PM

Tema anterior - Siguiente tema

0 Miembros y 1 Visitante están viendo este tema.

Agosto 19, 2011, 11:30:07 PM Ultima modificación: Marzo 14, 2015, 10:16:10 AM por Expermicid
Esta es la nueva version grafica de este simple cliente mysql

Una imagen seria




Código: perl

#!usr/bin/perl
#Mysql Manager (C) Doddy Hackman 2011
#ppm install http://www.bribes.org/perl/ppm/DBI.ppd
#ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd

use Tk;
use Tk::ROText;
use Tk::PNG;
use DBI;

if ($^O eq 'MSWin32') {
use Win32::Console;
Win32::Console::Free();
}

my $nave = MainWindow->new(-background=>"black",-foreground=>"orange");

$nave->title("Mysql Manager");
$nave->geometry("210x160+20+20");
$nave->resizable(0,0);

$nave->Label(-text=>"Host : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>10);
my $host = $nave->Entry(-width=>22,-text=>"localhost",-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>13);

$nave->Label(-text=>"User : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>40);
my $user = $nave->Entry(-width=>22,-text=>"root",-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>43);

$nave->Label(-text=>"Pass : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>70);
my $pass = $nave->Entry(-width=>22,-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>73);

$nave->Button(-text=>"Connect",-width=>13,-command=>\&now,-background=>"black",-foreground=>"orange",-activebackground=>"orange")->place(-x=>60,-y=>120);

MainLoop;

sub now {

my $host = $host->get;
my $user = $user->get;
my $pass = $pass->get;

$info = "dbi:mysql::".$host.":3306";

if (my $enter = DBI->connect($info,$user,$pass,{PrintError=>0})) {

$nave->destroy;

my $man = MainWindow->new(-background=>"black",-foreground=>"orange");
$man->title("Mysql Manager (C) Doddy Hackman 2011");
$man->geometry("650x540+20+20");
$man->resizable(0,0);
my $f = $man->Photo(-file=>"foto.png",-format=>"PNG");
$man->Label(-image=>$f,-borderwidth=>0)->place(-x=>20,-y=>20);
$man->Label(-text=>"Query : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>73,-y=>230);
my $ac = $man->Entry(-width=>60,-background=>"black",-foreground=>"orange")->place(-x=>135,-y=>233);
$man->Button(-width=>8,-text=>"Execute",-command=>\&tes,-background=>"black",-foreground=>"orange",-activebackground=>"orange")->place(-x=>510,-y=>233);
my $out = $man->ROText(-width=>74,-height=>15,-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>293);

sub tes {
my $ac = $ac->get;
$re = $enter->prepare($ac);
$re->execute();
my $total = $re->rows();

my @columnas = @{$re->{NAME}};

if ($total eq "-1") {
$out->insert("end","\n[-] Query Error\n");
next;
} else {
$out->insert("end","\n[+] Result of the query\n");
if ($total eq 0) {
$out->insert("end","\n[+] Not rows returned\n\n");
} else {
$out->insert("end","\n[+] Rows returned : ".$total."\n\n");
for(@columnas) {
$out->insert("end",$_."\t");
}
$out->insert("end","\n\n");
while (@row = $re->fetchrow_array) {
for(@row) {
$out->insert("end",$_."\t");
}
$out->insert("end","\n");
}}}}
} else {
msg("Mysql Manager","Error in the connection");
}
}


sub msg {

my $color_fondo = "black"; #white
my $color_letra = "orange"; #black

my ($titulo,$contenido) = @_;

my $mensaje = MainWindow->new(-background=>$color_fondo,-foreground=>$color_letra);
$mensaje->title($titulo);
$mensaje->geometry("200x50+20+20");
$mensaje->resizable(0,0);
$mensaje->Label(-text=>$contenido,-font=>"Impact1",-background=>$color_fondo,-foreground=>$color_letra)->place(-y=>15,-x=>20);

MainLoop;

}

# ¿ The End ?


Para bajar el script con el logo lo pueden hacer de aca

Código: php

http://doddyhackman.webcindario.com/descargas/mysqlman.rar