- 帖子
- 219
- 主題
- 24
- 精華
- 0
- 積分
- 243
- 點名
- 0
- 作業系統
- Windows10
- 軟體版本
- Office2016
- 閱讀權限
- 20
- 性別
- 女
- 註冊時間
- 2012-4-18
- 最後登錄
- 2022-2-7
 
|
回復 7# GBKEE
關於圖形驗證Captcha的方式,這是joey0415提供得[參考]來源
看不懂^_^!! 但跑驗證碼是正確的- Public Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
- Public Declare Function CloseClipboard Lib "user32" () As Long
- Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
- Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
- Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
- Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
- Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
- '剪貼版資料格式定義
- Private Const CF_DIB = 8
- Sub 驗證碼識別()
- Dim a(1 To 4)
- Dim img '（驗證碼）圖片
- Dim CtrlRange '非文本物件集合
- Dim bytClipData() As Byte '定義位元組陣列
- Dim arr(0 To 1260)
- Dim ts As Integer
- On Error Resume Next
- Set Regedit_XG = CreateObject("WScript.Shell") '創建一個空的VBS"殼"
- Jz = Regedit_XG.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407") '讀取註冊表"安全設置-Internet區域"中的"允許對剪貼板進行編程訪問"設置(3＝禁用、0＝啟用、1＝提示)原始值
- Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", "0", "REG_DWORD" '修改註冊表"安全設置-Internet區域"中的"允許對剪貼板進行編程訪問"設置(3＝禁用、0＝啟用、1＝提示)，使系統默認為"允許訪問剪貼板"
- With CreateObject("InternetExplorer.application") '創建一個空的ie
- .Visible = True '讓ie可見
- .Navigate "http://119.145.135.38/fscx/web/loginForm.do" '導航到http://119.145.135.38/fscx/web/loginForm.do
- Do Until .ReadyState = 4 '等待ie完畢載入
- DoEvents
- Loop
- Set img = .Document.All.tags("img")(0) '指定（驗證碼）目標圖片
- Set CtrlRange = .Document.body.createControlRange() '創建非文本物件 ControlRange 集合
- CtrlRange.Add img '向非文本物件 ControlRange 集合中添加 img 物件
- CtrlRange.execCommand "Copy", True '從 ControlRange 集合中copy img 物件（圖片）到剪貼板
- Dim hMem As Long, lpData As Long
- OpenClipboard 0& '打開粘貼板
- hMem = GetClipboardData(8) '獲得粘貼板資料，指定格式為：CF_DIB = 8
- If CBool(hMem) Then
- lpData = GlobalLock(hMem) '鎖定記憶體物件hMen
- lClipSize = GlobalSize(hMem) '獲得粘貼板資料位元組數
- If lpData <> 0 And lClipSize > 0 Then
- ReDim bytClipData(0 To lClipSize - 1) As Byte '重新定義位元組陣列大小
- CopyMemory bytClipData(0), ByVal lpData, lClipSize '粘貼板轉化成位元組陣列
- End If
- GlobalUnlock hMem '解除鎖定記憶體物件hMen
- End If
- CloseClipboard '關閉粘貼板
- For i = 1 To 1260 '歸一化處理
- ts = (Val(bytClipData((i - 1) * 3 + 40)) + Val(bytClipData((i - 1) * 3 + 41)) + Val(bytClipData((i - 1) * 3 + 42))) / 3 '40是圖片開始位元組
- If ts > 150 Then
- ts = 0
- Else
- ts = 1
- End If
- arr(i) = ts
- Next i
- For i = 1 To 4
- a(i) = 0 '0
- If arr(13 * 60 + 8 + (i - 1) * 14) = 1 And arr(14 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 1: GoTo 1 '16位色，所以乘以"3"RGB各占一位元組，60是寬，14是字間距，
- If arr(4 * 60 + 6 + (i - 1) * 14) = 1 Then a(i) = 2: GoTo 1 '2
- If arr(16 * 60 + 11 + (i - 1) * 14) = 0 Then a(i) = 3: GoTo 1 '3
- If arr(7 * 60 + 5 + (i - 1) * 14) = 1 Then a(i) = 4: GoTo 1 '4
- If arr(12 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 5: GoTo 1 '5
- If arr(9 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 6: GoTo 1 '6
- If arr(16 * 60 + 13 + (i - 1) * 14) = 1 Then a(i) = 7: GoTo 1 '7
- If arr(10 * 60 + 8 + (i - 1) * 14) = 1 And arr(11 * 60 + 8 + (i - 1) * 14) = 1 Then a(i) = 8: GoTo 1 '8
- If arr(9 * 60 + 9 + (i - 1) * 14) = 1 Then a(i) = 9 '9
- 1:
- Next i
- Cells(1, 1) = a(1) & a(2) & a(3) & a(4) '識別後的驗證碼
- .Document.All.tags("INPUT")(0).Value = "1234567890" '填寫登錄名
- .Document.All.tags("INPUT")(1).Value = "0987654321" '填寫密 碼
- .Document.All.tags("INPUT")(2).Value = Cells(1, 1) '填寫驗證碼
- .Document.All.tags("img")(1).Click '點擊"登錄"按鈕
- '.Quit '關閉ie
- 'MsgBox "OK"
- End With
- Regedit_XG.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\3\1407", Jz, "REG_DWORD" '恢復註冊表"安全設置-Internet區域"中的"允許對剪貼板進行編程訪問"設置(3＝禁用、0＝啟用、1＝提示)原始值
- Set Regedit_XG = Nothing '釋放VBS"殼"
- End Sub
|
|
發表於 2013-9-28 18:41
| 
