Jump to content


Photo

How to make Captcha?


  • Please log in to reply
14 replies to this topic

#1 devx

devx

    Newbie

  • Members
  • Pip
  • 3 posts

Posted 26 July 2011 - 12:07 PM

How to make Captcha?
thnx
  • 0

#2 Farshad Mohajeri

Farshad Mohajeri

    Administrator

  • Administrators
  • 10356 posts

Posted 26 July 2011 - 12:24 PM

You can use TUniImage to show the Captcha image. There are several ways to create the Captcha image itself which I believe there are 3rd party tools for it.
  • 0

#3 Jason Reid

Jason Reid

    Active Member

  • Members
  • PipPipPip
  • 89 posts

Posted 28 July 2011 - 12:44 PM

Heres an example of how you can make your very own captcha component based on TUniImage

unit UniCaptcha;

interface
uses
  classes,
  Graphics,
  uniImage;

type TUniCaptcha = class(TUniImage)
  private
    FChallenge : ShortString;
    procedure Render;
  public
    constructor create(Owner : TComponent); override;
    procedure SetChallenge(aChallenge : ShortString);
  published
    property Challenge  : ShortString    read FChallenge   write FChallenge;
end;

procedure Register;

implementation

constructor TUniCaptcha.Create(Owner: TComponent);
begin
  inherited;
end;

procedure TUniCaptcha.SetChallenge(aChallenge: ShortString);
begin
  FChallenge := aChallenge;
  Render;
end;

procedure TUniCaptcha.render;
Var
  b : TBitmap;
  i : Integer;
begin
  b := TBitmap.Create;
  with b do
  begin
    b.Width  := self.Width;
    b.height := self.Height;
    For i := 0 to 30 do begin
      randomize;
      canvas.Pen.Width     := random(5)+5;
      Canvas.Pen.Color     := random(64738)+64738;
      Canvas.Brush.Style   := bsFDiagonal;

      Canvas.Ellipse(random(width),random(Height),random(width),random(height));
    end;
    Canvas.Font.Color := clBlue;
    Canvas.Font.Size  := 18;
    Canvas.TextOut(10,trunc(self.height/2),FChallenge);
    Canvas.Font.Color := clRed;
    Canvas.TextOut(8,trunc(self.height/2)-2,FChallenge);
  end;

  Picture.Assign(<img src='http://forums.unigui.com/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />;
  b.Free;
end;

procedure Register;
begin
    RegisterComponents('UniCustom', [TUniCaptcha]);
end;

end.

you can use it something like this :
procedure TMainForm.UniFormCreate(Sender: TObject);
begin
  //InsertControl();
  UniCaptcha1.SetChallenge('Billybob cheats at cards!');
end;

There are loads of different ways to prevent character recognition and to validate, simply compare to the "Challenge" property :)

Attached Files


  • 0

#4 Jason Reid

Jason Reid

    Active Member

  • Members
  • PipPipPip
  • 89 posts

Posted 28 July 2011 - 01:31 PM

Then using a little sin() magic we can distort it to make it barely readable (Procedure Distort(aBitmap : TBitmap) ;).

unit UniCaptcha;

interface
uses
  classes,
  Graphics,
  uniImage;

type TUniCaptcha = class(TUniImage)
  private
    FChallenge : ShortString;
    procedure Render;
    Procedure  Distort(aBitmap : TBitmap) ;
  public
    constructor create(Owner : TComponent); override;
    procedure SetChallenge(aChallenge : ShortString);
  published
    property Challenge  : ShortString    read FChallenge   write FChallenge;
end;

procedure Register;

implementation

constructor TUniCaptcha.Create(Owner: TComponent);
begin
  inherited;
end;

Procedure TUniCaptcha.Distort(aBitmap: TBitmap);
var
  b : TBitmap;
  x,y : integer;
