unit OCR;

interface

 uses Windows, SysUtils, Graphics, Classes, PNGImage, GIFImage, JPEG, Math, AsphyreZlib;

 type
   TOCRLibSetting = record  //验证码库设置
    SaveBMP: Boolean; //存储转换后的Bmp文件
    BmpPath: String; //Bmp存储路径
    BmpPrefix: String; //Bmp文件前缀
    BmpSuffix: String; //Bmp文件后缀
  end;

 type
   //图像大小类
  TOCRSz = record
     W,H: Byte;   //宽,高
  end;
   //特征码模板库类
  TOCRTemplates = record
     Count: Byte;    //数量
    Names: array of String; //名称
    OCRFiles: array of String; //文件名/路径
    OCRSz: array of TOCRSz; //图像大小
    YaoqiuSS: array of Byte;  //是否为算式
  end;

//初始化验证码库
function InitOCRLib: Boolean;
//取消使用Dll
procedure CancelUseDLL;
//加载验证码模板库
function LoadOCRLib(const AFileName: String = ''): Boolean;
//图像转换为BMP
function ALL2BMP(const Filename : String; const Bmp: TBitmap): Boolean;
//加载资源dll
function LoadOCRResourceDLL(const ADllName: String): Boolean;
//识别验证码
function RecogOCR(var Success: Boolean; const ImageFile: String): String;
//更改特征码模板
function LoadOCRTemplate(const TmplID: Integer): Boolean;
//加载特征码文件
function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
//查找验证码特征文件
function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
//验证码库设置
function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
//获得验证码库设置
function GetOCRLibSetting: TOCRLibSetting;
//获得验证码模板库
function GetOCRTemplates: TOCRTemplates;
//获取最后识别时间(毫秒)
function GetLastRecogTime: DWORD;
//调用AspriseOcr
 //function RecogOCRByOCRLib(const FileName: String): String;
 //释放验证码库/清除特征码文件
function FreeOcr: Boolean;

//procedure SetPicFormat(Format: Byte);

const
   FMT_AUTO = ; //自动
  FMT_PNG = ; //png
  FMT_BMP = ; //bmp
  FMT_GIF = ; //gif
  FMT_JPEG = ; //jpg/jpeg

 implementation

 uses IniFiles, SSUtils;

 type
   RSpeicalEffects = record  //特殊效果
    To1Line: Boolean;   //字符归位
    RemoveZD: Boolean;  //消除噪点
    Y0: Byte;           //Y轴偏移
    XcZD: Byte;         //噪点阀值
  end;

 type //字符特征码
  RChar = record
     MyChar: char;          //字符
    used: Boolean;         //已使用
    MyCharInfo: .., ..] of byte;  //字符图像
  end;

 type //字符特征文件
  RCharInfo = record
     charwidth: byte; //字符宽度
    charheight: byte; //字符高度
    X0: byte; //第一个字符开始x偏移
    TotalChars: byte; //图象字符总数
    CusDiv : boolean;  //自定义二值化运算
    DivCmp : Byte; //  :>  :=  :<<br>     DivColr : TColor;  //二值化阀值
    _CmpChr,_CmpBg: Boolean;  //比较字符(黑色),比较背景(白色)
    _ClrRect: Boolean;   //清除矩形
    _RectLen: Byte;     //矩形长度

     allcharinfo: ..] of RChar; //字符特征码列表
  end;

 type
   TOcrVersionSng = ..] of Byte;
   TOcrVersion = record    //版本号
    First,Minjor: Byte;   //版本
    Author: String[];   //作者
    Name: String[];     //特征码名称
  end;

   ROcrLibFile = record
     Sng: TOcrVersionSng;  //版本标识
    Ver: TOcrVersion;     //版本
    W,H: Byte;            //图像宽,高
    Effect: RSpeicalEffects;  //特殊效果
    CharInfo: RCharInfo;     //特征码
    EffectBLW: Boolean;     //通用二值化
  end;

   TOcrLibDllInfo = record
     DllFile: String;
     MDLRPrefix: String;
     MDLRType: String;
   end;

 var
   _BITMAP: TBitmap;  //识别图像
  MycharInfo: RCharInfo; //特征码
  _Effect: RSpeicalEffects;  //特效
  _EffBLW: Boolean;  //通用二值化
  SSCode: Byte;   //是否为算式

 var
   BmW,BmH: Integer;  //特征码图像宽,高
  OcrName: String;  //特征码名称
  _PicFormat: Byte; //图像格式
  _PicWidth,_PicHeight: Byte; //实际图像宽,高
  Templates: TOCRTemplates; //模板列表
  Setting: TOCRLibSetting;
   LastRecogTime: DWORD;

 var
   UseDll: Boolean;
   DllInfo: TOcrLibDllInfo;

