unit1.pas

能够自动识别验证码的小程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ExtDlgs, ComCtrls, ShellAPI, JPEG;//, GIFImage;

type //字符特征码
  RChar = record
    MyChar: char;
    MyCharInfo: array[0..49, 0..49] of byte;
  end;

type //字符特征文件
  RCharInfo = record
    Sng: integer; //文件类型标识
    Ver: real; //版本号
    charwidth: byte; //字符宽度
    charheight: byte; //字符高度
    X0: byte; //第一个字符开始x偏移
    TotalChars: byte; //图象字符总数
    allcharinfo: array[0..9] of RChar;
  end;
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button2: TButton;
    Image2: TImage;
    Edit3: TEdit;
    Edit4: TEdit;
    Image3: TImage;
    Edit5: TEdit;
    Edit6: TEdit;
    Image4: TImage;
    Edit7: TEdit;
    Edit8: TEdit;
    Image5: TImage;
    Edit9: TEdit;
    Edit10: TEdit;
    Image6: TImage;
    Edit11: TEdit;
    Edit12: TEdit;
    Image7: TImage;
    Edit13: TEdit;
    Edit14: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Image8: TImage;
    Edit15: TEdit;
    Edit16: TEdit;
    Image9: TImage;
    Edit17: TEdit;
    Edit18: TEdit;
    Image10: TImage;
    Edit19: TEdit;
    Edit20: TEdit;
    Image11: TImage;
    Edit21: TEdit;
    Edit22: TEdit;
    Image12: TImage;
    Edit23: TEdit;
    Edit24: TEdit;
    Image13: TImage;
    Edit25: TEdit;
    Edit26: TEdit;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Image14: TImage;
    Edit27: TEdit;
    Edit28: TEdit;
    Image15: TImage;
    Edit29: TEdit;
    Edit30: TEdit;
    Image16: TImage;
    Edit31: TEdit;
    Edit32: TEdit;
    Image17: TImage;
    Edit33: TEdit;
    Edit34: TEdit;
    Image18: TImage;
    Edit35: TEdit;
    Edit36: TEdit;
    Button3: TButton;
    Button4: TButton;
    Edit37: TEdit;
    Image19: TImage;
    Label10: TLabel;
    Label11: TLabel;
    Button5: TButton;
    Image20: TImage;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    Button6: TButton;
    ProgressBar1: TProgressBar;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label12: TLabel;
    Label13: TLabel;
    Edit38: TEdit;
    Edit39: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
    MyCharInfo: RCharInfo;
    pic: array[0..17] of Timage;
    exepath: string;
    procedure ModiFyInfo(MyCanvas: TCanvas; MyChar: char; X0,
      CharWidth, CharHeight: integer);
    procedure ShowAllCharInfo;
    procedure GetCharInfoFromImage(MyCanvas: TCanvas; CharInfo: string);
    function GetStringFromImage(SBMP: TBITMAP): string;
    function CMPBMP(SBMP: TBITMAP; x0, m: integer): integer;
    procedure InteCharInfo(Charwidth, X0: integer);
    function Makehtm(CharWidth, X0: string): string;
    procedure GetCharInfoFromALLImage;
    function PIC2BMP(filename: string): TBITMAP;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
//根据不同情况初始化特征码信息

procedure TForm1.InteCharInfo(Charwidth, X0: integer);
begin
  Fillchar(MycharInfo, sizeof(RcharInfo), 1);
  MycharInfo.Sng := 751115327;
  MycharInfo.Ver := 1.1;
  MycharInfo.TotalChars := length(edit1.text);
  MycharInfo.charwidth := charwidth;
  MycharInfo.charheight := image1.Picture.Bitmap.Height;
  MycharInfo.X0 := X0;
end;
//

