Tag Archives: Captcha

Captcha creation in perl

use CGI;
use vars qw( $q $dbh);
use CGI::Carp qw(fatalsToBrowser);
use Digest::SHA qw(sha512_base64);
use GD::SecurityImage backend => 'Magick';
use Digest::MD5;
#-------------------------------Database Connection-----------------------------
$q = new CGI;
$CGI::HEADERS_ONCE = 1;
my $dbh = &getDatabaseConnection();
my $dbhi= &getDatabaseConnectioni();
#-------------------------------------------------------------------------------
print $q->header("text/html");
my $msssg='';
sub createSecretString{
    my $id = "";
    my @CharList = ("a".."z",0..9,"A".."Z");
    my $x;
    for($x=0;$x<14;$x++){
        $id .= $CharList[int(rand(62))];
    }
    my $sessionid=Digest::MD5->md5_hex($$.time().$id);
    return $sessionid;
}
sub createCaptchaString{
    my $id = "";
    my @CharList = ("a".."z",0..9,"A".."Z");
    my $x;
    for($x=0;$x<=6;$x++){
        $id .= $CharList[int(rand(62))];
    }
    return $id;
}

sub printbodyx{
    my $rand_string = &createCaptchaString;
    my $image = GD::SecurityImage->new(
        width => 300,
        height => 100,
        ptsize => 25,
        lines => 100,
        thickness => 4,
        rndmax => 4,
        scramble => 2,
        send_ctobg => 1,
        bgcolor => '#ffffff',
        font => 'ARIALBD.TTF',
    );
    $image->random($rand_string);
    $image->create( qw/ ttf blank #000000 #7D011D / );
    $image->particle(500, 1);
    my($image_data, $mime_type, $random_number) = $image->out;
    my $secret_string = &createSecretString();
    $dbh->do(qq{
        INSERT INTO
            image_validation
                (secret_number,secret_key,time_added)
        VALUES
            (?,?,NOW())
    },undef,$random_number,$secret_string);
    my ($image_id) = $dbh->selectrow_array("SELECT LAST_INSERT_ID() FROM image_validation");
    open(WRT,">/captcha/$image_id.png");
    binmode(WRT);
    print WRT $image_data;
    close(WRT);
    if(defined($q->param('submit'))) {
        my $secret_number = $q->param('secret_number');
        my $secret_string = $q->param('secret_string');
        my($image_id,$db_number)=$dbh->selectrow_array(qq{
            SELECT
                image_id,secret_number
            FROM
                image_validation
            WHERE
                secret_key = ?
        },undef,$secret_string);
        if(!$db_number || ($db_number ne $secret_number)) {
            $msssg=&printError("The code entered does not match. Please try again.");
        } else {
            $msssg= qq{OK};
        }
    }
    print qq{
        <table>
            <tr>
                <td style="padding-left: 25px; width: 414px; background-color: rgb(255, 249, 250);">Capcha</td>
                <td style="padding-left: 25px; width: 15px; background-color: rgb(255, 249, 250); white-space: nowrap;">
                    <span style="font-size:20px;"><strong>:</strong></span>
                </td>
                <td style="width: 414px; background-color: rgb(255, 249, 250);">
                    <img alt="CAPTCHA" src="/captcha/$image_id.png" id="captcha_img" style="border:1px solid #7D011D;width:250px;height:90px;" />
                    &nbsp;<img alt="refresh" style="width:15px;height:15px;cursor: pointer;" name="refresh" id="refresh" src="/images/refresh.png" onclick="captch_change()">
                </td>
            </tr>
            <tr>
                <td style="padding-left: 25px; width: 414px; background-color: rgb(255, 249, 250);">Enter code&nbsp;<font color="#FF0000">*</font></td>
                <td style="padding-left: 25px; width: 15px; background-color: rgb(255, 249, 250); white-space: nowrap;">
                    <span style="font-size:20px;"><strong>:</strong></span>
                </td>
                <td style="width: 414px; background-color: rgb(255, 249, 250);">
                    <input id="secret_number" maxlength="100" name="secret_number" style="width:300px;" type="text" />
                    <input name="secret_string" id="secret_string" type="hidden" value="$secret_string" />
                    <br/>
                    <span style="color:#ff0000;font-size:9pt;font-weight:bold;" id="warning"> </span>
                </td>
            </tr>
            <tr>
                <td colspan="3" style="background-color: rgb(255, 249, 250); width: 414px; text-align: center;">
                    <input id="submitx" name="submitx" style="border:2px outset #799D35;" type="button" onclick="validate()" value="Submit" />
                    <input id="Reset" name="Reset" style="border:2px outset #799D35;" type="reset" value="Reset" />
                </td>
            </tr>
        </table>
    };
}

sub printError{
    my($head,$message)=@_;
    $err_capcha = qq{<b><div style="color:#FF0000" align="center">$head</div></b>$message};
    return $err_capcha;
}