comment
IRC Chat
play_arrow
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.

Captcha en Delphi

  • 0 Respuestas
  • 2100 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5390
  • Actividad:
    40%
  • Reputación 31
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de
« en: Febrero 24, 2010, 04:55:33 pm »
Este codigo genera imagenes Captcha (No tienes permisos para ver links. Registrate o Entra con tu cuenta). Muy util para aplicacion intraweb o simplemente para validad que el usuario que se esta loggeando en un ser humano.

Nota: Se necesita una imagen (blanco.bmp), yo en lo personal utilizo un bmp del fondo de matrix que con el color verde de las letras es ideal para el proposito. Cualquier aportacion en bienvenida.

Código: Delphi
  1. unit fmain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Button1: TButton;
  12.     Image1: TImage;
  13.     procedure letrasAnguladas(c : string; angulo : integer; nextPos : Integer);
  14.     function PalabraAleatoria(Longitud: integer): string;
  15.     procedure generaImg();
  16.     procedure Button1Click(Sender: TObject);
  17.   private
  18.     { Private declarations }
  19.   public
  20.     { Public declarations }
  21.   end;
  22.  
  23. var
  24.   Form1: TForm1;
  25.  
  26. implementation
  27.  
  28. {$R *.dfm}
  29.  
  30. procedure TForm1.letrasAnguladas(c : string; angulo : integer; nextPos : Integer);
  31. var
  32.    logfont:TLogFont;
  33.    font: Thandle;
  34. begin
  35.    LogFont.lfheight:=30;
  36.    logfont.lfwidth:=10;
  37.    logfont.lfweight:=900;
  38.  
  39.    LogFont.lfEscapement:=angulo;
  40.    logfont.lfcharset:=1;
  41.    logfont.lfoutprecision:=OUT_TT_ONLY_PRECIS;
  42.    logfont.lfquality:= DEFAULT_QUALITY;
  43.    logfont.lfpitchandfamily:= FF_SWISS;
  44.    logfont.lfUnderline := 0;
  45.    logfont.lfStrikeOut := 0;
  46.  
  47.    font:=createfontindirect(logfont);
  48.  
  49.    Selectobject(Image1.canvas.handle,font);
  50.  
  51.    SetTextColor(Image1.canvas.handle,rgb(0,180,0));
  52.    SetBKmode(Image1.canvas.handle,transparent);
  53.  
  54.    Image1.canvas.textout(nextPos,5,c);
  55.    SetTextColor(Image1.canvas.handle,rgb(Random(255),Random(255),Random(255)));
  56.    deleteobject(font);
  57. end;
  58.  
  59. function TForm1.PalabraAleatoria(Longitud: integer): string;
  60. const
  61.   Letras = '01234567890ABCDEFGHIJKLMNPRSTUVWXYZ';
  62. var
  63.   n  : integer;
  64. begin
  65.   Result:='';
  66.   for n:=1 to Longitud do Result:=Result+Letras[1+Random(Length(Letras))];
  67. end;
  68.  
  69. procedure TForm1.generaImg();
  70. var
  71.    palabra : string;
  72.    vX : integer;
  73. begin
  74.    Randomize;
  75.    palabra := PalabraAleatoria(Random(6)+4);
  76.    if length(palabra) > 6 then
  77.       palabra := copy(palabra,1,6);
  78.    for vX := 1 to Length(palabra) do
  79.       letrasAnguladas(palabra[vX],Random(600)+1,25*vX-15);
  80. end;
  81.  
  82. procedure TForm1.Button1Click(Sender: TObject);
  83. begin
  84.    Image1.Picture.LoadFromFile('blanco.bmp');
  85.    generaImg;
  86. end;
  87.  
  88. end.



« Última modificación: Abril 15, 2013, 11:24:47 pm por Expermicid »


 

¿Te gustó el post? COMPARTILO!



[Sintaxis general de Delphi] By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 1984
Último mensaje Febrero 24, 2010, 04:35:15 pm
por ANTRAX
Eliminar acentos y otros agregados de un caracter/cadena Delphi 2009

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3129
Último mensaje Febrero 24, 2010, 04:57:14 pm
por ANTRAX
1er troyano en Delphi By: Geek Lord Venezuela [R00t] Team

Iniciado por ANTRAX

Respuestas: 0
Vistas: 3257
Último mensaje Febrero 24, 2010, 04:34:48 pm
por ANTRAX
[Delphi] Project Spartacus 1.0 (Regalo de Navidad)

Iniciado por BigBear

Respuestas: 2
Vistas: 1602
Último mensaje Diciembre 26, 2014, 11:54:34 pm
por n4pst3r
[Delphi] Creacion de un Server Builder con recursos

Iniciado por BigBear

Respuestas: 1
Vistas: 1412
Último mensaje Marzo 09, 2015, 07:56:20 pm
por Flemon