form
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim Fname$, Lineno&, j%, s
Private Sub Command10_Click()
WebBrowser1.Document.parentWindow.execScript "loginSSO()"
If InStr(1, WebBrowser1.Document.body.innerHtml, "提示：您输入的手机号码或密码错误，请重新输入") = 0 Then
Label5.Caption = s(j)
Exit Sub
Else
Label5.Caption = "go on"
End If
End Sub
Private Sub Command11_Click()
WebBrowser1.Navigate2 Text3.Text
End Sub
Private Sub Command2_Click()
Dim cGC As New clsGetCode
txtCode = cGC.GetCode(pic1)
Text1.Text = cGC.ViewString
End Sub
Private Sub Command3_Click()
Text5.Text = WebBrowser1.Document.body.innerHtml
End Sub
Private Sub Command4_Click()
Timer1.Enabled = True
Timer1.Interval = 7000
End Sub
Private Sub Command5_Click()
Timer1.Enabled = False
End Sub
Private Sub Command6_Click()
End
End Sub
Private Sub Command8_Click()
Dim CtrlRange, x
For Each x In WebBrowser1.Document.All
If UCase(x.tagName) = "IMG" Then
If x.Name = "verifyImg" Then
Set CtrlRange = WebBrowser1.Document.body.createControlRange()
CtrlRange.Add (x)
CtrlRange.execCommand ("Copy")
pic1.Picture = Clipboard.GetData
End If
End If
Next
End Sub
Private Sub Command9_Click()
j = IIf(j + 1 >= Lineno, 0, j + 1)
Dim vDoc, vTag
Dim i As Integer
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.Length - 1
If UCase(vDoc.All(i).tagName) = "INPUT" Then
Set vTag = vDoc.All(i)
Select Case vTag.Name
Case "mobileno"
vTag.Value = Text2.Text '手机号码
Case "password"
vTag.Value = s(j) '服务密码
Label4.Caption = s(j)
Case "operVerifyCode"
vTag.Value = txtCode.Text '验证码
End Select
End If
Next i
End Sub
Private Sub Form_Load()
Fname = "c:\abc.txt"
Open Fname For Input As #1
Text4.Text = StrConv(InputB(LOF(1), 1), vbUnicode)
Close #1
s = Split(Text4.Text, vbNewLine)
Lineno = UBound(s) + 1
Timer1.Enabled = False
WebBrowser1.Navigate2 Text3.Text
'Form2.Show
End Sub
Private Sub html_Change()
End Sub
Private Sub Timer1_Timer()
j = IIf(j + 1 >= Lineno, 0, j + 1)
'WebBrowser1.Navigate2 Text3.Text
Dim CtrlRange, x
For Each x In WebBrowser1.Document.All
If UCase(x.tagName) = "IMG" Then
If x.Name = "verifyImg" Then
Set CtrlRange = WebBrowser1.Document.body.createControlRange()
CtrlRange.Add (x)
CtrlRange.execCommand ("Copy")
pic1.Picture = Clipboard.GetData
'Set CtrlRange = Nothing
End If
End If
Next
Dim cGC As New clsGetCode
txtCode = cGC.GetCode(pic1)
Text1.Text = cGC.ViewString
Dim vDoc, vTag
Dim i As Integer
Set vDoc = WebBrowser1.Document
For i = 0 To vDoc.All.Length - 1
If UCase(vDoc.All(i).tagName) = "INPUT" Then
Set vTag = vDoc.All(i)
Select Case vTag.Name
Case "mobileno"
vTag.Value = Text2.Text '手机号码
Case "password"
vTag.Value = s(j) '服务密码
Label4.Caption = s(j)
Case "operVerifyCode"
vTag.Value = txtCode.Text '验证码
End Select
End If
Next i
'Sleep 400
WebBrowser1.Document.parentWindow.execScript "loginSSO()"
'Set vTag = Nothing
'Set vDoc = Nothing
Sleep 6000
If InStr(1, WebBrowser1.Document.body.innerHtml, "提示：您输入的手机号码或密码错误，请重新输入") = 0 Then
Label5.Caption = s(j)
Exit Sub
Else
Label5.Caption = "go on"
End If
End Sub
Public Sub panduan()
End Sub
类模块
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public ViewString As String
Private m_G As Byte
Public Function GetCode(pic1 As PictureBox) As String
On Error Resume Next
Kill "字模\*.txt"
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
Dim n
For iy = 0 To pic1.ScaleHeight - 10
For ix = 0 To pic1.ScaleWidth - 10
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
For iy = 1 To UBound(pix(), 2) - 1
For ix = 1 To UBound(pix(), 1) - 1
If pix(ix, iy) Then
If Not (pix(ix - 1, iy) Or pix(ix + 1, iy) Or pix(ix, iy - 1) Or pix(ix, iy + 1)) Then
pix(ix, iy) = False
End If
End If
Next
Next
iy = 0
For ix = 1 To UBound(pix(), 1) - 1
If pix(ix, iy) Then
If Not (pix(ix - 1, iy) Or pix(ix + 1, iy) Or pix(ix, iy + 1)) Then
pix(ix, iy) = False
End If
End If
Next
iy = UBound(pix(), 2)
For ix = 1 To UBound(pix(), 1) - 1
If pix(ix, iy) Then
If Not (pix(ix - 1, iy) Or pix(ix + 1, iy) Or pix(ix, iy - 1) Or pix(ix - 1, iy)) Then
pix(ix, iy) = False
End If
End If
Next
ix = 0
For iy = 1 To UBound(pix(), 2) - 1
If pix(ix, iy) Then
If Not (pix(ix, iy - 1) Or pix(ix, iy + 1) Or pix(ix + 1, iy)) Then
pix(ix, iy) = False
End If
End If
Next
ix = UBound(pix(), 1)
For iy = 1 To UBound(pix(), 2) - 1
If pix(ix, iy) Then
If Not (pix(ix, iy - 1) Or pix(ix, iy + 1) Or pix(ix - 1, iy)) Then
pix(ix, iy) = False
End If
End If
Next
If pix(0, 0) Then
If Not (pix(0, 1) Or pix(1, 1) Or pix(1, 0)) Then
pix(ix, iy) = False
End If
End If
'For ix = 1 To UBound(pix(), 1) - 1 '去掉一列只有一个点的点
' For iy = 1 To UBound(pix(), 2) - 1
' If pix(ix, iy) Then n = n + 1
' If n = 1 Then
' pix(ix, iy) = False
' End If
'
'
' Next
' Next
Dim str As String
For iy = 0 To UBound(pix(), 2)
For ix = 0 To UBound(pix(), 1)
If pix(ix, iy) Then
' Form2.CurrentX = ix * Form2.TextWidth("1")
' Form2.CurrentY = iy * Form2.TextHeight("1")
' Form2.Print "1"
str = str & "■"
Else
' Form2.CurrentX = ix * Form2.TextWidth("0")
' Form2.CurrentY = iy * Form2.TextHeight("0")
' Form2.Print "0"
str = str & "□"
End If
Next
str = str & vbCrLf
Next
ViewString = str
Dim x As Long
Dim y As Long
Dim x1 As Long
Dim y1 As Long
'--------------------------------------------------1
x = 7
y = 5
x1 = x
y1 = y
x = 17
y = 15
For iy = y1 To y
For ix = x1 To x
If pix(ix, iy) Then
Form2.CurrentX = ix * Form2.TextWidth("1")
Form2.CurrentY = iy * Form2.TextHeight("1")
Form2.Print "1"
Open "字模\1.txt" For Append As #1
Print #1, "1";
Close #1
Else
Form2.CurrentX = ix * Form2.TextWidth("0")
Form2.CurrentY = iy * Form2.TextHeight("0")
Form2.Print "0"
Open "字模\1.txt" For Append As #1
Print #1, "0";
Close #1
End If
Next
Next
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------2
x = 18
y = 5
x1 = x
y1 = y
x = 28
y = 15
For iy = y1 To y
For ix = x1 To x
If pix(ix, iy) Then
Form2.CurrentX = ix * Form2.TextWidth("1")
Form2.CurrentY = iy * Form2.TextHeight("1")
Form2.Print "2"
Open "字模\2.txt" For Append As #1
Print #1, "1";
Close #1
Else
Form2.CurrentX = ix * Form2.TextWidth("0")
Form2.CurrentY = iy * Form2.TextHeight("0")
Form2.Print "0"
Open "字模\2.txt" For Append As #1
Print #1, "0";
Close #1
End If
Next
Next
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------3
x = 29
y = 5
x1 = x
y1 = y
x = 39
y = 15
For iy = y1 To y
For ix = x1 To x
If pix(ix, iy) Then
Form2.CurrentX = ix * Form2.TextWidth("1")
Form2.CurrentY = iy * Form2.TextHeight("1")
Form2.Print "3"
Open "字模\3.txt" For Append As #1
Print #1, "1";
Close #1
Else
Form2.CurrentX = ix * Form2.TextWidth("0")
Form2.CurrentY = iy * Form2.TextHeight("0")
Form2.Print "0"
Open "字模\3.txt" For Append As #1
Print #1, "0";
Close #1
End If
Next
Next
GetCode = GetCode & GetNum(pix(), x1, y1, x, y)
'--------------------------------------------------4
x = 40
y = 5
x1 = x '起点横坐标
y1 = y '起点纵坐标
x = 50
y = 15
'If (x - x1) > 15 Then x1 = x + 12
For iy = y1 To y
For ix = x1 To x
If pix(ix, iy) Then
Form2.CurrentX = ix * Form2.TextWidth("1")
Form2.CurrentY = iy * Form2.TextHeight("1")
Form2.Print "4"
Open "字模\4.txt" For Append As #1
Print #1, "1";
Close #1
Else
Form2.CurrentX = ix * Form2.TextWidth("0")
Form2.CurrentY = iy * Form2.TextHeight("0")
Form2.Print "0"
Open "字模\4.txt" For Append As #1
Print #1, "0";
Close #1
End If
Next
Next
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))
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 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
Private 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
For iy = y To y1
For ix = x To x1
s = s & Abs(CInt(pix(ix, iy)))
Next
Next
GetNum = GetPixModNum(s)
End Function
Public Property Get G() As Byte
G = m_G
End Property
Public Property Let G(ByVal vNewValue As Byte)
m_G = vNewValue
End Property
Private Sub Class_Initialize()
m_G = 90
End Sub
'根据获得的字母的点阵数据，来进行匹配
Private Function GetPixModNum(str As String) As String
Dim C_char(35) As String
'0000011110000000111110000110001100011000001100110010011001100100110011000011011100000111011000000100100000011001000000110
C_char(0) = "0000011110000001111110000110001100011000001100110000011001100000110010000011001100000110011000001100110000011001100000110"
'0000011110000000111110000110001100011000001100110000010001100000110011000011001100000110011000001100110000011001100000110
'0000000110000000011000000000110000000111100000011011000000000100000000011000000000110000000001100000000011000000000110000
C_char(1) = "0000000110000000011000000001110000001111100000011011000000000110000000011000000000110000000001100000000011000000000110000"
'0000000110000000011000000001110000001111100000010011000000000110000000011000000000110000000001100000000011000000000110000
'0000000110000000011000000001110000000111000000011011000000000110000000011000000000110000000001000000000011000000000110000
'0000000110000000011000000001110000000111100000011011000000000110000000011000000000110000000001100000000011000000000110000
'0000011110000001111110000110000110011000001100000000011000000000100000000011000000001100000000110000000011000000001100000
C_char(2) = "0000011110000001011110000110000110011000001100000000011000000000100000000011000000001100000000110000000011000000001100000"
'0000011110000001111110000010000110011000001100000000011000000000100000000011000000001100000000100000000011000000000000000
'0000011110000001111010000110000110011000001100000000011000000000100000000011000000001100000000010000000011000000001100000
C_char(3) = "0000011110000011111110000110001100011000011000000000110000000011000000011100000000111100000000011100000000011001000000110"
'0000011110000011111110000110001100011000011000000000110000000011000000011100000000111100000000011100000000000000000010110
'0000000011000000001100000000111000000001110000000111100000011011000001101100000110011000011000110001100001100011111111110
'0000000011000000001100000000011001000001110000000111100000011011000001101100000110011000011000110001100001100011111111110
C_char(4) = "1000000011000000011100001000111000010001110000000111100000011011000001101100000110011000111000110001100001100011111111110"
'0001111111100011111110000110000000001100000000110000001001101100000011111110001110000110000000001100000000011000000000110
C_char(5) = "0001111011100011111110000110010000001100000000110000000001100110000011111110001110000110000000001100000000011000000000110"
'0001111111100011111110000110000000011100000000110000000001101110000011111110001110000110000000001100000000011000000000110
C_char(6) = "0000011111000001111110000110001110001100001100100000000001101111000011111110000110001110011000001100110000011001100000110"
'1001111111100111111111000000000110000000011000000001100000000110000000001100000000110000000001000000000110000000001110000
'0001111111100111111111000000000110000000011000000001100000000111000000001100000000110000000001000000000110000000001100000
C_char(7) = "0001111111100011111110000000000000000000011000000001110000000110000000001100000000110000000001000000000110000000001100000"
'0001111111100111111111000000000110000000011000000001100000000110000000001100000000110000000001000000000110000000001100000
C_char(8) = "0000011110000011111110001110000110011000001100110000010001100001100001111110000001111000001100011000110000011001100000110"
'0000011110000011111110001110000110010000001100110000011001100001100001111110000011111100001100011100000000011001100000111
C_char(9) = "0000011110000001111110000111001100011000001100110000011001100000110011000011000110101100001111111000001101011000000000110"
'0000011110000001111110000110001100011000001100110000011001100000110011000011000110101110001111111100001101011000000000110
'0000011110000001111110000110001100011000001000110000011001100000100011000011000110001110001111111100001111011000000000110
Dim i As Integer
For i = 0 To UBound(C_char)
If C_char(i) <> "" Then
If bj(str, C_char(i)) Then
If i <= 9 Then '阀值，表示不匹配的点小于9
GetPixModNum = Chr(i + 48)
Else
GetPixModNum = Chr(i + 65 - 10)
End If
Exit Function
End If
End If
Next
End Function
'字符比较函数
Private Function bj(str As String, modstr As String, Optional rc As Integer = 10) 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
bj = False
Else
bj = True
End If
End Function