begin
  b := TBitmap.Create;
  b.Width  := aBitmap.Width;
  b.Height := aBitmap.Height;
  for x := 0 to aBitmap.Canvas.ClipRect.Right do
  begin
    for y := 0 to aBitmap.Canvas.ClipRect.Bottom do
    begin
      b.Canvas.Pixels[x,y +trunc(sin(x/4)*4)] :=
        aBitmap.Canvas.Pixels[x,y];
    end;
  end;
  Picture.Assign(<img src='http://forums.unigui.com/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />;
  b.Free;
end;

procedure TUniCaptcha.SetChallenge(aChallenge: ShortString);
begin
  FChallenge := aChallenge;
  Render;
end;

procedure TUniCaptcha.render;
Var
  b : TBitmap;
  i : Integer;
begin
  b := TBitmap.Create;
  with b do
  begin
    b.Width  := self.Width;
    b.height := self.Height;
    For i := 0 to 30 do begin
      randomize;
      canvas.Pen.Width     := random(5)+5;
      Canvas.Pen.Color     := random(64738)+64738;
      Canvas.Brush.Style   := bsFDiagonal;

      Canvas.Ellipse(random(width),random(Height),random(width),random(height));
    end;
    Canvas.Font.Color := clBlue;
    Canvas.Font.Size  := 18;
    Canvas.TextOut(10,trunc(self.height/2),FChallenge);
    Canvas.Font.Color := clRed;
    Canvas.TextOut(8,trunc(self.height/2)-2,FChallenge);
  end;
  distort(<img src='http://forums.unigui.com/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />;
  b.Free;
end;

procedure Register;
begin
    RegisterComponents('UniCustom', [TUniCaptcha]);
end;

end.

viola! 1 x hacker busting captcha :)

Attached Files


  • 0

#5 Farshad Mohajeri

Farshad Mohajeri

    Administrator

  • Administrators
  • 10356 posts

Posted 28 July 2011 - 01:40 PM

Cool!

Thanks for sharing.
  • 0

#6 Dionel Acosta Duarte

Dionel Acosta Duarte

    Advanced Member

  • Members
  • PipPipPipPip
  • 450 posts
  • LocationDominican Republic

Posted 28 July 2011 - 04:01 PM

Then using a little sin() magic we can distort it to make it barely readable (Procedure Distort(aBitmap : TBitmap) ;).

unit UniCaptcha;

interface
uses
  classes,
  Graphics,
  uniImage;

type TUniCaptcha = class(TUniImage)
  private
    FChallenge : ShortString;
    procedure Render;
    Procedure  Distort(aBitmap : TBitmap) ;
  public
    constructor create(Owner : TComponent); override;
    procedure SetChallenge(aChallenge : ShortString);
  published
    property Challenge  : ShortString    read FChallenge   write FChallenge;
end;

procedure Register;

implementation

constructor TUniCaptcha.Create(Owner: TComponent);
begin
  inherited;
end;

Procedure TUniCaptcha.Distort(aBitmap: TBitmap);
var
  b : TBitmap;
  x,y : integer;
begin
  b := TBitmap.Create;
  b.Width  := aBitmap.Width;
  b.Height := aBitmap.Height;
  for x := 0 to aBitmap.Canvas.ClipRect.Right do
  begin
    for y := 0 to aBitmap.Canvas.ClipRect.Bottom do
    begin
      b.Canvas.Pixels[x,y +trunc(sin(x/4)*4)] :=
        aBitmap.Canvas.Pixels[x,y];
    end;
  end;
  Picture.Assign(<img src='http://forums.unigui.com/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />;
  b.Free;
end;

procedure TUniCaptcha.SetChallenge(aChallenge: ShortString);
begin
  FChallenge := aChallenge;
  Render;
end;

procedure TUniCaptcha.render;
Var
  b : TBitmap;
  i : Integer;
begin
  b := TBitmap.Create;
  with b do
  begin
    b.Width  := self.Width;
    b.height := self.Height;
    For i := 0 to 30 do begin
      randomize;
      canvas.Pen.Width     := random(5)+5;
      Canvas.Pen.Color     := random(64738)+64738;
      Canvas.Brush.Style   := bsFDiagonal;

      Canvas.Ellipse(random(width),random(Height),random(width),random(height));
    end;
    Canvas.Font.Color := clBlue;
    Canvas.Font.Size  := 18;
    Canvas.TextOut(10,trunc(self.height/2),FChallenge);
    Canvas.Font.Color := clRed;
    Canvas.TextOut(8,trunc(self.height/2)-2,FChallenge);
  end;
  distort(<img src='http://forums.unigui.com/public/style_emoticons/<#EMO_DIR#>/cool.gif' class='bbc_emoticon' alt='B)' />;
  b.Free;
end;

procedure Register;
begin
    RegisterComponents('UniCustom', [TUniCaptcha]);
end;

end.

viola! 1 x hacker busting captcha :)


Two questions:

1- It is necessary "constructor" if you only call inherited method???

2- procedure TUniCaptcha.SetChallenge(aChallenge: ShortString); is declared, but the property does not use it. It is something missed???
  • 0

#7 Dionel Acosta Duarte

Dionel Acosta Duarte

    Advanced Member

  • Members
  • PipPipPipPip
  • 450 posts
  • LocationDominican Republic

Posted 28 July 2011 - 04:06 PM

One more questions, but in this case about "captcha itself".

The use of different colors could help the process of recognition of characters. Will be good to use some lines or circles of the same color across some letters.

PS: It is just a comment. Do not put much attention to it.
  • 0

#8 Jason Reid

Jason Reid

    Active Member

  • Members
  • PipPipPip
  • 89 posts

Posted 28 July 2011 - 05:09 PM

Two questions:

1- It is necessary "constructor" if you only call inherited method???

Nah.. I was playing with it, left it in in case I want to play with it again later.

procedure TUniCaptcha.SetChallenge(aChallenge: ShortString); is declared, but the property does not use it. It is something missed???


SetChallenge sets FChallenge := aChallenge.

aChallenge is a procedure argument, FChallenge is a private variable.

Property Challenge reads and writes FChallenge

its not a OO setter, just a method called SetChallenge.
  • 0

#9 Jason Reid

Jason Reid

    Active Member

  • Members
  • PipPipPip
  • 89 posts

Posted 28 July 2011 - 05:10 PM

One more questions, but in this case about "captcha itself".

The use of different colors could help the process of recognition of characters. Will be good to use some lines or circles of the same color across some letters.

PS: It is just a comment. Do not put much attention to it.


Sure! You can draw whatever you like in there :)

The point of the exercise was to illustrate how easily you can use standard canvas drawing techniques with Unigui :)
  • 0

