baidu.frm

一个VB识别百度的验证码程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "识别百度的验证码"
   ClientHeight    =   1875
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   3915
   LinkTopic       =   "Form1"
   ScaleHeight     =   1875
   ScaleWidth      =   3915
   StartUpPosition =   3  '窗口缺省
   Begin VB.PictureBox Picture2 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   345
      Left            =   120
      ScaleHeight     =   19
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   57
      TabIndex        =   2
      Top             =   930
      Width           =   915
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   120
      ScaleHeight     =   21
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   55
      TabIndex        =   1
      Top             =   270
      Width           =   885
   End
   Begin VB.CommandButton Command1 
      Caption         =   "开始获得"
      Height          =   495
      Left            =   1890
      TabIndex        =   0
      Top             =   270
      Width           =   1215
   End
   Begin VB.Label Label2 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   2160
      TabIndex        =   6
      Top             =   930
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "结果"
      Height          =   255
      Index           =   2
      Left            =   1710
      TabIndex        =   5
      Top             =   990
      Width           =   405
   End
   Begin VB.Label Label1 
      Caption         =   "第一次转换"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   4
      Top             =   750
      Width           =   945
   End
   Begin VB.Label Label1 
      Caption         =   "原图"
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   3
      Top             =   90
      Width           =   465
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'网  站：http://www.hackeroo.com/
'e-mail：[e-mail]
'OICQ  : 266370
'****************************************************************************


Private Sub Command1_Click()
Dim ok As Boolean
Dim bm As BITMAP
Dim dot, bRed, bGreen, bBlue, Y As Long

For kuan = 0 To 49: For gao = 0 To 19
  a(kuan, gao).dot = 0
  a(kuan, gao).tag = 0
Next: Next
GetObject Picture1.Picture.Handle, Len(bm), bm

Picture2.Height = Picture1.Height

Picture2.Width = Picture1.Width
 For gao = 0 To bm.bmHeight - 1
 For kuan = 0 To bm.bmWidth - 1
        
        dot = GetPixel(Picture1.hdc, kuan, gao)
     bRed = Red(dot)
     bGreen = Green(dot)
     bBlue = Blue(dot)
     Y = (9798 * bRed + 19235 * bGreen + 3735 * bBlue) \ 32768
    If Y < 128 Then
    dot = 1
    Else
    dot = 0
    End If
    If kuan < 6 Or kuan > 43 Or gao < 3 Or gao > 17 Then dot = 0
    a(kuan, gao).dot = dot
    
    Next kuan
    
Next gao



For kuan = 0 To 49: For gao = 0 To 19 '去掉孤立点
     
    If a(kuan, gao).dot = 1 Then
        a(kuan, gao).tag = a(kuan - 1, gao - 1).dot + a(kuan - 1, gao).dot + a(kuan - 1, gao + 1).dot + a(kuan, gao - 1).dot + a(kuan, gao + 1).dot + a(kuan + 1, gao - 1).dot + a(kuan + 1, gao).dot + a(kuan + 1, gao + 1).dot
        If a(kuan, gao).tag = 0 Then
        a(kuan, gao).dot = 0
        End If
    End If
 
Next: Next


For kuan = 0 To 49: For gao = 0 To 19 '去掉双子孤点
   
    If a(kuan, gao).dot = 1 And a(kuan, gao).tag = 1 Then
        a(kuan, gao).tag = a(kuan - 1, gao - 1).tag + a(kuan - 1, gao).tag + a(kuan - 1, gao + 1).tag + a(kuan, gao - 1).tag + a(kuan, gao + 1).tag + a(kuan + 1, gao - 1).tag + a(kuan + 1, gao).tag + a(kuan + 1, gao + 1).tag
        If a(kuan, gao).tag < 2 Then
        a(kuan, gao).dot = 0
        a(kuan, gao).tag = 0
        End If
    End If

Next: Next

'上边对整个图片初步处理,下边分块处理

Dim jieguo As String
jieguo = ""
For i = 1 To 4
FenGe (i)
QuBian
JianHua
QuQiao1
QuQiao2

If is2 Then
    jieguo = jieguo + Trim(Str(2))
ElseIf is1 Then
    jieguo = jieguo + Trim(Str(1))
ElseIf is3 Then
    jieguo = jieguo + Trim(Str(3))
ElseIf is4 Then
    jieguo = jieguo + Trim(Str(4))
ElseIf is5 Then
    jieguo = jieguo + Trim(Str(5))
ElseIf is6 Then
    jieguo = jieguo + Trim(Str(6))
ElseIf is7 Then
    jieguo = jieguo + Trim(Str(7))
ElseIf is9 Then
    jieguo = jieguo + Trim(Str(9))
ElseIf is8 Then
    jieguo = jieguo + Trim(Str(8))
Else
    jieguo = jieguo + Trim(Str(0))
End If

For kuan = 0 To 9: For gao = 0 To 19
Picture2.PSet (kuan + 10 * i - 10, gao), (1 - b(kuan, gao).dot) * 16777215
Next: Next
Next
'输出结果
SavePicture Picture2.Image, "c:\me2.bmp" '第二图
Label2.Caption = jieguo
Debug.Print jieguo
End Sub

Private Function Near(ByVal i As Integer, ByVal j As Integer) As Byte
 Near = a(i - 1, j - 1).dot * 1 + a(i, j - 1).dot * 2 + a(i + 1, j - 1).dot * 4 + a(i - 1, j).dot * 8 + a(i + 1, j).dot * 16 + a(i - 1, j + 1).dot * 32 + a(i, j + 1).dot * 64 + a(i + 1, j + 1).dot * 128
End Function

Private Sub JiSuan()
Dim kuan, gao  As Integer
For gao = 0 To 19: For kuan = 0 To 49
    If a(kuan, gao).dot = 1 Then
    a(kuan, gao).tag = Near(kuan, gao)
    End If
Next: Next
End Sub

Private Sub Form_Load()
Picture1.Picture = LoadPicture(App.Path & "\1.jpg")
End Sub