[Perl Tk] Mysql Manager

  • 0 Respuestas
  • 1377 Vistas

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

Desconectado BigBear

  • *
  • Underc0der
  • Mensajes: 543
  • Actividad:
    0%
  • Reputación 3
    • Ver Perfil

[Perl Tk] Mysql Manager

  • en: Agosto 19, 2011, 11:30:07 pm
Esta es la nueva version grafica de este simple cliente mysql

Una imagen seria




Código: Perl
  1. #!usr/bin/perl
  2. #Mysql Manager (C) Doddy Hackman 2011
  3. #ppm install http://www.bribes.org/perl/ppm/DBI.ppd
  4. #ppm install http://theoryx5.uwinnipeg.ca/ppms/DBD-mysql.ppd
  5.  
  6. use Tk;
  7. use Tk::ROText;
  8. use Tk::PNG;
  9. use DBI;
  10.  
  11. if ($^O eq 'MSWin32') {
  12. use Win32::Console;
  13. Win32::Console::Free();
  14. }
  15.  
  16. my $nave = MainWindow->new(-background=>"black",-foreground=>"orange");
  17.  
  18. $nave->title("Mysql Manager");
  19. $nave->geometry("210x160+20+20");
  20. $nave->resizable(0,0);
  21.  
  22. $nave->Label(-text=>"Host : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>10);
  23. my $host = $nave->Entry(-width=>22,-text=>"localhost",-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>13);
  24.  
  25. $nave->Label(-text=>"User : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>40);
  26. my $user = $nave->Entry(-width=>22,-text=>"root",-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>43);
  27.  
  28. $nave->Label(-text=>"Pass : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>10,-y=>70);
  29. my $pass = $nave->Entry(-width=>22,-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>73);
  30.  
  31. $nave->Button(-text=>"Connect",-width=>13,-command=>\&now,-background=>"black",-foreground=>"orange",-activebackground=>"orange")->place(-x=>60,-y=>120);
  32.  
  33. MainLoop;
  34.  
  35. sub now {
  36.  
  37. my $host = $host->get;
  38. my $user = $user->get;
  39. my $pass = $pass->get;
  40.  
  41. $info = "dbi:mysql::".$host.":3306";
  42.  
  43. if (my $enter = DBI->connect($info,$user,$pass,{PrintError=>0})) {
  44.  
  45. $nave->destroy;
  46.  
  47. my $man = MainWindow->new(-background=>"black",-foreground=>"orange");
  48. $man->title("Mysql Manager (C) Doddy Hackman 2011");
  49. $man->geometry("650x540+20+20");
  50. $man->resizable(0,0);
  51. my $f = $man->Photo(-file=>"foto.png",-format=>"PNG");
  52. $man->Label(-image=>$f,-borderwidth=>0)->place(-x=>20,-y=>20);
  53. $man->Label(-text=>"Query : ",-font=>"Impact1",-background=>"black",-foreground=>"orange")->place(-x=>73,-y=>230);
  54. my $ac = $man->Entry(-width=>60,-background=>"black",-foreground=>"orange")->place(-x=>135,-y=>233);
  55. $man->Button(-width=>8,-text=>"Execute",-command=>\&tes,-background=>"black",-foreground=>"orange",-activebackground=>"orange")->place(-x=>510,-y=>233);
  56. my $out = $man->ROText(-width=>74,-height=>15,-background=>"black",-foreground=>"orange")->place(-x=>60,-y=>293);
  57.  
  58. sub tes {
  59. my $ac = $ac->get;
  60. $re = $enter->prepare($ac);
  61. $re->execute();
  62. my $total = $re->rows();
  63.  
  64. my @columnas = @{$re->{NAME}};
  65.  
  66. if ($total eq "-1") {
  67. $out->insert("end","\n[-] Query Error\n");
  68. next;
  69. } else {
  70. $out->insert("end","\n<ul class="bbc_list"><li type="square"> Result of the query\n");[/li][/list]
  71. if ($total eq 0) {
  72. $out->insert("end","\n</li><li type="square"> Not rows returned\n\n");[/li][/list]
  73. } else {
  74. $out->insert("end","\n</li><li type="square"> Rows returned : ".$total."\n\n");[/li][/list]
  75. for(@columnas) {
  76. $out->insert("end",$_."\t");
  77. }
  78. $out->insert("end","\n\n");
  79. while (@row = $re->fetchrow_array) {
  80. for(@row) {
  81. $out->insert("end",$_."\t");
  82. }
  83. $out->insert("end","\n");
  84. }}}}
  85. } else {
  86. msg("Mysql Manager","Error in the connection");
  87. }
  88. }
  89.  
  90.  
  91. sub msg {
  92.  
  93. my $color_fondo = "black"; #white
  94. my $color_letra = "orange"; #black
  95.  
  96. my ($titulo,$contenido) = @_;
  97.  
  98. my $mensaje = MainWindow->new(-background=>$color_fondo,-foreground=>$color_letra);
  99. $mensaje->title($titulo);
  100. $mensaje->geometry("200x50+20+20");
  101. $mensaje->resizable(0,0);
  102. $mensaje->Label(-text=>$contenido,-font=>"Impact1",-background=>$color_fondo,-foreground=>$color_letra)->place(-y=>15,-x=>20);
  103.  
  104. MainLoop;
  105.  
  106. }
  107.  
  108. # ¿ The End ?
  109.  

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

Código: [Seleccionar]
http://doddyhackman.webcindario.com/descargas/mysqlman.rar
« Última modificación: Marzo 14, 2015, 10:16:10 am por Expermicid »

 

Tutorial perl desde cero By: Black Poision & Painboy

Iniciado por ProcessKill

Respuestas: 2
Vistas: 5327
Último mensaje Septiembre 02, 2011, 09:43:36 pm
por blozzter
[Perl] Verificando si es root para correr un script

Iniciado por c1st

Respuestas: 1
Vistas: 3472
Último mensaje Octubre 07, 2012, 06:01:39 pm
por ANTRAX
[Uniscan] Scanner de vulnerabilidades WEB hecho en Perl

Iniciado por tar3kw0rm3d

Respuestas: 0
Vistas: 3012
Último mensaje Junio 02, 2013, 08:01:28 pm
por tar3kw0rm3d
[Perl] Counter Strike 1.6 Servers List

Iniciado por BigBear

Respuestas: 0
Vistas: 2560
Último mensaje Noviembre 12, 2012, 07:32:11 pm
por BigBear
DoSing IP 1.0 - [Creado por SkillmaX] + Source [PERL]

Iniciado por SkillmaX

Respuestas: 0
Vistas: 2598
Último mensaje Julio 04, 2010, 10:14:31 am
por SkillmaX