use Tk;
use DBI;

$serverc=0;
$uidc=0;
$pwdc=0;
$start_dir=Win32::GetCwd();

sub MYIP{
    $name=();
    $name=gethostbyname($x1);
    $name=join '.',unpack('C4',$name);
}#returns ip addresses to the computer, does not do the job twice

sub UID{
    print "Browse clicked\n".($tu->get());
    $tx=$mw->FileSelect(-directory => $start_dir);
    $ufile=$tx->Show;
    if (defined $ufile){
        $ufile=~s/\//\\/g;
        $ufile=~s/\\\\/\\/g;}
    $tu->insert(0,$ufile);
    $tu->focus();
    }
sub PWD{
    print "Browse clicked\n".($tp->get());
    $tx=$mw->FileSelect(-directory => $start_dir);
    $pfile=$tx->Show;
    if (defined $pfile){
        $pfile=~s/\//\\/g;
        $pfile=~s/\\\\/\\/g;}
    $tp->insert(0,$pfile);
    $tp->focus();
    }
sub SRV{
    print "Browse clicked\n".($ts->get());
    $tx=$mw->FileSelect(-directory => $start_dir);
    $sfile=$tx->Show;
    if (defined $sfile){
        $sfile=~s/\//\\/g;
        $sfile=~s/\\\\/\\/g;
    }
    $ts->insert(0,$sfile);
    $ts->focus();
}
sub DOIT{
if (open (FILE,$sfile)){
    undef @srv;
    for (<FILE>){
        chomp $_;
        push  @srv,lc $_;
    }
    close FILE
}else{
    @srv=split(/;/,($ts->get()));
}
if (open (FILE,$pfile)){
    undef @pwd;
    for (<FILE>){
        chomp $_;
        push @pwd,$_;
    }
    close FILE
}else{
    @pwd=split(/;/,($tp->get()));}
if (open (FILE,$ufile)){
    undef @uid;
    for (<FILE>){
        chomp $_;
        push @uid,$_;
    }
    close FILE
}else{
    @uid=split(/;/,($tu->get()));
}
    #add error window
$now=localtime();

open (LOG, ">>sqllog.html");
print LOG "<table border=1 cellpadding=2><caption>$now</caption><tr bg
+round=grey><th>Server</th><th>IP address</th><th>Connect using</th><t
+h>UserID</th><th>Password</th><th>Information</th><th>Version</th></t
+r>\n";

$serverc=0;
$uidc=0;
$pwdc=0;
$pwdt=0;

foreach $x1 (@srv){
    $serverc++;
    $pwdc=0;
    $no_exist=0;
    my $DXN='driver={SQL Server};Server='.$x1;
    my $dbh=DBI->connect("dbi:ODBC:$DXN");
    if (!$DBI::errstr){
        $str="<font color=red><b>Logged into database</b></font>";
    }else{
        $str=$DBI::errstr;
        chomp $str;
        $str=~s/\[.*\]//g;}
    if ($str=~/\bnot found\b/g){
        $no_exist++;
    }
    &MYIP();
    print LOG "<td><b>$x1</b></td><td>$name</td><td>Windows authentica
+tion</td><td></td><td></td><td>$str</td><td></td></tr>\n";
    $str=();
    foreach $x2 (@uid){
        $uidc++;
        foreach $x3 (@pwd){
            $pwdc++;
            unless($no_exist>1){
                $str=();
                my $DSN='driver={SQL Server};Server='.$x1.';UID='.$x2.
+';PWD='.$x3.';';
                my $dbh = DBI->connect("dbi:ODBC:$DSN","$x2","$x3");
                if ($DBI::errstr){
                    $str=$DBI::errstr;
                    chomp $str;
                    $str=~s/\[.*\]//g;
                    if ($str=~/\bdoes not exist\b/g){
                        $no_exist++;
                    }
                    if ($str=~/\bLogin failed\b/g){
                        $str="<td bgcolor=#99FF99>".$str."</td>";
                    }else{
                        $str="<td bgcolor=orange>".$str."</td>";
                    }
                }
                unless ($DBI::errstr){
                    $str= "<td><font color=red><b>Logged into database
+</b></font></td>";
                    $ver=$dbh->prepare('select @@version');
                    unless (exists $version{$x1}){
                        $ver->execute;
                        while (my $row = $ver->fetchrow_array){
                            $row=~/(\b\d+\.\d+.\d+\b)/g;
                            $version{$x1}=$1;
                        }
                        $ver->finish();
                    }
                }
                if ($pwdc<4){
                    $pwdc=$pwdc."st" if ($pwdc eq 1);
                    $pwdc=$pwdc."nd" if ($pwdc eq 2);
                    $pwdc=$pwdc."rd" if ($pwdc eq 3);
                }else{
                    $pwdc=$pwdc."th";
                }
                print LOG "<td></td><td></td><td>Sql server authentica
+tion</td><td>$x2</td><td>$pwdc</td>$str<td>$version{$x1}</td></tr>\n"
+;
                chop $pwdc;chop $pwdc;
            }
            }
            $pwdt += $pwdc;
            $pwdc=0;
    }
    }
    print LOG "</table>";
    close LOG;
    $info="Tested $serverc servers with $uidc userids. \nWrote to file
+ $start_dir\\sqllog.html\n";
}
$mw = MainWindow -> new ;
$mw -> title("Sql Password Tester");
my $f= $mw->Frame(-relief=>"ridge",-borderwidth=>1)->pack(-expand=>1,-
+fill=>'x',-side=>'top', -anchor=>"nw");
$f->Menubutton(-text=>"File",-tearoff=>0,-menuitems=>[["command"=> "Us
+erID..",-command=>\&UID],["command"=> "Password..",-command=>\&PWD],[
+"command"=> "Server..",-command=>\&SRV],"-",["command"=>"Exit",-comma
+nd=>sub{exit;}]])->pack(-side=>"left");
$f->Menubutton(-text=>"Help",-tearoff=>0,-menuitems=>[["command"=>"Hel
+p"],"-",["command"=>"About"]])->pack(-side=>"right");
$mw->Label(-textvariable=>\$info)->pack(-fill=>"x",-side=>"top",-ancho
+r=>"nw");
$mw->Label(-text=>"userid")->pack;
$tu=$mw->Entry(-takefocus=>1, -width=>30)->pack;
$tu->focus;
$mw->Label(-text=>"password")->pack;
$tp=$mw->Entry(-width=>20, -show=>"*")->pack;
$mw->Label(-text=>"server")->pack;
$ts=$mw->Entry(-width=>20)->pack;
$mw->maxsize(380,270),$mw->minsize(380,270);
$mw->Button(-text => "Start", -command =>\&DOIT)->pack(-side=>"left");

MainLoop;
[download]