const
   SP = '@';

 procedure CancelUseDLL;
 begin
   UseDll := False;
 end;

function GetLastRecogTime: DWORD;
 begin
   Result := LastRecogTime;
 end;

function GetOCRLibSetting: TOCRLibSetting;
 begin
   Result := Setting;
 end;

function GetOCRTemplates: TOCRTemplates;
 begin
   Result := Templates;
 end;

function LoadOCRResourceDLL(const ADllName: String): Boolean;
 var
   strm: TResourceStream;
   hDll: THandle;
   S: String;
   function GetTempPathFileName: String;
   var
     SPath, SFile : PChar;
   begin
     SPath := AllocMem(MAX_PATH);
     SFile := AllocMem(MAX_PATH);
     GetTempPath(MAX_PATH, SPath);
     GetTempFileName(SPath, , SFile);
     Result := String(SFile);
     FreeMem(SPath, MAX_PATH);
     FreeMem(SFile, MAX_PATH);
     DeleteFile(Result);
   end;
 begin
   Result := False;
   try
     hDll := LoadLibrary(PChar(ADllName));
      then
     begin
       try
         strm := TResourceStream.Create(hDll,
           'SDSOFT_OCR',
           PChar('OCR'));

         S := GetTempPathFileName;
         strm.SaveToFile(S);
         try
           UseDll := True;
           Result := LoadOCRLib(S);
         except
           UseDll := False;
         end;
         if Result = False then UseDll := False;
         if UseDll = True then DllInfo.DllFile := ADllName;

         DeleteFile(S);
       finally
         FreeLibrary(hDll);
       end;
     end;
     Result := True;
   except
   end;
 end;

function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
 begin
   Result := False;
   try
     Setting := ASetting;
     Result := True;
   except
   end;
 end;

function InitOCRLib: Boolean;
 begin
   Result := False;
   try
     UseDll := False;
     DllInfo.DllFile := '';
     DllInfo.MDLRPrefix := '';
     DllInfo.MDLRType := '';

     _BITMAP := nil;
     FillChar(MycharInfo,SizeOf(RCharInfo),#);
     MycharInfo.DivCmp := ;
     MycharInfo.DivColr := $7FFFFF;
     MycharInfo._CmpChr := True;
     MycharInfo._CmpBg := False;
     MycharInfo.X0 := ;
     MycharInfo.charwidth := ;
     MycharInfo.CusDiv := False;
     MycharInfo.charheight := ;
     FillChar(_Effect,SizeOf(RSpeicalEffects),#);
     _Effect.To1Line := False;
     _Effect.RemoveZD := False;
     Setting.SaveBMP := False;
     Setting.BmpPrefix := 'OCR';
     Setting.BmpSuffix := '';
     LastRecogTime := ;
   except
   end;
 end;

function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
 var
   I: Integer;
 begin
   Result := -;
    do
   begin
     if (Templates.Names[I] = AOCRName) or
          ((Templates.OCRSz[I].W = Width) and (Templates.OCRSz[I].H = Height))
            then
     begin
       Result := I;
       Break;
     end;
   end;
 end;

function LoadOCRLib(const AFileName: String = ''): Boolean;
 var
   Ini: TIniFile;
   S,S2: String;
   I,J: Integer;

   FileName: String;
 begin
   Result := False;
   FileName := AFileName;
   if FileName = '' then
     FileName := ExtractFilePath(ParamStr())+'OCR.INI';
   try
     Templates.Count := ;
     SetLength(Templates.Names,);
     SetLength(Templates.OCRFiles,);
     Ini := TIniFile.Create(FileName);
     Templates.Count := Byte(Ini.ReadInteger());
     SetLength(Templates.Names,Templates.Count*SizeOf(String));
     SetLength(Templates.OCRFiles,Templates.Count*SizeOf(String));
     SetLength(Templates.OCRSz,Templates.Count*SizeOf(TOCRSz));
     SetLength(Templates.YaoqiuSS,Templates.Count*SizeOf(Byte));
       do
     begin
       S := Ini.ReadString('OCRLIB','T'+IntToStr(I),'');
       if S <> '' then
       begin
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         if UseDll then Templates.OCRFiles[I] := S2
         ))+S2;
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         Templates.OCRSz[I].W := Byte(StrToInt(S2));
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         Templates.OCRSz[I].H := Byte(StrToInt(S2));
         Templates.YaoqiuSS[I] := Byte(StrToInt(S));
         Templates.Names[I] := Ini.ReadString('OCRNAME','T'+IntToStr(I),'');
       end;
     end;
     if UseDll = True then
     begin
       DllInfo.MDLRPrefix := Ini.ReadString('DLLSETTING','Prefix','');
       DllInfo.MDLRType := Ini.ReadString('DLLSETTING','ResourceType','OCR');
     end;
     Ini.Free;
     Result := True;
   except
   end;
 end;

