ndocr3.dpr

一个不错的QQ2009验证码自动识别程序源代码

    if x2 > -1 then break;
  end;
  y1 := -1;
  for n1:=0 to unitH-1 do
  begin
    for n2:=0 to unitW-1 do
    begin
      if unitAry[n1*unitW+n2] = 1 then
      begin
        y1 := n1;
        break;
      end;
    end;
    if y1 > -1 then break;
  end;
  y2 := -1;
  for n1:=unitH-1 downto 0 do
  begin
    for n2:=0 to unitW-1 do
    begin
      if unitAry[n1*unitW+n2] = 1 then
      begin
        y2 := n1;
        break;
      end;
    end;
    if y2 > -1 then break;
  end;
  Dec(x2,x1-1);
  Dec(y2,y1-1);
  w := 40;
  h := 40;
  SetLength(ary,w*h);
  for n1:=0 to w*h-1 do ary[n1] := 0;
  if x2 > 1 then xp := (w-1)/(x2-1) else xp := w-1;
  if y2 > 1 then yp := (h-1)/(y2-1) else yp := h-1;
  flag := (xp>1) or (yp>1);
  for n1:=0 to y2-1 do
  begin
    for n2:=0 to x2-1 do
    begin
      if unitAry[(n1+y1)*unitW+n2+x1] = 1 then
      begin
        x := Round(n2*xp);
        y := Round(n1*yp);
        ary[y*w+x] := 1;
        if flag then
        begin
          if n2<x2-1 then unifyDrawLine(n2+1,n1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
          if n1<y2-1 then
          begin
            unifyDrawLine(n2,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
            if unitAry[(n1+y1+1)*unitW+n2+x1] = 0 then
            begin
              if (n2<x2-1) and (unitAry[(n1+y1)*unitW+n2+x1+1]=0) then
                unifyDrawLine(n2+1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
              if (n2>0) and (unitAry[(n1+y1)*unitW+n2+x1-1]=0) then
                unifyDrawLine(n2-1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
            end else begin
              if (n2<x2-1) and (unitAry[(n1+y1)*unitW+n2+x1+1]=1) then
                unifyDrawArea(n2+1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
              if (n2>0) and (unitAry[(n1+y1)*unitW+n2+x1-1]=1) then
                unifyDrawArea(n2-1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
            end;
          end;
        end;
      end;
    end;
  end;
  unitW := w;
  unitH := h;
  unitAry := ary;
  result := true;
end;

function osLen(var ary1,ary2:TI25Array):Integer;stdcall;
var
  i,v: Integer;
begin
  v := 0;
  for i:=0 to 24 do Inc(v,(ary1[i]-ary2[i])*(ary1[i]-ary2[i]));
  result := v;
end;

function unitIdentity(libName:pchar;mRound,bone,limit,unitW,unitH:Integer;var unitAry:TBArray):string;stdcall;
var
  areaAry,ary2: TI25Array;
  i1,i2,n1,n2: Integer;
  c: string;
begin
  c := '?';
  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 splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW:Integer;var imgAry:TBArray):TAAIArray;stdcall;
var
  ary: TAAIArray;
  n1,n2,n3,l: Integer;
begin
  SetLength(ary,spn);
  for n1:=0 to spn-1 do
  begin
    for n2:=0 to spuw-1 do
    begin
      for n3:=0 to spuh-1 do
      begin
        if imgAry[(n3+spy0)*imgW+n2+n1*(spuw+sppw)+spx0] = 1 then
        begin
          l := Length(ary[n1]);
          SetLength(ary[n1],l+1);
          ary[n1][l][0] := n2 + n1*spuw + spx0;
          ary[n1][l][1] := n3 + spy0;
        end;
      end;
    end;
  end;
  n2 := 0;
  for n1:=0 to spn-1 do
  begin
    if Length(ary[n1]) = 0 then
      Inc(n2)
    else if n2 > 0 then
      ary[n1-n2] := ary[n1];
  end;
  if n2 > 0 then SetLength(ary,Length(ary)-n2);
  result := ary;
end;

procedure cutArea(var imgW,imgH:Integer;spx0,spy0,spw2,sph2:Integer;var imgAry:TBArray);
var
  ary2: TBArray;
  i,n: Integer;
begin
  if spw2 <= 0 then spw2 := imgW + spw2;
  if sph2 <= 0 then sph2 := imgH + sph2;
  if spw2 > imgW then spw2 := imgW;
  if sph2 > imgH then sph2 := imgH;
  SetLength(ary2,spw2*sph2);
  for i:=0 to sph2-1 do
  begin
    for n:=0 to spw2-1 do
    begin
      ary2[i*spw2+n] := imgAry[(i+spy0)*imgW+n+spx0];
    end;
  end;
  imgAry := ary2;
  imgW := spw2;
  imgH := sph2;
end;

function identity(libName:pchar;mRound,bone,maxNoise,limit,spn,spx0,spy0,spuw,spuh,sppw,imgW,imgH:Integer;var imgAry:TBArray):pchar;stdcall;
var
  ary: TAAIArray;
  unitAry: TBArray;
  n,n1,x1,y1,x2,y2,unitW,unitH: Integer;
  rt: pchar;
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,imgW,imgH,true,imgAry);
  end else begin
    clearNoise(maxNoise,imgW,imgH,false,imgAry);
    n := (imgW-spx0-sppw) div (spuw+sppw);
    if (spn = -1) or (spn > n) then spn := n;
    ary := splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW,imgAry);
  end;
  GetMem(rt,Length(ary)+1);
  for n:=0 to Length(ary)-1 do
  begin
    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;
    StrCopy(rt+n,pchar(unitIdentity(libName,mRound,bone,limit,unitW,unitH,unitAry)));
  end;
  result := rt;
end;

function getCode(var pImgAry:TBArray;imgW,imgH:Integer;para:pchar):pchar;stdcall;
var
  n,j: Integer;
  mRound,bone,lightKind,light1,light2,dots,limit,spn,spx0,spy0,spuw,spuh,sppw: Integer;
  maxNoise: Double;
  libName: string;
  sl: TStringList;
  imgAry:TBArray;
begin
  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;

  sl := TStringList.Create();
  ExtractStrings([','],[],para,sl);
  if sl.Count > 0 then
    libName := LowerCase(sl[0])
  else
    libName := '-';
  if sl.Count > 1 then begin
    mRound := StrToInt(sl[1]);
    bone := StrToInt(sl[2]);
    lightKind := StrToInt(sl[3]);
    light1 := StrToInt(sl[4]);
    light2 := StrToInt(sl[5]);
    dots := StrToInt(sl[6]);
    maxNoise := StrToFloat(sl[7]);
    limit := StrToInt(sl[8]);
    spn := StrToInt(sl[9]);
    spx0 := StrToInt(sl[10]);
    spy0 := StrToInt(sl[11]);
    spuw := StrToInt(sl[12]);
    spuh := StrToInt(sl[13]);
    sppw := StrToInt(sl[14]);
  end else begin
    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;
  end;
  sl.Free();
  if libName <> '-' then
  begin
    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;
        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,imgW,imgH,imgAry);
end;

function loadLib_Str(var buf:TBArray;n,l:Integer):string;stdcall;
var
  i: Integer;
  s: string;
begin
  s := '';
  for i:=0 to l-1 do s := s + char(buf[n+i]);
  result := s;
end;

function loadLib_Int(var buf:Array of byte;var i:Integer):Integer;stdcall;
begin
  result := buf[i] + buf[i+1] shl 8 + buf[i+2] shl 16 + buf[i+3] shl 24;
  Inc(i,4);
end;

function loadLibFile(fn,libName:pchar):Boolean;stdcall;
var
  buf: TBArray;
  n,i,j,k: Integer;
  sLibName: string;
begin
  result := false;
  n := FileOpen(fn, fmOpenRead);
  if n = -1 then exit;
  i := FileSeek(n,0,2);
  FileSeek(n,0,0);
  SetLength(buf,i);
  FileRead(n, buf[0], i);
  FileClose(n);
  if (loadLib_Str(buf,0,8) <> 'NdOcrLib') then exit;
  if buf[8] <> 1 then exit;
  if StrComp(libName,'') = 0 then
    sLibName := loadLib_Str(buf,59,20)
  else
    sLibName := libName;
  sLibName := LowerCase(sLibName);
  j := Length(libAry);
  for n:=0 to j-1 do
    if StrComp(pchar(libAry[n].LibName),pchar(sLibName)) = 0 then exit;

  SetLength(libAry,j+1);
  with libAry[j] do
  begin
    mRound := buf[9];
    bone := buf[10];
    k := 11;
    lightKind := loadLib_Int(buf,k);
    light1 := loadLib_Int(buf,k);
    light2 := loadLib_Int(buf,k);
    dots := loadLib_Int(buf,k);
    maxNoise := loadLib_Int(buf,k) / 1000;
    limit := loadLib_Int(buf,k);
    spn := loadLib_Int(buf,k);
    spx0 := loadLib_Int(buf,k);
    spy0 := loadLib_Int(buf,k);
    spuw := loadLib_Int(buf,k);
    spuh := loadLib_Int(buf,k);
    sppw := loadLib_Int(buf,k);
  end;
  libAry[j].LibName := sLibName;
  libAry[j].Ary := copy(buf,279,i-279);
  result := true;
end;

function loadLib(fn,libName:pchar):Integer;stdcall;
var
  sr: TSearchRec;
  ret: Integer;
begin
  result := 0;
  if FileExists(fn) then begin
    if loadLibFile(fn,libName) then result := 1;
  end else begin
    ret := FindFirst(fn+'\*.lib',faAnyFile,sr);
    while Ret = 0 do
    begin
      if loadLibFile(pchar(fn+'\'+sr.Name),'') then Inc(result);
      ret := FindNext(sr);
    end;
    FindClose(sr.FindHandle);
  end;
end;

procedure freeLib();stdcall;
begin
  SetLength(libAry,0);
end;

exports
  loadLib,
  freeLib,
	getCode
  ;

begin

end.