Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?

Sqltest - A SQL password testing utility with Perl/Tk

by perlsage (Scribe)
on May 09, 2003 at 11:41 UTC ( #256827=sourcecode: print w/replies, xml ) Need Help??
Category: Win32 Stuff
Author/Contact Info perlsage

A small SQL password testing tool I wrote few years back, hope its some use to someone.

  • tests windows login and sql login
  • generates a html report
  • has Perl/Tk gui
  • password(s), server(s) and/or userid(s) can be given in a file
use Tk;
use DBI;


sub MYIP{
    $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);
    if (defined $ufile){
sub PWD{
    print "Browse clicked\n".($tp->get());
    $tx=$mw->FileSelect(-directory => $start_dir);
    if (defined $pfile){
sub SRV{
    print "Browse clicked\n".($ts->get());
    $tx=$mw->FileSelect(-directory => $start_dir);
    if (defined $sfile){
sub DOIT{
if (open (FILE,$sfile)){
    undef @srv;
    for (<FILE>){
        chomp $_;
        push  @srv,lc $_;
    close FILE
if (open (FILE,$pfile)){
    undef @pwd;
    for (<FILE>){
        chomp $_;
        push @pwd,$_;
    close FILE
if (open (FILE,$ufile)){
    undef @uid;
    for (<FILE>){
        chomp $_;
        push @uid,$_;
    close FILE
    #add error window

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


foreach $x1 (@srv){
    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>";
        chomp $str;
    if ($str=~/\bnot found\b/g){
    print LOG "<td><b>$x1</b></td><td>$name</td><td>Windows authentica
    foreach $x2 (@uid){
        foreach $x3 (@pwd){
                my $DSN='driver={SQL Server};Server='.$x1.';UID='.$x2.
                my $dbh = DBI->connect("dbi:ODBC:$DSN","$x2","$x3");
                if ($DBI::errstr){
                    chomp $str;
                    if ($str=~/\bdoes not exist\b/g){
                    if ($str=~/\bLogin failed\b/g){
                        $str="<td bgcolor=#99FF99>".$str."</td>";
                        $str="<td bgcolor=orange>".$str."</td>";
                unless ($DBI::errstr){
                    $str= "<td><font color=red><b>Logged into database
                    $ver=$dbh->prepare('select @@version');
                    unless (exists $version{$x1}){
                        while (my $row = $ver->fetchrow_array){
                if ($pwdc<4){
                    $pwdc=$pwdc."st" if ($pwdc eq 1);
                    $pwdc=$pwdc."nd" if ($pwdc eq 2);
                    $pwdc=$pwdc."rd" if ($pwdc eq 3);
                print LOG "<td></td><td></td><td>Sql server authentica
                chop $pwdc;chop $pwdc;
            $pwdt += $pwdc;
    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
$tu=$mw->Entry(-takefocus=>1, -width=>30)->pack;
$tp=$mw->Entry(-width=>20, -show=>"*")->pack;
$mw->Button(-text => "Start", -command =>\&DOIT)->pack(-side=>"left");


Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://256827]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (3)
As of 2022-08-18 22:41 GMT
Find Nodes?
    Voting Booth?

    No recent polls found