function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
 var
   Fstrm: TFileStream;
   strm: TMemoryStream;
   dat: ROcrLibFile;
   function VersVerify: Boolean;
   begin
     Result := (dat.Sng[] = Byte(] = Byte('C'));
   end;
 begin
   Result := False;
   try
     Fstrm := TFileStream.Create(ocrFile,fmOpenRead);
     strm := TMemoryStream.Create;
     try
       Fstrm.Position := ;
       ZDecompressStream(FStrm,strm);
       Fstrm.Free;

       strm.Position := ;
       strm.Read(dat,SizeOf(ROcrLibFile));
       if VersVerify = True then
       begin
         MycharInfo := dat.CharInfo;
         _Effect := dat.Effect;
         BmW := dat.W;
         BmH := dat.H;
         OcrName := dat.Ver.Name;
         _EffBLW := dat.EffectBLW;
         Result := True;
       end;
     finally
       strm.Free;
     end;

     ;
   except
   end;
 end;
 procedure To1Line(const Bmp: TBitmap; Y0,X0,Chw,CharL: Byte);
 type
   xByteArray = array of Byte;
 var
   X,Y: Integer;
   Ch: TBitmap;
   MinJL: xByteArray;
   function MinArr(const Data: xByteArray; const Count: Integer): Byte;
   var
     I: Integer;
   begin
      then Exit;
     Result := Data[];
       do
     begin
       if Data[I] < Result then Result := Data[I];
     end;
   end;
   procedure GetMinJL(const nChar: Byte);
   var
     K,L,M: Byte;
     c: TColor;
     MinJLS: xByteArray;
   begin
     K := X0 + nChar * Chw;
     SetLength(MinJLS,Chw);
       do
     begin
       M := ;
       c := Bmp.Canvas.Pixels[K+L,M+Y0];
       while (c <> clBlack) and (M <= Bmp.Height) do
       begin
         inc(M);
         c := Bmp.Canvas.Pixels[K+L,M+Y0];
       end;
       MinJLS[L] := M;
     end;
     MinJL[nChar] := MinArr(MinJLS,Chw);
     SetLength(MinJLS,);
   end;
 begin
   SetLength(MinJL,CharL);
   Ch := TBitmap.Create;
     do
   begin
     GetMinJL(X);
     Y := X0 + X * Chw;

     Ch.Width := Chw;
     Ch.Height := Bmp.Height - MinJL[X];
     Ch.Canvas.Brush.Color := clWhite;
     Ch.Canvas.Brush.Style := bsSolid;
     Ch.Canvas.Pen.Color := clWhite;
     Ch.Canvas.Pen.Style := psSolid;
     Ch.Canvas.Rectangle(,,Ch.Width,Ch.Height);
     Ch.Canvas.CopyRect(Rect(,,Ch.Width,Ch.Height),Bmp.Canvas,Rect(Y,MinJL[X],Y+Chw,Bmp.Height));

     Bmp.Canvas.Brush.Color := clWhite;
     Bmp.Canvas.Brush.Style := bsSolid;
     Bmp.Canvas.Pen.Color := clWhite;
     Bmp.Canvas.Pen.Style := psSolid;
     Bmp.Canvas.Rectangle(Y,MinJL[X],Y+Chw,Bmp.Height);
     Bmp.Canvas.CopyRect(Rect(Y,Y0,Y+Chw,Bmp.Height-MinJL[X]),Ch.Canvas,Rect(,,Ch.Width,Ch.Height));
   end;
   Ch.Free;
   SetLength(MinJL,);
 end;

