验证码自动识别代码之VB编

从老外网站找的验证码识别代码,可以识别简单的图片验证码,因为老外的网站不知道是哪国的语言,看来看去不知所云,所以把代码复制过来慢慢研究吧.国内类似代码也有,但因为我是新手,很多地方不太懂,哈哈!

以下是窗体代码:

form1 uzerine picturebox at isim=pic1
commandbutton at isim=CmdGetCode
textbox at isim=txtCode

sonrada asagidaki kodu copy paste yapin form1 icine;

Kod:

Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal FileName As Long, hImage As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hDC As Long, Graphics As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal Graphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "gdiplus" (ByVal Graphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal SrcWidth As Long, ByVal SrcHeight As Long, ByVal srcUnit As Long, Optional ByVal imageAttributes As Long = 0, Optional ByVal callback As Long = 0, Optional ByVal callbackData As Long = 0) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Long
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Const UnitPixel As Long = &H2&

Private Type Bitmap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes

As Long
bmPlanes As Integer
bmBitsPixel As Integer
BmBits As Long
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Enum ImageLockMode
ImageLockModeRead = &H1
ImageLockModeWrite = &H2
ImageLockModeUserInputBuf = &H4
End Enum
Private Type BitmapData
Width As Long
Height As Long
Stride As Long
PixelFormat As Long
scan0 As Long
reserved As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type GetRGB
R As Byte
G As Byte
B As Byte
End Type
Private Sub CmdGetCode_Click()
Dim cGC As New clsGetCode
Call GetCode

txtCode = cGC.GetCode(pic1)
End Sub
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Absterge()
Dim PicBits() As Byte, PicInfo As Bitmap, BytesPerPixel As Long
Dim R As Byte, G As Byte, B As Byte, Gray As Byte, I As Long

With pic1
.AutoRedraw = True
GetObject .Image, Len(PicInfo), PicInfo
BytesPerPixel = PicInfo.bmBitsPixel \ 8
ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * BytesPerPixel)
GetBitmapBits .Image, UBound(PicBits), PicBits(1)
For I = 0 To UBound(PicBits) \ BytesPerPixel - 1
B = PicBits(I * BytesPerPixel + 1)
G = PicBits(I * BytesPerPixel + 2)
R = PicBits(I * BytesPerPixel + 3)
Gray = R * 0.39 + G * 0.5 + B * 0.11
If R <> B Then Gray = 255
If Gray > 180 Then Gray = 255 Else Gray = 0
PicBits(I * BytesPerPixel + 1) = Gray
PicBits(I * BytesPerPixel + 2) = Gray
PicBits(I * BytesPerPixel + 3) = Gray
Next I
SetBitmapBits .Image, UBound(PicBits), PicBits(1)
.Refresh
End With

End Sub

Private Sub GetCode()
Dim Image As Long
Dim Graphics As Long
Dim Token As Long
Dim GdipInput As GdiplusStartupInput
DownloadFile "/image.php?newtime=1223176107921", App.Path + "/~1.bmp"
GdipInput.GdiplusVersion = 1
GdiplusStartup Token, GdipInput
GdipLoadImageFromFile StrPtr(App.Path & "\~1.bmp"), Image
GdipGetImageWidth Image, Width
GdipGetImageHeight Image, Height
GdipCreateFromHDC pic1.hDC, Graphics

GdipDrawImageRectRectI Graphics, Image, 0, 0, Width, Height, 0, 0, Width, Height, UnitPixel, 0, 0, 0
GdipDeleteGraphics Graphics
GdipDisposeImage Image
pic1.Refresh
pic1.Picture = pic1.Image
GdiplusShutdown Token
End Sub

以下是类模块:

sonrada bir classmodule ekleyin isim=clsGetCode
Kod:

Option Explicit
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private m_G As Byte

Public Function GetCode(pic1 As PictureBox) As String
Dim R As Byte
Dim G As Byte
Dim B As Byte

Dim x As Long
Dim y As Long
Dim x1 As Long
Dim y1 As Long

Dim iy As Long
Dim ix As Long

Dim pix() As Boolean
ReDim pix(pic1.ScaleWidth - 1, pic1.ScaleHeight - 1) As Boolean

For iy = 0 To pic1.ScaleHeight - 1
For ix = 0 To pic1.ScaleWidth - 1
Call GetRGB(GetPixel(pic1.hDC, ix, iy), R, G, B)
If G <= m_G Then
pix(ix, iy) = True
Else
pix(ix, iy) = False
End If
Next
Next

