devx Posted July 26, 2011 Share Posted July 26, 2011 How to make Captcha? thnx Quote 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. Quote 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 Quote 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 Quote 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. Quote 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??? Quote 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. Quote 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. Quote 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 Quote 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. Quote 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. Quote 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; Quote 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. Quote 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; Quote 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.