function GetTail(str,sp : String): Integer;
 var
   Temp : String;
 begin
   Temp := Str;
   Delete(Temp,,Pos(sp,str)+length(sp)-);
   Result := StrToInt(Temp);
 end;

 procedure SlQuickSort(Sl : TStringList; iLo, iHi: Integer);
 var
   Lo, Hi, Mid : Integer;
   T : String;
 begin
   Lo := iLo;
   Hi := iHi;
   Mid := GetTail(Sl[(Lo + Hi) ],Sp);
   repeat
     while GetTail(Sl[Lo],Sp) < Mid do Inc(Lo);
     while GetTail(Sl[Hi],Sp) > Mid do Dec(Hi);
     if Lo <= Hi then
     begin
       T := sl[Lo];
       sl[Lo] := sl[Hi];
       sl[Hi] := T;
       Inc(Lo);
       Dec(Hi);
     end;
   until Lo > Hi;
   if Hi > iLo then SlQuickSort(Sl, iLo, Hi);
   if Lo < iHi then SlQuickSort(Sl, Lo, iHi);
 end;

 Function HexToInt(Hex :String):Int64;
 Var Sum : Int64;
     I,L : Integer;
 Begin
   L := Length(Hex);
   Sum := ;
   For I :=  to L Do
    Begin
    Sum := Sum * ;
    If ( Ord(Hex[I]) >= Ord(')) then
       Sum := Sum + Ord(Hex[I]) - Ord(')
    else If ( Ord(Hex[I]) >= Ord('A') ) and (Ord(Hex[I]) <= Ord('F')) then
       Sum := Sum + Ord(Hex[I]) - Ord(
    else If ( Ord(Hex[I]) >= Ord('a') ) and ( Ord(Hex[I]) <= Ord('f')) then
       Sum := Sum + Ord(Hex[I]) - Ord(
    else
       Begin
       Sum := -;
       break;
       End;
    End;
   Result := Sum;
 End;

function GetHead(str,sp : String):string;
 begin
   Result:=copy(str,,pos(sp,str)-);
 end;

 procedure WhiteBlackImgEx(const bmp: TBitmap);
 type
   xByteArray = array of Byte;
 var
   p: PByteArray;
   J,Y,W: Integer;
   arr: xByteArray;
   function AverageArr(const Data: xByteArray; const Count: Integer): Int64;
   var
     I: Integer;
   begin
     Result := ;
      then Exit;
       do
     begin
       Result := Result + Data[I];
     end;
     Result := Round(Result/Count);
   end;
 begin
   bmp.PixelFormat := pf24bit;
   SetLength(arr,bmp.Height*bmp.Width);
     do
   begin
     p := bmp.ScanLine[Y];
     J := ;
      do
     begin
       arr[(Y*bmp.Width)+J ] := Round((p[J]+p[J+]+p[J+])/);
       Inc(J,);
     end;
   end;
   W := Byte(AverageArr(Arr,bmp.Height*bmp.Width));
     do
   begin
     p := bmp.ScanLine[Y];
     J := ;
      do
     begin
       ]+p[J+])/) >= W then
       begin
         p[J] := ;
         p[J+] := ;
         p[J+] := ;
       end else
       begin
         p[J] := MaxByte;
         p[J+] := MaxByte;
         p[J+] := MaxByte;
       end;
       Inc(J,);
     end;
   end;
   SetLength(Arr,);
 end;

 procedure Ranse(const bmp: TBitmap; const Color: TColor);
 var
   c: TColor;
   X,Y: Integer;
   r1,g1,b1: Byte;
   r2,g2,b2: Byte;
 begin
   r1 := GetRValue(Color);
   g1 := GetGValue(Color);
   b1 := GetBValue(Color);
     do
   begin
       do
     begin
       c := Bmp.Canvas.Pixels[X,Y];
       r2 := GetRValue(c);
       g2 := GetGValue(c);
       b2 := GetBValue(c);
      // if (c <> clWhite) and (c <> clBlack) then
     // begin
        r2 := Round(r1*Min(Abs(r2-MaxByte),MaxByte-r2)/MaxByte);
         g2 := Round(g1*Min(Abs(g2-MaxByte),MaxByte-g2)/MaxByte);
         b2 := Round(b1*Min(Abs(b2-MaxByte),MaxByte-b2)/MaxByte);
         c := RGB(r2,g2,b2);
         Bmp.Canvas.Pixels[X,Y] := c;
     //  end;
    end;
   end;
 end;

 procedure Grayscale(const bmp: TBitmap);
 var
   p: PByteArray;
   J,Y,W: Integer;
 begin
   bmp.PixelFormat := pf24bit;
     do
   begin
     p := bmp.ScanLine[Y];
     J := ;
      do
     begin
       W := (P[J] *  + P[J+] * + P[J+] * );
       W := W ;
       P[J] := Byte(W);
       P[J+] := Byte(W);
       P[J+] := Byte(W);
       Inc(J,);
     end;
   end;
   //bmp.PixelFormat := pf1bit;
  //bmp.PixelFormat := pf24bit;
end;

function ALL2BMP(const Filename : String; const Bmp: TBitmap): Boolean;
 var
   GIF: TGIFImage;
   jpg: TJPEGImage;
   PNG: TPNGobject;
   FileEx: String;
 begin
   Result := False;
   try
     FileEx := UpperCase(ExtractFileExt(filename));
     if FileEx = '.PNG' then
     begin
       PNG := TPNGobject.Create;
       try
         PNG.LoadFromFile(filename);
         _PicFormat := ;
         BMP.Assign(PNG);
       except
         //not png image
      end;
       PNG.Free;
     end else if FileEx = '.BMP' then
       try
         BMP.LoadFromFile(filename);
         _PicFormat := ;
       except
         //not bmp image
      end
     else if FileEx = '.GIF' then
     begin
       GIF := TGIFImage.Create;
       try
         GIF.LoadFromFile(filename);
         _PicFormat := ;
         BMP.Assign(GIF);
       except
         //not gif image
      end;
       GIF.Free;
     end else if (FileEx = '.JPG') or (FileEx = '.JPEG') then
     begin
       JPG := TJPEGImage.Create;
       try
         JPG.LoadFromFile(filename);
         _PicFormat := ;
         BMP.Assign(JPG);
       except
         //not jpg image
      end;
       JPG.Free;
     end;
     //
     then
       try
         BMP.LoadFromFile(FileName);
         _PicFormat := ;
       except
       end;
      then
     begin
       PNG := TPNGobject.Create;
       try
         PNG.LoadFromFile(FileName);
         _PicFormat := ;
         BMP.Assign(PNG);
       finally
         PNG.Free;
       end;
     end;
      then
     begin
       GIF := TGIFImage.Create;
       try
         GIF.LoadFromFile(FileName);
         _PicFormat := ;
         BMP.Assign(GIF);
       finally
         GIF.Free;
       end;
     end;
      then
     begin
       JPG := TJPEGImage.Create;
       try
         JPG.LoadFromFile(FileName);
         BMP.Assign(JPG);
         _PicFormat := ;
       finally
         JPG.Free;
       end;
     end;
     Result := True;
   except
   end;
 end;function PIC2BMP(filename : String): TBITMAP;
 var
   GIF: TGIFImage;
   jpg: TJPEGImage;
   BMP: TBITMAP;
   PNG: TPNGobject;
   FileEx: String;
   i, j, x: Byte;
   b : boolean;
   //
  SrcRGB : pByteArray;
   ClPixel : TColor;
 begin
   b := False;
   ClPixel := ;
   FileEx := UpperCase(ExtractFileExt(filename));
   BMP := TBITMAP.Create;
   if FileEx = '.PNG' then
   begin
     PNG := TPNGobject.Create;
     try
       PNG.LoadFromFile(filename);
       _PicFormat := ;
       BMP.Assign(PNG);
     except
       //not png image
    end;
     PNG.Free;
   end else if FileEx = '.BMP' then
     try
       BMP.LoadFromFile(filename);
       _PicFormat := ;
     except
       //not bmp image
    end
   else if FileEx = '.GIF' then
   begin
     GIF := TGIFImage.Create;
     try
       GIF.LoadFromFile(filename);
       _PicFormat := ;
       BMP.Assign(GIF);
     except
       //not gif image
    end;
     GIF.Free;
   end else if (FileEx = '.JPG') or (FileEx = '.JPEG') then
   begin
     JPG := TJPEGImage.Create;
     try
       JPG.LoadFromFile(filename);
       _PicFormat := ;
       JPG.Grayscale := TRUE;
       BMP.Assign(JPG);
     except
       //not jpg image
    end;
     JPG.Free;
   end;
   //
   then
     try
       BMP.LoadFromFile(FileName);
       _PicFormat := ;
     except
     end;
    then
   begin
     PNG := TPNGobject.Create;
     try
       PNG.LoadFromFile(FileName);
       _PicFormat := ;
       BMP.Assign(PNG);
     finally
       PNG.Free;
     end;
   end;
    then
   begin
     GIF := TGIFImage.Create;
     try
       GIF.LoadFromFile(FileName);
       _PicFormat := ;
       BMP.Assign(GIF);
     finally
       GIF.Free;
     end;
   end;
    then
   begin
     JPG := TJPEGImage.Create;
     try
       JPG.LoadFromFile(FileName);
       JPG.Grayscale := TRUE;
       BMP.Assign(JPG);
       _PicFormat := ;
     finally
       JPG.Free;
     end;
   end;

   _PicWidth := BMP.Width;
   _PicHeight := BMP.Height;
   //BMP.SaveToFile(_PicFile+'.BMP');

   //Fetch(_BbsType,_PicWidth,_PicHeight,_PicFormat,_CodeUrl);
  if _EffBLW then
   begin
     Grayscale(bmp);
     Ranse(bmp,clRed);
     WhiteBlackImgEx(bmp);
   end else
   begin
     Bmp.PixelFormat := pf24Bit;

   // make picture only black and white
      do
     begin
       SrcRGB := BMP.ScanLine[j];
         do
       begin
         if MycharInfo._ClrRect then
         begin
           x := MycharInfo._RectLen;
           -x)-x) then
           begin
             SrcRGB[i*]   := $ff;
             SrcRGB[i*+] := $ff;
             SrcRGB[i*+] := $ff;
             continue;
           end;
         end;
         ClPixel := HexToInt(IntToHex(SrcRGB[i*],)+
                               IntToHex(SrcRGB[i*+],)+
                               IntToHex(SrcRGB[i*+],));
         if MycharInfo.CusDiv then
         begin
           case MycharInfo.DivCmp of
           :  b := ClPixel > MycharInfo.DivColr;
           :  b := ClPixel = MycharInfo.DivColr;
           :  b := ClPixel < MycharInfo.DivColr;
           :  b := ClPixel <> MycharInfo.DivColr;
           end;
         end else
           b := ClPixel > MycharInfo.DivColr;
         if b then begin
           SrcRGB[i*]   := $ff;
           SrcRGB[i*+] := $ff;
           SrcRGB[i*+] := $ff;
         end else begin
           SrcRGB[i*]   := ;
           SrcRGB[i*+] := ;
           SrcRGB[i*+] := ;
         end;
       end;
     end;
   end;
   {BMP.Canvas.lock;
   for i := 0 to BMP.Width - 1 do
     for j := 0 to BMP.Height - 1 do
     begin
       if _ClrRect then
       begin
         x := _RectLen;
         if (iBMP.Width-1-x)or(j>BMP.Height-1-x) then
         begin
           BMP.Canvas.Pixels[i, j] := clwhite;
           continue;
         end;
       end;
       if _CusDiv then
       begin
         case _DivCmp of
         0:  b := BMP.Canvas.Pixels[i, j] > _DivColr;
         1:  b := BMP.Canvas.Pixels[i, j] = _DivColr;
         2:  b := BMP.Canvas.Pixels[i, j] < _DivColr;
         end;
       end else
         b := BMP.Canvas.Pixels[i, j] > _DivColr;
       if b then
         BMP.Canvas.Pixels[i, j] := clwhite
       else
         BMP.Canvas.Pixels[i, j] := clblack;
     end;
   BMP.Canvas.Unlock;  }
   result := BMP;
 end;