procedure TForm1.FormCreate(Sender: TObject);
begin
  exepath := ExtractFilePath(Application.ExeName);
  InteCharInfo(9, 1);
  Pic[0] := image1;
  Pic[1] := image2;
  Pic[2] := image3;
  Pic[3] := image4;
  Pic[4] := image5;
  Pic[5] := image6;
  Pic[6] := image7;
  Pic[7] := image8;
  Pic[8] := image9;
  Pic[9] := image10;
  Pic[10] := image11;
  Pic[11] := image12;
  Pic[12] := image13;
  Pic[13] := image14;
  Pic[14] := image15;
  Pic[15] := image16;
  Pic[16] := image17;
  Pic[17] := image18;
end;
//修正指定字符特征码

procedure TForm1.ModiFyInfo(MyCanvas: TCanvas; MyChar: char; X0, CharWidth, CharHeight: integer);
var
  i, j: integer;
begin
  for i := 0 to CharWidth do
    for j := 0 to CharHeight do
      if MyCanvas.Pixels[X0 + i, j] > 0 then   //当前像素不为白色
      begin
        MyCharInfo.allcharinfo[strtoint(Mychar)].MyChar := Mychar;
        MyCharInfo.allcharinfo[strtoint(Mychar)].MyCharInfo[i, j] := 0;
      end;
end;
//根据学习后的字符特征码显示所有字符

procedure TForm1.ShowAllCharInfo;
var
  BMP: TBITMAP;
  i, j, k: integer;
begin
  BMP := TBITMAP.Create;
  BMP.Width := (MyCharInfo.charwidth + 5) * 10 - 5;
  BMP.Height := MyCharInfo.charheight;
  BMP.Canvas.Brush.Color := clMoneygreen;
  BMP.Canvas.FloodFill(1, 1, clblack, fsBorder);
  for k := 0 to 9 do
    for i := 0 to MyCharInfo.charwidth do
      for j := 0 to MyCharInfo.charheight do
        if MyCharInfo.allcharinfo[K].MyCharInfo[i, j] > 0 then
          BMP.Canvas.Pixels[i + k * (MyCharInfo.charwidth + 5), j] := clblack;
  Image20.Picture.Bitmap.Assign(BMP);
  BMP.Free;
end;
//学习一个附加码的所有字符

procedure TForm1.GetCharInfoFromImage(MyCanvas: TCanvas; CharInfo: string);
var
  i: integer;
  x: integer;
begin
  for i := 1 to MycharInfo.TotalChars do
  begin
    x := MycharInfo.X0 + MycharInfo.charwidth * (i - 1);
    ModiFyInfo(MyCanvas, CharInfo[i], x, MycharInfo.charwidth, MycharInfo.charheight);
  end;
end;

//学习所有图片共18个

procedure TForm1.GetCharInfoFromALLImage;
begin
  GetCharInfoFromImage(image1.Picture.Bitmap.Canvas, edit1.text);
  GetCharInfoFromImage(image2.Picture.Bitmap.Canvas, edit3.text);
  GetCharInfoFromImage(image3.Picture.Bitmap.Canvas, edit5.text);
  GetCharInfoFromImage(image4.Picture.Bitmap.Canvas, edit7.text);
  GetCharInfoFromImage(image5.Picture.Bitmap.Canvas, edit9.text);
  GetCharInfoFromImage(image6.Picture.Bitmap.Canvas, edit11.text);
  GetCharInfoFromImage(image7.Picture.Bitmap.Canvas, edit13.text);
  GetCharInfoFromImage(image8.Picture.Bitmap.Canvas, edit15.text);
  GetCharInfoFromImage(image9.Picture.Bitmap.Canvas, edit17.text);
  GetCharInfoFromImage(image10.Picture.Bitmap.Canvas, edit19.text);
  GetCharInfoFromImage(image11.Picture.Bitmap.Canvas, edit21.text);
  GetCharInfoFromImage(image12.Picture.Bitmap.Canvas, edit23.text);
  GetCharInfoFromImage(image13.Picture.Bitmap.Canvas, edit25.text);
  GetCharInfoFromImage(image14.Picture.Bitmap.Canvas, edit27.text);
  GetCharInfoFromImage(image15.Picture.Bitmap.Canvas, edit29.text);
  GetCharInfoFromImage(image16.Picture.Bitmap.Canvas, edit31.text);
  GetCharInfoFromImage(image17.Picture.Bitmap.Canvas, edit33.text);
  GetCharInfoFromImage(image18.Picture.Bitmap.Canvas, edit35.text);
  ShowAllCharInfo;
