| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 669 人关注过本帖, 1 人收藏
标题:验证码的一些心得
取消只看楼主 加入收藏
zhuyongxing
Rank: 6Rank: 6
等 级:侠之大者
威 望:1
帖 子:234
专家分:482
注 册:2009-8-5
结帖率:91.43%
收藏(1)
 问题点数:0 回复次数:0 
验证码的一些心得
程序代码:
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Dim m_G As Byte
Dim m_R As Byte
Dim m_B As Byte
Dim HQ As Boolean
Private Sub Command1_Click()
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化
End Sub

Public Function 二值化() As String
Dim a As Byte
Dim b As Byte
Dim G As Byte
Dim R As Byte

Dim NumS As String

Dim pix() As Boolean

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

Dim Color1 As Long
Dim Color2 As Long

Dim iy As Long
Dim ix As Long


For iy = 3 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 And R <= m_R And b <= m_B Then
           pix(ix, iy) = False
        Else
           pix(ix, iy) = True
        End If
    Next
Next

Dim str As String
For iy = 3 To UBound(pix(), 2)
    For ix = 0 To UBound(pix(), 1)
        If pix(ix, iy) Then
            str = str & ""
        Else
            str = str & ""
        End If
    Next
    str = str & vbCrLf
Next





Text1.Text = str




str = ""
For ix = 0 To UBound(pix(), 1)

For iy = 3 To UBound(pix(), 2)
        If pix(ix, iy) Then
            str = str & ""
        Else
            str = str & ""
        End If
    Next
    str = str & vbCrLf
Next
Text8 = str
End Function
Public Function 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))
    b = CByte((Color And &HFF0000) / 2 ^ (8 * 2))
    G = CByte(((Color And &HFF00) / 2 ^ (8 * 1)) And &HFF)
    R = CByte((Color And &HFF) / 2 ^ (8 * 0))
End Function

Private Sub Command2_Click()
List1.AddItem "正确"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub

Private Sub Command3_Click()
Picture1.Picture = pic1.Picture
  If Text6.Text = "" Then Exit Sub
   
    With HttpSocket1
        .Http_Ver = V11
        .RequestUrl = Text6.Text
        '.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
        .AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
        .AddHeader "Accept-Language", "zh-cn"
        '.AddHeader "Accept-Encoding", "gzip, deflate"
        .AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
        .AddHeader "Host", .RemoteHost
        .AddHeader "Connection", "Close"
        .SendRequest
    End With
   
Command6_Click
End Sub
Private Sub Command4_Click()
List1.AddItem "错误"
For i = 0 To List1.ListCount - 1
If List1.List(i) = "正确" Then
z = z + 1
Else
p = p + 1
End If
Next i
Text5 = "总记录---" & List1.ListCount & "条记录---正确---" & z & "条记录---正确率---" & Format((z / List1.ListCount) * 100, "0.00") & "%"
End Sub

Private Sub Command6_Click()
'---------------------------二值
m_G = Text2.Text
m_R = Text3.Text
m_B = Text4.Text
Call 二值化


Dim str1() As String
Dim str2() As String
Dim i As Integer
Dim j As Integer
i = 0
str1() = Split(Text1.Text, vbCrLf)
str2() = Split(Text8.Text, vbCrLf)

'1-9  8-17  15-25  23-32

For i = 0 To 3
Text7(i) = ""
Next i
'----------------------------------识别2
Dim m(0 To 3) As Long, n(0 To 3) As Long
m(0) = 1: m(1) = 8: m(2) = 15: m(3) = 23
n(0) = 9: n(1) = 17: n(2) = 25: n(3) = 32


For k = 0 To 3 '------2
num = 0
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") = 0 Then
Text7(k) = IIf(Text7(k) = "", "2", Text7(k))
End If
End If
Next k

For k = 0 To 3 '---------4
If InStr(Mid(str1(6), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Or InStr(Mid(str1(7), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(9, "")) > 0 Then Text7(k) = IIf(Text7(k) = "", "4", Text7(k)): Exit For '"□■■■■□"
Next i
End If
Next k




For k = 0 To 3 '-------------3,5
num = 0
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(7, "")) > 0 Then
If InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Or InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Then
For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), String(5, "")) > 0 Then num = num + 1
Next i
If num >= 2 Then Text7(k) = IIf(Text7(k) = "", "5", Text7(k))