function CMPBMP(SBMP: TBITMAP; x0, m: integer): integer;
 var
   i, j: integer;
   //
  SrcRGB : pByteArray;
 begin
   result := ;
     do
   begin
     SrcRGB := SBMP.ScanLine[j];
       do
     begin
       ] = ) ) then
         Inc(Result);
       ] > ) ) then
         Inc(Result);
     end;
   end;

   {
   result := 0;
   SBMP.Canvas.Lock;
   for i := 0 to MycharInfo.charwidth - 1 do
     for j := 0 to MycharInfo.charHeight - 1 do
     begin
       if _CmpChr and (SBMP.Canvas.Pixels[x0 + i, j] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
         Inc(Result);
       if _CmpBg and (SBMP.Canvas.Pixels[x0 + i, j] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
         Inc(Result);
     end;
   SBMP.Canvas.Unlock;  }
 end;

function CMPBMPPRO(SBMP: TBITMAP; x0, m: integer): integer;
 var
   i, j : integer;
   xj : byte;
   Ret : Integer;
   //
  SrcRGB : pByteArray;
 begin
   result := ;
    to _BITMAP.Height - MycharInfo.charheight do
   begin
     Ret := ;
       do
     begin
       SrcRGB := SBMP.ScanLine[j+xj];
         do
       begin
         ] = ) ) then
           Inc(Ret);
         ] > ) ) then
           Inc(Ret);
       end;
     end;
     if result > Ret then
     result := Ret;
   end;

   {result := 99999;
   SBMP.Canvas.Lock;
   for xj := 0 to _BITMAP.Height - MycharInfo.charheight do
   begin
     Ret := 0;
     for i := 0 to MycharInfo.charwidth - 1 do
       for j := 0 to MycharInfo.charHeight - 1 do
       begin
         if _CmpChr and (SBMP.Canvas.Pixels[x0 + i, j+xj] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
           Inc(Ret);
         if _CmpBg  and (SBMP.Canvas.Pixels[x0 + i, j+xj] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
           Inc(Ret);
       end;
     if result > Ret then
     result := Ret;
   end;
   SBMP.Canvas.Unlock;   }
 end;

function GetStringFromImage(SBMP: TBITMAP): String;
//const
 //  SpeicalChars: ..] of String = ('+','-','*','/','(',')','=');
var
   k, m, x: integer;
   alike : Integer;
   S : String;
   Sort : boolean;
   SlAlike : TStringList;
 begin
   //DebugStr('SBMP_W_H',IntToStr(SBMP.Width)+'*'+IntToStr(SBMP.Height),'e:');
  result := '';
   if _Effect.To1Line = True then
   begin
     try
       To1Line(SBMP,_Effect.Y0,MycharInfo.X0,MycharInfo.charwidth,Mycharinfo.TotalChars);
     except
     end;
   end;
   SlAlike := TStringList.Create;
     do
   begin
     x := MycharInfo.X0 + MyCharInfo.charwidth * k;
     //DebugLog('k:'+IntToStr(k)+'  '+'x:'+IntToStr(x));
    SlAlike.Clear;
     Sort := True;
       do
     begin
       if Mycharinfo.allcharinfo[m].used = True then
       begin
         {if m>35 then
           S := SpeicalChars[m-36]
         else if m>9 then
           S := Chr(m+87)
         else
           S := IntToStr(m); }
         S := Mycharinfo.allcharinfo[m].MyChar;
         if SBMP.Height = MycharInfo.charheight then
           Alike := CMPBMP(SBMP, x, m)
         else
           Alike := CMPBMPPRO(SBMP, x, m);
       //DebugLog('m:'+s+'  '+'Alike:'+IntToStr(Alike));
         then
         begin
           Result := Result + S;
           //DebugLog('get_it:'+s);
          //DebugStr()+ 'TH NUM','e:');

           Sort := False;
           break;
         end else
           SlAlike.Add(S + Sp + IntToStr(Alike));
       end;
     end;
     if Sort then
     begin
       SlQuickSort(SlAlike,,SlAlike.Count-);
       result := result + GetHead(SlAlike[],Sp);
       //DebugLog(],Sp));
      //DebugStr(],Sp)+ ' AS '+IntToStr(k)+ 'TH NUM','e:');

       //SlAlike.SaveToFile('f:\'+IntToStr(k)+'.txt');
    end;
   end;
   SlAlike.Free;
 end;

function RecogOCR(var Success: Boolean; const ImageFile: String): String;
 begin
   Success := False;
   try
     _BITMAP := nil;
     LastRecogTime := GetTickCount;
     _BITMAP := PIC2BMP(ImageFile);
     Result := GetStringFromImage(_BITMAP);
     LastRecogTime := GetTickCount-LastRecogTime;
     SaveBmp;
     _BITMAP.Free;
     Success := True;
      then Result := SSUtils.RecogSuanshi(Result);
   except
     LastRecogTime := ;
   end;
 end;
 end.
//----------------------------------------------------------
 //----------------------------------------------------------
unit SSUtils;

interface

 uses Windows, SysUtils, CalcExpress;

function RecogSuanshi(const S: String): String;

 implementation

function DeleteFh(const S: String; const Fh: Char): String;
 var
   I: Integer;
 begin
   Result := '';
    to Length(S) do
   begin
     if S[I] <> Fh then
     begin
       Result := Result + S[I];
     end;
   end;
 end;

function RecogSuanshi(const S: String): String;
const
   argv: ..] ,);
 var
   S2: String;
   cexp: TCalcExpress;
 begin
   Result := '计算错误!';
   try
     cexp := TCalcExpress.Create(nil);
     try
       S2 := DeleteFh(S,'?');
       S2 := DeleteFh(S,'=');
       S2 := StringReplace(S2,'加','+',[rfReplaceAll]);
       S2 := StringReplace(S2,'减','-',[rfReplaceAll]);
       S2 := StringReplace(S2,'乘','*',[rfReplaceAll]);
       S2 := StringReplace(S2,'除','/',[rfReplaceAll]);
       S2 := StringReplace(S2,'×','*',[rfReplaceAll]);
       S2 := StringReplace(S2,'÷','/',[rfReplaceAll]);
       S2 := StringReplace(S2,'+','+',[rfReplaceAll]);
       S2 := StringReplace(S2,'-','-',[rfReplaceAll]);

       cexp.Formula := S2;
       Result := IntToStr(Round(cexp.calc(argv)));
     except
     end;
   finally
     cexp.Free;
   end;
 end;

 end.