end;
//根据设定选择不同的学习模式

procedure TForm1.Button1Click(Sender: TObject);
var
  Begincharwidth, Endcharwidth, charwidth, beginX0, endX0, X0: integer;
  htm: Tstrings;
begin
  if radiobutton1.Checked then
  begin
    Begincharwidth := round(image1.Picture.Bitmap.Width / MycharInfo.TotalChars);//一个字符的宽度
    Begincharwidth := round(Begincharwidth / 2); //半个字符的宽度
    Endcharwidth := 2 * Begincharwidth;  //一个字符的宽度
    BeginX0 := 0;
    endX0 := MycharInfo.charwidth + 1;
  end
  else
  begin
    try
      BeginX0 := strtoint(edit38.Text);
      endX0 := BeginX0;
      Begincharwidth := strtoint(edit39.Text);
      Endcharwidth := strtoint(edit39.Text);
    except
      showmessage('请输入数值型字符');
      exit;
    end;
  end;
  //以下弹出网页
  htm := TstringList.Create;
  htm.Add('<table>' + #13#10);
  ProgressBar1.Min := 0;
  ProgressBar1.Max := (endX0 - BeginX0 + 1) * (Endcharwidth - Begincharwidth + 1);
  ProgressBar1.Position := 0;
  ProgressBar1.Step := 1;
  for charwidth := Begincharwidth to Endcharwidth do
    for X0 := BeginX0 to endX0 do
    begin
      ProgressBar1.StepIt;
      if X0 + charWidth * MycharInfo.TotalChars > image1.Picture.Bitmap.Width then
        continue;
      InteCharInfo(charwidth, X0);
      GetCharInfoFromAllImage;
      htm.Text := htm.Text + MakeHtm(inttostr(charwidth), inttostr(X0));
    end;
  htm.Add('</table>' + #13#10);
  htm.SaveToFile(exepath + 'temp\test.htm');
  htm.Free;
  if radiobutton1.Checked then
    shellexecute(handle, 'open', Pchar(exepath + 'temp\test.htm'), nil, nil, SW_SHOWMAXIMIZED);
end;

function TForm1.Makehtm(CharWidth, X0: string): string;
begin
  image20.Picture.SaveToFile(exepath + 'temp\' + X0 + '-' + CharWidth + '.BMP');
  result := '<tr>' + #13#10;
  result := result + '<td>偏移：' + X0 + '</td>' + #13#10;
  result := result + '<td>字宽：' + CharWidth + '</td>' + #13#10;
  result := result + '<td><img src="' + X0 + '-' + CharWidth + '.BMP"></td>' + #13#10;
  result := result + '</tr>' + #13#10;
end;

//比较图片上X0开始的字符是否是指定字符M

function TForm1.CMPBMP(SBMP: TBITMAP; x0, m: integer): integer;
var
  i, j: integer;
begin
  result := 0;
  for i := 0 to MycharInfo.charwidth - 1 do
    for j := 0 to MycharInfo.charHeight - 1 do
      if (SBMP.Canvas.Pixels[x0 + i, j] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
        result := result + 1;
end;

//从图片中识别字串

function TForm1.GetStringFromImage(SBMP: TBITMAP): string;
var
  k, m: integer;
  x: integer;
begin
  result := '';
  for k := 0 to MycharInfo.TotalChars - 1 do
  begin
    x := MycharInfo.X0 + MyCharInfo.charwidth * k;
    for m := 9 downto 0 do
    begin
      if CMPBMP(SBMP, x, m) = 0 then
      begin
        result := result + inttostr(m);
        break;
      end;
      if m = 0 then
        result := result + '?';
    end;
  end;
end;
//识别外部图片

procedure TForm1.Button3Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
  begin
    Image19.Picture.Bitmap := PIC2BMP(OpenDialog1.FileName);
    edit37.Text := GetStringFromImage(Image19.Picture.Bitmap);
  end;
end;
//识别学习图片

procedure TForm1.Button2Click(Sender: TObject);
begin
  edit2.Text := GetStringFromImage(Image1.Picture.Bitmap);
  edit4.Text := GetStringFromImage(Image2.Picture.Bitmap);
  edit6.Text := GetStringFromImage(Image3.Picture.Bitmap);
  edit8.Text := GetStringFromImage(Image4.Picture.Bitmap);
  edit10.Text := GetStringFromImage(Image5.Picture.Bitmap);
  edit12.Text := GetStringFromImage(Image6.Picture.Bitmap);
  edit14.Text := GetStringFromImage(Image7.Picture.Bitmap);
  edit16.Text := GetStringFromImage(Image8.Picture.Bitmap);
  edit18.Text := GetStringFromImage(Image9.Picture.Bitmap);
  edit20.Text := GetStringFromImage(Image10.Picture.Bitmap);
  edit22.Text := GetStringFromImage(Image11.Picture.Bitmap);
  edit24.Text := GetStringFromImage(Image12.Picture.Bitmap);
  edit26.Text := GetStringFromImage(Image13.Picture.Bitmap);
  edit28.Text := GetStringFromImage(Image14.Picture.Bitmap);
  edit30.Text := GetStringFromImage(Image15.Picture.Bitmap);
  edit32.Text := GetStringFromImage(Image16.Picture.Bitmap);
  edit34.Text := GetStringFromImage(Image17.Picture.Bitmap);
  edit36.Text := GetStringFromImage(Image18.Picture.Bitmap);
end;
//输出特征码结构

procedure TForm1.Button4Click(Sender: TObject);
var
  P: file of RCharInfo;
begin
  if savedialog1.Execute then
  begin
    Assignfile(P, savedialog1.FileName);
    rewrite(P);
    write(p, MycharInfo);
    CloseFile(P);
  end;
end;
//导入特征码结构

procedure TForm1.Button6Click(Sender: TObject);
var
  P: file of RCharInfo;
begin
  if Opendialog1.Execute then
  begin
    Assignfile(P, Opendialog1.FileName);
    reset(P);
    read(p, MycharInfo);
    CloseFile(P);
    ShowAllCharInfo;
  end;
end;
//导入学习图片

procedure TForm1.Button5Click(Sender: TObject);
var
  i: integer;
begin
  if OpenDialog1.Execute then
  begin
    for i := 0 to OpenDialog1.Files.Count - 1 do
    begin
      Pic[i].Picture.Bitmap := PIC2BMP(OpenDialog1.Files.Strings[i]);
      if i = 17 then
        Break;
    end;
  end;
end;

function TForm1.PIC2BMP(filename: string): TBITMAP;
var
 // GIF: TGIFImage;
  jpg: TJPEGImage;
  BMP: TBITMAP;
  FileEx: string;
  i, j: integer;
begin
  FileEx := UpperCase(ExtractFileExt(filename));
  BMP := TBITMAP.Create;
  if FileEx = '.BMP' then
    BMP.LoadFromFile(filename)
  else if FileEx = '.GIF' then
  begin
   { GIF := TGIFImage.Create;
    GIF.LoadFromFile(filename);
    BMP.Assign(GIF);
    GIF.Free; }
  end
  else if (FileEx = '.JPG') or (FileEx = '.JPEG') then
  begin
    JPG := TJPEGImage.Create;
    JPG.LoadFromFile(filename);
    JPG.Grayscale := TRUE;
    BMP.Assign(JPG);
    JPG.Free;
  end;
  for i := 0 to BMP.Width - 1 do
    for j := 0 to BMP.Height - 1 do
    begin
      if BMP.Canvas.Pixels[i, j] > $7FFFFF then
        BMP.Canvas.Pixels[i, j] := clwhite
      else
        BMP.Canvas.Pixels[i, j] := clblack;
    end;
  result := BMP;
end;

end.