x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)
x1 = x
y1 = y
x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)

x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)
x1 = x
y1 = y
x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)

x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)
x1 = x
y1 = y
x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)

x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)
x1 = x
y1 = y
x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)

x = GetFontStartX(pix(), x)
y = GetFontStartY(pix(), 0)
x1 = x
y1 = y
x = GetFontEndX(pix(), x)
y = GetFontEndY(pix(), y)
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
End Function

Private Sub GetRGB(ByVal Color As Long, ByRef R As Byte, ByRef G As Byte, ByRef B As Byte, Optional ByRef A As Byte)
A = CByte((Color And &HFF000000) / 2 ^ (8 * 3))
R = CByte((Color And &HFF) / 2 ^ (8 * 0))
G = CByte(((Color And &HFF00) / 2 ^ (8 * 1)) And &HFF)
B = CByte((Color And &HFF0000) / 2 ^ (8 * 2))
End Sub

Private Function GetFontStartY(ByRef pix() As Boolean, ByRef sY As Long) As Long
Dim ix As Long
Dim iy As Long
For iy = sY To UBound(pix(), 2)
For ix = 0 To UBound(pix(), 1)
If pix(ix, iy) Then
GetFontStartY = iy
Exit Function
End If
Next
Next
End Function

Private Function GetFontStartX(ByRef pix() As Boolean, ByRef sX As Long) As Long
Dim ix As Long
Dim iy As Long
For ix = sX To UBound(pix(), 1)
For iy = 0 To UBound(pix(), 2)
If pix(ix, iy) Then
GetFontStartX = ix
Exit Function
End If
Next
Next
End Function


Priva

te Function GetFontEndY(ByRef pix() As Boolean, ByRef sY As Long) As Long
Dim ix As Long
Dim iy As Long
Dim flag As Boolean

For iy = sY To UBound(pix(), 2)
flag = True
For ix = 0 To UBound(pix(), 1)
If pix(ix, iy) Then
flag = False
Exit For
End If
Next
If flag = True Then
GetFontEndY = iy
Exit Function
End If
Next

End Function

Private Function GetFontEndX(ByRef pix() As Boolean, ByRef sX As Long) As Long
Dim ix As Long
Dim iy As Long
Dim flag As Boolean

For ix = sX To UBound(pix(), 1)
flag = True
For iy = 0 To UBound(pix(), 2)
If pix(ix, iy) Then
flag = False
Exit For
End If
Next
If flag = True Then
GetFontEndX = ix
Exit Function
End If
Next
End Function

Private Function GetNum(pix() As Boolean, x, y, x1, y1) As String
Dim s As String
Dim ix As Long
Dim iy As Long
For iy = y To y1 - 1
For ix = x To x1 - 1
s = s & Abs(CInt(pix(ix, iy)))
Next
Next
GetNum = GetPixModNum(s)
End Function


Private Sub Class_Initialize()
m_G = 150
End Sub


Private Function GetPixModNum(str As String) As String
Dim C_char(9) As String
C_char(0) = "00011000001111000110011011000011110000111100001111000011011001100011110000011000"
C_char(1) = "001100011100111100001100001100001100001100001100001100111111"
C_char(2) = "00111100011001101100001100000011000001100000110000011000001100000110000011111111"
C_char(3) = "01111100110001100000001100000110000111000000011000000011000000111100011001111100"
C_char(4) = "00000110000011100001111000110110011001101100011011111111000001100000011000000110"
C_char(5) = "11111110110000001100000011011100111001100000001100000011110000110110011000111100"
C_char(6) = "00111100011001101100001011000000110111001110011011000011110000110110011000111100"
C_char(7) = "11111111000000110000001100000110000011000001100000110000011000001100000011000000"
C_char(8) = "00111100011001101100001101100110001111000110011011000011110000110110011000111100"
C_char(9) = "00111100011001101100001111000011011001110011101100000011010000110110011000111100"

Dim I As Integer
For I = 0 To UBound(C_char)
If C_char(I) <> "" Then
If Compare(str, C_char(I)) Then
GetPixModNum = Chr(I + 48)
Exit Function
End If
End If
Next
End Function

Private Function Compare(str As String, modstr As String, Optional rc As Integer = 5) As Boolean
Dim I As Integer
Dim n As Integer
For I = 1 To Len(modstr)
If Mid(str, I, 1) <> Mid(modstr, I, 1) Then n = n + 1
Next
If n > rc Then
Compare = False


Else
Compare = True
End If
End Function