ndocr.pas

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

{
识别图像验证码
}

unit NdOcr;

interface

uses
	Windows,SysUtils,Classes,Graphics,Math,GifImage,
  comm,func,kind1;

  function loadLib(kind,fn:pchar):Integer;stdcall;
  function freeLib:Integer;stdcall;
  procedure pGetCodeFromStream(var pStm:TMemoryStream;colorDepth,kind,para:pchar;rt:pchar;rtL:Integer;ec:pchar);stdcall;
  procedure pGetCodeFromFile(fn,colorDepth,kind,para:pchar;rt:pchar;rtL:Integer;ec:pchar);stdcall;

implementation

function getCodeFromStream(var pStm:TMemoryStream;colorDepth,kind,para:pchar):string;
var
  buf: Array[0..9] of byte;
  imgAry: TBArray;
  i,lineSize,dataOff,dataSize,imgW,imgH: Integer;
  bmp: TBITMAP;
  //gif: TGIFImage;
  //jpg: TJPEGImage;
  //png: TPNGobject;
  stm: TMemoryStream;
begin
  if pStm.Size < 10 then
  begin
    result := '?';
    exit;
  end;

  try
	  stm := TMemoryStream.Create();
	  stm.LoadFromStream(pStm);

	  //统一图像格式为256色bmp
	  //支持的有bmp,gif,jpg,png
	  stm.Position := 0;
	  stm.ReadBuffer(buf[0],10);
	  stm.Position := 0;
	  bmp := TBITMAP.Create();
	  if (buf[0]=66) and (buf[1]=77) then begin //bmp
	    bmp.LoadFromStream(stm)
	  { 由于需要额外的支持文件，所以暂时去掉了
	  end else if (buf[0]=71) and (buf[1]=73) and (buf[2]=70) then begin //gif
	    gif := TGifImage.Create();
	    gif.LoadFromStream(stm);
	    bmp.Assign(gif);
	    gif.Free()
	  end else if (buf[1]=80) and (buf[2]=78) and (buf[3]=71) then begin //png
	    png := TPNGobject.Create();
	    png.LoadFromStream(stm);
	    bmp.Assign(png);
	    png.Free();
	  end else if (buf[6]=74) and (buf[7]=70) and (buf[8]=73) and (buf[9]=70) then begin //jpg
	    jpg := TJpegImage.Create();
	    jpg.LoadFromStream(stm);
	    bmp.Assign(jpg);
	    jpg.Free();
	  }
	  end else begin  //not image
	    result := '?';
	    exit;
	  end;

	  imgW := bmp.Width;
	  imgH := bmp.Height;
	  if StrComp(colorDepth,'') <> 0 then bmp.PixelFormat := TPixelFormat(StrToInt(colorDepth));
	  bmp.PixelFormat := pf24Bit;
	  stm.Clear();
	  bmp.SaveToStream(stm);

	  bmp.Free();

		//为了提高处理速度，直接对bmp图像内存进行操作，在资料中有bmp的结构介绍
	  stm.Position := 0;
	  stm.Seek(10,soCurrent);
	  stm.ReadBuffer(buf[0],4);
	  //数据偏移
	  dataOff := buf[0] + buf[1] shl 8 + buf[2] shl 16 + buf[3] shl 24;
	  lineSize := ((imgW*24+31) shr 5) shl 2;
	  stm.Seek(20,soCurrent);
	  stm.ReadBuffer(buf[0],4);
	  //数据量
	  dataSize := buf[0] + buf[1] shl 8 + buf[2] shl 16 + buf[3] shl 24;
	  SetLength(imgAry,imgW*imgH*3);
	  stm.Position := dataOff + dataSize - lineSize;
	  //读取有效数据（已跳过对齐数据）
	  for i:=0 to imgH-1 do
	  begin
	    stm.ReadBuffer(imgAry[i*imgW*3],imgW*3);
	    stm.Seek(-imgW*3-lineSize,soCurrent);
	  end;
	  stm.Free();

    result := getCode1(imgAry,imgW,imgH,para);
  except
    result:='?';
  end;
end;

//ec:  delphi-#0 vc-\0 vb-" "  (这是为制作dll时支持不同调用语言而做的)
procedure copyResult(s:string;rt:pchar;rtL:Integer;ec:pchar);
var
  n,i: Integer;
begin
  n := Min(rtL,Length(s));
  StrLCopy(rt,pchar(s),n);
  if n < rtL then
  begin
    if ec = '' then ec := #0;
    for i:=n to rtL-1 do rt[i] := ec[0];
  end;
end;

procedure pGetCodeFromStream(var pStm:TMemoryStream;colorDepth,kind,para:pchar;rt:pchar;rtL:Integer;ec:pchar);stdcall;
begin
  copyResult(getCodefromStream(pStm,colorDepth,kind,para),rt,rtL,ec);
end;

function getCodeFromFile(fn,colorDepth,kind,para:pchar):string;
var stm: TMemoryStream;
begin
  if FileExists(fn) then
  begin
    stm := TMemoryStream.Create();
    stm.LoadFromFile(fn);
    result := getCodeFromStream(stm,colorDepth,kind,para);
    stm.Free();
  end else
    result := '?';
end;

procedure pGetCodeFromFile(fn,colorDepth,kind,para:pchar;rt:pchar;rtL:Integer;ec:pchar);stdcall;
begin
  copyResult(getCodeFromFile(fn,colorDepth,kind,para),rt,rtL,ec);
end;

procedure pGetCodeFromBytes(var imgAry:pchar;imgL:Integer;colorDepth,kind,para:pchar;rt:pchar;rtL:Integer;ec:pchar);stdcall;
var
  stm: TMemoryStream;
begin
  stm := TMemoryStream.Create();
  stm.WriteBuffer(imgAry,imgL);
  copyResult(getCodefromStream(stm,colorDepth,kind,para),rt,rtL,ec);
  stm.Free();
end;

function loadLibF(kind:Integer; fn:pchar):Boolean;
begin
  result := loadLibFile('1',fn);
end;

//加载识别库，返回成功加载的数量
//fn为目录时(不以\结束)，加载其下所有库，且libName失效
//libName为空时使用库自带名称，已有时不重新加载
function loadLib(kind,fn:pchar):Integer;stdcall;
var
  i: Integer;
  ret: Integer;
  sr: TSearchRec;
begin
  if Trim(kind) = '' then
    i := 1
  else begin
    try
      i := StrToInt(kind);
    except
      i := 0;
    end;
  end;

  result := 0;
  if FileExists(fn) then begin
    if loadLibF(i,fn) then result := 1;
  end else begin
    //对某目录下全部库进行加载
    ret := FindFirst(fn+'\*.lib',faAnyFile,sr);
    while Ret = 0 do
    begin
      if loadLibF(i,pchar(fn+'\'+sr.Name)) then Inc(result);
      ret := FindNext(sr);
    end;
    FindClose(sr);
  end;
end;

//加载识别库，返回成功加载的数量
function freeLib:Integer;stdcall;
begin
  result := Length(libAry);
  SetLength(libAry,0);
end;

end.