devx Posted July 26, 2011 Share Posted July 26, 2011 How to make Captcha? thnx Link to comment Share on other sites More sharing options...
Administrators Farshad Mohajeri Posted July 26, 2011 Administrators Share Posted July 26, 2011 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. Link to comment Share on other sites More sharing options...
JasonReid Posted July 28, 2011 Share Posted July 28, 2011 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(; 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 Link to comment Share on other sites More sharing options...
JasonReid Posted July 28, 2011 Share Posted July 28, 2011 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(; 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(; b.Free; end; procedure Register; begin RegisterComponents('UniCustom', [TUniCaptcha]); end; end. viola! 1 x hacker busting captcha Link to comment Share on other sites More sharing options...
Administrators Farshad Mohajeri Posted July 28, 2011 Administrators Share Posted July 28, 2011 Cool! Thanks for sharing. Link to comment Share on other sites More sharing options...
dionel1969 Posted July 28, 2011 Share Posted July 28, 2011 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(; 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(; 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??? Link to comment Share on other sites More sharing options...
dionel1969 Posted July 28, 2011 Share Posted July 28, 2011 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. Link to comment Share on other sites More sharing options...
JasonReid Posted July 28, 2011 Share Posted July 28, 2011 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. Link to comment Share on other sites More sharing options...
JasonReid Posted July 28, 2011 Share Posted July 28, 2011 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 Link to comment Share on other sites More sharing options...
dionel1969 Posted July 28, 2011 Share Posted July 28, 2011 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. Link to comment Share on other sites More sharing options...
dionel1969 Posted July 28, 2011 Share Posted July 28, 2011 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. Link to comment Share on other sites More sharing options...
Marlon Nardi Posted November 3, 2012 Share Posted November 3, 2012 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; Link to comment Share on other sites More sharing options...
lema Posted November 3, 2012 Share Posted November 3, 2012 Hi , thanks ! I will try it. Note: It's better for all of us to enclose source code into a code block. Link to comment Share on other sites More sharing options...
Marlon Nardi Posted November 3, 2012 Share Posted November 3, 2012 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; Link to comment Share on other sites More sharing options...
Kast2k Posted November 28, 2017 Share Posted November 28, 2017 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.free end; UniGui 1.0.0.1412 Question closed. I will use UniCanvas Link to comment Share on other sites More sharing options...
Recommended Posts
Please sign in to comment
You will be able to leave a comment after signing in
Sign In Now