#10 Dionel Acosta Duarte

Dionel Acosta Duarte

    Advanced Member

  • Members
  • PipPipPipPip
  • 450 posts
  • LocationDominican Republic

Posted 28 July 2011 - 06:56 PM

Nah.. I was playing with it, left it in in case I want to play with it again later.


Ok. You know...

SetChallenge sets FChallenge := aChallenge.

aChallenge is a procedure argument, FChallenge is a private variable.

Property Challenge reads and writes FChallenge

its not a OO setter, just a method called SetChallenge.


It was not necessary the first 3 lines, just the last one. But, because in many codes when you have a property called Prop, then appear an "OO setter" called SetProp.

Ok. Thank you anyway for your time.
  • 0

#11 Dionel Acosta Duarte

Dionel Acosta Duarte

    Advanced Member

  • Members
  • PipPipPipPip
  • 450 posts
  • LocationDominican Republic

Posted 28 July 2011 - 06:58 PM

Sure! You can draw whatever you like in there :)

The point of the exercise was to illustrate how easily you can use standard canvas drawing techniques with Unigui :)


Ok. I understood, and in this case is a help to "the thread starter" and to me too.

Thank you.
  • 0

#12 Marlon

Marlon

    Advanced Member

  • uniGUI Subscriber
  • PipPipPipPip
  • 368 posts
  • LocationNova Mutum - MT - Brasil

Posted 03 November 2012 - 04:38 PM

Posted Image

private
{ Private declarations }
validapost: string;

function GeraImagem(Img: TUniImage): string;

--------------------------------------------------------------------------

function TFormEsqueci_Minha_Senha.GeraImagem(Img: TUniImage): string;
const
f: array [0..4] of string = ('Courier New', 'Impact', 'Times New Roman',
'Verdana', 'Arial');
s = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
C: ARRAY [0..14] OF tcOLOR = (clAqua, clBlack, clBlue, clFuchsia, clGray,
clGreen, clLime, clMaroon, clNavy, clOlive,
clPurple, clRed, clSilver, clTeal, clYellow);
var
i, x, y : integer;
r : string;

begin
randomize;
Img.Width := 160;
Img.Height := 60;
for i := 0 to 3 do
r := r + s[Random(length(s)-1)+1];

with Img.Picture.Bitmap do
begin
width := Img.Width;
Height := Img.Height;
Canvas.Brush.Color := $00EFEFEF;
Canvas.FillRect(Img.ClientRect);