Delphi识别读取验证码的更多相关文章

  1. [Java] 识别图片验证码

    现在大多数网站都采用了验证码来防止暴力破解或恶意提交.但验证码真的就很安全吗?真的就不能被机器识别?? 我先讲讲我是怎么实现站外提交留言到一个网站的程序. 这个网站的留言版大致如下: 我一看这种简单的 ...

  2. Python识别网站验证码

    http://drops.wooyun.org/tips/6313 Python识别网站验证码 Manning · 2015/05/28 10:57 0x00 识别涉及技术 验证码识别涉及很多方面的内 ...

  3. 验证码处理类:UnCodebase.cs + BauDuAi 读取验证码的值(并非好的解决方案)

    主要功能:变灰,去噪,等提高清晰度等 代码类博客,无需多说,如下: public class UnCodebase { public Bitmap bmpobj; public UnCodebase( ...

  4. C# Json反序列化 C# 实现表单的自动化测试&lt;通过程序控制一个网页&gt; 验证码处理类:UnCodebase.cs + BauDuAi 读取验证码的值(并非好的解决方案) 大话设计模式:原型模式 C# 深浅复制 MemberwiseClone

    C# Json反序列化   Json反序列化有两种方式[本人],一种是生成实体的,方便处理大量数据,复杂度稍高,一种是用匿名类写,方便读取数据,较为简单. 使用了Newtonsoft.Json,可以自 ...

  5. python 识别图片验证码报IOError

    说一下困扰了我一周的问题:识别图片验证码 本来我按照安装步骤(http://www.cnblogs.com/yeayee/p/4955506.html?utm_source=tuicool&u ...

  6. DELPHI下读取与设置系统时钟

    在DELPHI下读取与设置系统时钟 很多朋友都想在自己的程序中显示系统时间 这在DELPHI中十分容易 利用DateToStr(Date)及TimeToStr(Time)函数即可实现. 二者的函数原型 ...

  7. Delphi TcxTreeList 读取 TcxImageComboBoxItem类型的值

    Delphi  TcxTreeList 读取  TcxImageComboBoxItem类型的值: Node.Values[wiNodeLevel.ItemIndex]://值 Node.Texts[ ...

  8. uu云验证码识别平台,验证码,验证码识别,全自动验证码识别技术,优优云全自动打码,代答题系统,优优云远程打码平台,uu云打码

    uu云验证码识别平台,验证码,验证码识别,全自动验证码识别技术,优优云全自动打码,代答题系统,优优云远程打码平台,uu云打码 优优云验证码识别答题平台介绍 优优云|UU云(中国公司)是全球唯一领先的智 ...

  9. Python - WebDriver 识别登录验证码

    Python - WebDriver 识别登录验证码 没什么可说的直接上代码! #-*-coding:utf-8-*- # Time:2017/9/29 7:16 # Author:YangYangJ ...

随机推荐

  1. 使用 Git Hooks 实现自动项目部署

    最近在某服务器上面搭建 git 开发和部署环境,git 开发环境很简单,按照 ProGit 一书的相关知识就可以轻松搞定,实现了类似 Github 的使用 SSH + 私有 Clone 的方式. 关于 ...

  2. 重温Servlet学习笔记--servletContext对象

    一个项目中只有一个ServletContext对象,我们可以在多个servlet中获取这个唯一的对象,使用它可以给多个servlet传递数据,我们通常成servletContext为上下文对象.这个对 ...

  3. Code笔记 之:防盗链(图片)

    图片防盗链   参考:http://bbs.csdn.net/topics/330080045    应该是”10种图片防盗的方法“,而不是”10种图片防盗链的方法“,不过看搜索防盗链的人要多一点,所 ...

  4. 使用PDO进行sql的预处理和操作结果集

  5. mysql高可用方案总结性说明

    MySQL的各种高可用方案,大多是基于以下几种基础来部署的(也可参考:Mysql优化系列(0)--总结性梳理   该文后面有提到)1)基于主从复制:2)基于Galera协议(PXC):3)基于NDB引 ...

  6. ABBYY FineReader无法打开TWAIN源怎么办

    ABBYY FineReader OCR文字识别软件不仅可以将PDF文档和图像文件(包括数码照片)转换为可编辑.可搜索的格式,还可以用来扫描文档,但在扫描过程中,有时可能会出现以下两种错误信息:一是无 ...

  7. LESS CSS 总结

    1.LESS 简介 less是动态的样式表语言,通过简洁明了的语法定义,使编写 CSS 的工作变得非常简单 类似Jquery框架 中文网站: http://www.lesscss.net/ 2.编译工 ...

  8. iostransitiontranslate闪屏问题总结

    webkit在绘制页面时会将结构分为各种层,当层足够大时就会变成很大的平铺层.这样一来webkit在每次页面结构发生变化时不需要都渲染整个页面而是渲染对应层了,这对渲染速度来说相当的重要.webkit ...

  9. 一、 kettle开发、上线常见问题以及防错规范步骤

    此篇说明对应的kettle版本是6.1,实际使用时7.x应该也是一样的. 一.    kettle开发流程(规范步骤,防止出错) (一)       Kettle设置检查 资源库连接 如果不加一下配置 ...

  10. Hadoop基础知识串烧

     YARN资源调度: 三种 FIFO 大任务独占 一堆小任务独占 capacity 弹性分配 :计算任务较少时候可以利用全部的计算资源,当队列的任务多的时候会按照比例进行资源平衡. 容量保证:保证队 ...