End If
Else

If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(5, "")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(5, "")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "■□□□■") > 0 Then

For i = m(k) - 1 To n(k) - 1
If InStr(str2(i), "" & String(5, "")) > 0 Then Text7(k) = IIf(Text7(k) = "", "3", Text7(k)): Exit For
Next i



End If
End If
End If
Next k






For k = 0 To 3 '-------------------8
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If

If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "8", Text7(k))
End If
Next k


For k = 0 To 3 '-------------------7
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(8, "")) > 0 Or InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(8, "")) > 0 Then
Text7(k) = IIf(Text7(k) = "", "7", Text7(k))
End If
Next k


For k = 0 To 3 '-------------------6
If InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■□■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■■■■") > 0 Or InStr(Mid(str1(3), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "■■□■■") > 0 Then
Text7(k) = IIf(Text7(k) = "", "6", Text7(k)) '
End If
Next k



For k = 0 To 3 '-------------------9
If InStr(Mid(str1(0), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(9), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Then
If InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(4), m(k), n(k) - m(k) + 1), "□■■□") Then

Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If

If InStr(Mid(str1(1), m(k), n(k) - m(k) + 1), String(4, "")) > 0 And InStr(Mid(str1(10), m(k), n(k) - m(k) + 1), String(4, "")) > 0 Then
If InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□□■■□□") > 0 Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■□") Or InStr(Mid(str1(5), m(k), n(k) - m(k) + 1), "□■■□") Then
Text7(k) = IIf(Text7(k) = "", "9", Text7(k))
End If
End If

Next k



 


End Sub



Private Sub Form_Load()
  If Text6.Text = "" Then Exit Sub
   
    With HttpSocket1
        .Http_Ver = V11
        .RequestUrl = Text6.Text
        '.SendData = "dorequest_bc&word1=%D3%E9%C0%D6%D0%DD%CF%D0"
        .AddHeader "Accept", "image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, application/x-shockwave-flash, application/vnd.ms-excel, application/msword, */*"
        .AddHeader "Accept-Language", "zh-cn"
        '.AddHeader "Accept-Encoding", "gzip, deflate"
        .AddHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)"
        .AddHeader "Host", .RemoteHost
        .AddHeader "Connection", "Close"
        .SendRequest
    End With
End Sub

Private Sub HttpSocket1_OnRecvOver()
On Error Resume Next
    Dim fn As Integer
    Dim buff() As Byte
    Dim Temp() As Byte
   
    Debug.Print HttpSocket1.ResponseHeader

    buff() = HttpSocket1.ResponseBody
   
   
    Dim savefile As String

    savefile = App.Path & "\temp.jpg"
    'Debug.Print savefile

    If Dir(savefile) <> "" Then Kill (savefile)

    fn = FreeFile

    'Open a binary file and load data into it!
    Open savefile For Binary Access Write As #fn
    Put #fn, , buff()
    DoEvents
    'Close the open file
    Close #fn
   
    pic1.Picture = LoadPicture(savefile)
End Sub
当然这里只是我发的算法部分。
我说一些我的算法。也就是图片二值化。因为图片大小一定。但是字的间隔什么都不确定
所以不能用平均分割的办法。
然后就是判断字的特点。因为都是数字所以还好判断些
我二值化之后是个11*32的一个数组。
那比如str1(11) str2(32) 这样两个数组交叉对比
比如7特征很明显。也就是str1(0)或者str(1)他的顶部含有7个1
但是相同的还有5.如何区分呢。5多了竖行也就str(2) 5个1相连的
当然分区我用的不是平均分区

'1-9  8-17  15-25  23-32这是分区 这样分别判断在那几个区就可以判断4位数字所占的位置了。
我们有固定取模块。当然。如果数字都是标准的哪取模块就相对简单一些。比如百姓网的电话图片
只是发点心得。
搜索更多相关主题的帖子: 验证码 
2012-02-17 13:48
快速回复:验证码的一些心得
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.041561 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved