kind1.pas

识别动网asp论坛的验证码 程序语言：delphi 7.0 作者：netdust 2007-12-4

unit kind1;

interface

uses
  Windows,SysUtils,Classes,Math,comm,func;

  function getCode1(var pImgAry:TBArray;imgW,imgH:Integer;para:pchar):string;

implementation

//单元识别
//limit:只要找到limit内的即返回
function unitIdentity(libName:pchar;mRound,bone,limit,unitW,unitH:Integer;var unitAry:TBArray):string;
var
  areaAry,ary2: TI25Array;
  i1,i2,n1,n2: Integer;
  c: string;
begin
  c := '?';
	//很多时候这个不适用  fixUnit(unitW,unitH,unitAry);
  if mRound = 1 then roundUnit(unitW,unitH,unitAry);
  if bone = 1 then boneUnit(unitW,unitH,unitAry);
  if not unifyUnit(unitW,unitH,unitAry) then
  begin
    result := c;
    exit;
  end;

  //抽取特征
  for n1:=0 to 24 do areaAry[n1] := 0;
  for n1:=0 to unitH-1 do
  begin
    for n2:=0 to unitW-1 do
    begin
      if unitAry[n1*unitW+n2] = 1 then
      begin
        Inc(areaAry[(n1 shr 3)*5 + n2 shr 3]);
      end;
    end;
  end;

  //特征对比
  n1 := limit + 1;
  n2 := -1;
  for i1:=0 to Length(libAry)-1 do
  begin
    if (StrComp(libName,'-')<>0) and (StrComp(libName,pchar(libAry[i1].LibName))<>0) then continue;
    i2:=0;
    while i2 < Length(libAry[i1].Ary) do
    begin
      for n1:=0 to 24 do ary2[n1] := libAry[i1].Ary[i2+1+n1];
      n1 := osLen(areaAry,ary2);
      if (n1<n2) or (n2=-1) then
      begin
        c := char(libAry[i1].Ary[i2]);
        if n1 <= limit then break;
        n2 := n1;
      end;
      Inc(i2,26);
    end;
    if (n1 <= limit) or (StrComp(libName,pchar(libAry[i1].LibName))=0) then break;
  end;
  result := c;
end;

//整体识别
function identity(libName:pchar;mRound,bone,maxNoise,limit,spn,spx0,spy0,spuw,spuh,sppw,rlL,rlH,ruW,imgW,imgH:Integer;var imgAry:TBArray):string;
var
  ary: TAAIArray;
  unitAry: TBArray;
  n,n1,x1,y1,x2,y2,unitW,unitH: Integer;
  rt: string;
begin
  if spx0 < 0 then spx0 := 0;
  if spy0 < 0 then spy0 := 0;
  if spn = 0 then begin
    if (spx0<>0) or (spy0<>0) or (spuw<>0) or (spuh<>0) then cutArea(imgW,imgH,spx0,spy0,spuw,spuh,imgAry);
    ary := clearNoise(maxNoise,rlL,rlH,ruW,imgW,imgH,true,imgAry);
  end else begin
    n := (imgW-spx0-sppw) div (spuw+sppw) + 1;
    if (spn = -1) or (spn > n) then spn := n;
  	//针对单元单独去除杂点
    SetLength(unitAry,spuw*spuh);
    for n:=0 to spn-1 do
    begin
      for y1:=0 to spuh-1 do
        for x1:=0 to spuw-1 do
          unitAry[x1+y1*spuw] := imgAry[(y1+spy0)*imgW+x1+n*(spuw+sppw)+spx0];
      clearNoise(maxNoise,1,1,spuw,spuw,spuh,false,unitAry);
      for y1:=0 to spuh-1 do
        for x1:=0 to spuw-1 do
          imgAry[(y1+spy0)*imgW+x1+n*(spuw+sppw)+spx0] := unitAry[x1+y1*spuw];
    end;
    ary := splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW,imgAry);
  end;

  if Length(ary) = 0 then rt := '?' else rt := '';
  for n:=0 to Length(ary)-1 do
  begin
  	if Length(ary[n]) = 0 then continue;
    x1 := ary[n][0][0];
    y1 := ary[n][0][1];
    x2 := x1;
    y2 := y1;
    for n1:=1 to Length(ary[n])-1 do
    begin
      if ary[n][n1][0] < x1 then x1 := ary[n][n1][0];
      if ary[n][n1][0] > x2 then x2 := ary[n][n1][0];
      if ary[n][n1][1] < y1 then y1 := ary[n][n1][1];
      if ary[n][n1][1] > y2 then y2 := ary[n][n1][1];
    end;
    unitW := x2 - x1 + 1;
    unitH := y2 - y1 + 1;
    SetLength(unitAry,unitW*unitH);
    for n1:=0 to Length(unitAry)-1 do unitAry[n1] := 0;
    for n1:=0 to Length(ary[n])-1 do unitAry[(ary[n][n1][1]-y1)*unitW+ary[n][n1][0]-x1] := 1;
    rt := rt + unitIdentity(libName,mRound,bone,limit,unitW,unitH,unitAry);
  end;
  result := rt;
end;

//下面的一些参数是我根据经常使用的一些变化的情况而定的，保存在lib文件中，
//不需要太在意，只要理解整个识别的思路就可以
//para格式：libname,para2,...
//libname为-代表空
function getCode1(var pImgAry:TBArray;imgW,imgH:Integer;para:pchar):string;
var
  n,j: Integer;
  mRound,bone,lightKind,light1,light2,dots,limit,spn,spx0,spy0,spuw,spuh,sppw,rlL,rlH,ruW: Integer;
  maxNoise: Double;
  libName: string;
  sl: TStringList;
  imgAry:TBArray;
begin
  {
  把颜色转为灰度
  R:=Color and $ff;
  G:=(Color and $ff00)shr 8;
  B:=(Color and $ff0000)shr 16;
  Brightness := (R * 30 + G * 59 + B * 11) Div 100;
  }
  SetLength(imgAry,imgW*imgH);
  for n:=0 to imgW*imgH-1 do imgAry[n] := (pImgAry[3*n+2]*30 + pImgAry[3*n+1]*59 + pImgAry[3*n]*11) Div 100;

  libName := '-';
  mRound := 0;
  bone := 0;
  lightKind := 0;
  light1 := 0;
  light2 := -1;
  dots := 1;
  maxNoise := 3;
  limit := 0;
  spn := 0;
  spx0 := 0;
  spy0 := 0;
  spuw := 0;
  spuh := 0;
  sppw := 0;
  rlL := 0;
  rlH := 0;
  ruW := 0;

  sl := TStringList.Create();
  ExtractStrings([','],[],para,sl);
  if sl.Count > 0 then begin
    libName := LowerCase(sl[0]);
    j := Length(libAry);
    for n:=0 to j-1 do
    begin
      if StrComp(pchar(libAry[n].LibName),pchar(libName)) = 0 then
      begin
        mRound := libAry[n].mRound;
        bone := libAry[n].bone;
        lightKind := libAry[n].lightKind;
        light1 := libAry[n].light1;
        light2 := libAry[n].light2;
        dots := libAry[n].dots;
        maxNoise := libAry[n].maxNoise;
        limit := libAry[n].limit;
        spn := libAry[n].spn;
        spx0 := libAry[n].spx0;
        spy0 := libAry[n].spy0;
        spuw := libAry[n].spuw;
        spuh := libAry[n].spuh;
        sppw := libAry[n].sppw;
        rlL := libAry[n].rlL;
        rlH := libAry[n].rlH;
        ruW := libAry[n].ruW;
        break;
      end;
    end;
  end;

  n := picTo01(lightKind,light1,light2,dots,imgW,imgH,imgAry);
  if maxNoise < 1 then maxNoise := maxNoise * n;
  result := identity(pchar(libName),mRound,bone,Round(maxNoise),limit,spn,spx0,spy0,spuw,spuh,sppw,rlL,rlH,ruW,imgW,imgH,imgAry);
  sl.Free();
end;

end.