for i := 0 to 3 do
begin
Canvas.Font.Size := random(20) + 20;
Canvas.Font.Name := f[High(f)];
Canvas.Font.Color := c[random(High©)];
Canvas.TextOut(i*40,0,r[i+1]);
end;

for i := 0 to 2 do
begin
Canvas.Pen.Color := c[random(High©)];
Canvas.Pen.Width := 2;
canvas.MoveTo(random(Width),0);
Canvas.LineTo(random(Width),Height);
Canvas.Pen.Width := 1;
x := random(Width-10);
y := random(Height-10);
Canvas.Rectangle(x,y,x+10,y+10);
end;
end;

Result := r;

end;

------------------------------------------------------------------

procedure TFormEsqueci_Minha_Senha.bt_recuperar_senhaClick(Sender: TObject);
begin
validapost := GeraImagem(UniImage1);
end;
  • 0

#13 lema

lema

    Advanced Member

  • uniGUI Subscriber
  • PipPipPipPip
  • 361 posts

Posted 03 November 2012 - 05:28 PM

Hi , thanks !
I will try it.

Note:
It's better for all of us to enclose source code into a code block.
  • 0

#14 Marlon

Marlon

    Advanced Member

  • uniGUI Subscriber
  • PipPipPipPip
  • 368 posts
  • LocationNova Mutum - MT - Brasil

Posted 03 November 2012 - 09:02 PM

changed to better view of all...

;)



    private
    { Private declarations }
    validapost: string;

    function GeraImagem(Img: TUniImage): string;

-------------------------------------------------------

function TFormEsqueci_Minha_Senha.GeraImagem(Img: TUniImage): string;
const
  f: array [0..4] of string = ('Courier New', 'Impact', 'Times New Roman',
                               'Verdana', 'Arial');
  s = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789';
  C: ARRAY [0..14] OF tcOLOR = (clAqua, clBlack, clBlue, clFuchsia, clGray,
                                clGreen, clLime, clMaroon, clNavy, clOlive,
                                clPurple, clRed, clSilver, clTeal, clYellow);
var
  i, x, y : integer;
  r : string;

begin
  randomize;
  Img.Width := 160;
  Img.Height := 60;
  for i := 0 to 3 do
    r := r + s[Random(length(s)-1)+1];

  with Img.Picture.Bitmap do
  begin
    width := Img.Width;
    Height := Img.Height;
    Canvas.Brush.Color := $00EFEFEF;
    Canvas.FillRect(Img.ClientRect);

    for i := 0 to 3 do
    begin
      Canvas.Font.Size := random(20) + 20;
      Canvas.Font.Name := f[High(f)];
      Canvas.Font.Color := c[random(High(c))];
      Canvas.TextOut(i*40,0,r[i+1]);
    end;

    for i := 0 to 2 do
    begin
      Canvas.Pen.Color := c[random(High(c))];
      Canvas.Pen.Width := 2;
      canvas.MoveTo(random(Width),0);
      Canvas.LineTo(random(Width),Height);
      Canvas.Pen.Width := 1;
      x := random(Width-10);
      y := random(Height-10);
      Canvas.Rectangle(x,y,x+10,y+10);
    end;
  end;

  Result := r;

end;

--------------------------------------------------------

procedure TFormEsqueci_Minha_Senha.UniFormShow(Sender: TObject);
begin
  validapost := GeraImagem(UniImage1);
end;

  • 0

#15 Kast2k

Kast2k

    Member

  • uniGUI Subscriber
  • PipPip
  • 19 posts

Posted 28 November 2017 - 01:15 PM

Dear colleagues,

may be i'm doing something wrong, but i can't assign bitmat to UniImage :(

 

Simpliest code doesn't work:

    UniImage1.Picture.Bitmap.Canvas.Brush.Color := $00EFEFEF;
    UniImage1.Picture.Bitmap.Canvas.FillRect(UniImage1.ClientRect);

or

var
  b:TBitmap;
begin
  b:=TBitmap.Create;
  b.width:=100;
  b.height:=100;
  b.canvas.brush.color:=clGreen;
  b.canvas.fillrect(UniImage1.ClientRect);
  UniImage1.Picture.Assign(b);
  b.free
end;

UniGui 1.0.0.1412

 

 

Question closed. I will use UniCanvas


  • 0




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users