Капча не была захвачена в VBA - PullRequest
Новая
       44

Капча не была захвачена в VBA

0 голосов
/ 19 апреля 2020

Мне трудно пройти через систему кодирования на этом веб-сайте. http://dgftebrc.nic.in: 8090 / MiscQry / Pan_index. jsp

Мне нужно ввести IEC кодов из листа Excel и введите код с картинки и извлеките таблицу на странице окончательного результата.

  1. 0913993340
  2. 0915011433
  3. 6315000983
  4. 3115906005

  5. 0411013530 

    Option Explicit
Public Sub IECsite()

Dim bot As WebDriver
'Dim VAL As String
Dim count As Long

Set bot = New WebDriver
bot.Start "chrome"
count = 1
While (Len(Range("A" & count)) > 0)

bot.Get "http://dgftebrc.nic.in:8090/MiscQry/Pan_index.jsp"

bot.FindElementById("panNo").SendKeys Range("A" & count)
'bot.FindElementById("captVal").SendKeys "L3oTtiM"
'VAL = InputBox("Enter the captcha value", "CAPTCHA", "")
'If VAL = vbNullString Then
'Exit Sub
'End If
'bot.FindElementById("captVal").SendKeys VAL
bot.Wait 10000

bot.FindElementById("submit").Click

Range("N" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[1]").Text
Range("O" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[2]").Text
Range("P" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[3]").Text
Range("Q" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[4]").Text
Range("R" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[5]").Text
Range("S" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[6]").Text
Range("T" & count) = bot.FindElementByXPath("//table[2]/tbody/tr[1]/td[7]").Text
count = count + 1

Wend
bot.Quit

End Sub

У меня есть 10-секундный интервал для ввода капчи вручную.

Пожалуйста, просмотрите ее и позвольте мне знать.

Image1

Любые идеи по извлечению этой таблицы, потому что, если я использую метод Xpath, я не могу взять всю таблицу сразу и необходимо написать длинный код, а главное - это будет утомительная работа для таблиц с несколькими строками.

ПРИМЕЧАНИЕ: - Эта таблица может состоять из более чем 1 строки (иногда 15 строк также)

Заранее спасибо.

enter image description here

Ответы [ 2 ]

2 голосов
/ 19 апреля 2020

Мне очень интересно посмотреть, сможете ли вы победить методологию капчи. Это не будет легко, и определенно НЕ легко с VBA. Весь смысл использования капч-системы состоит в том, чтобы установить тип теста «вызов-ответ-тест», чтобы определить, является ли пользователь человеком. Это все, что он делает, и делает это очень хорошо.

1 голос
/ 19 апреля 2020

Перед запуском кода необходимо сначала выполнить несколько шагов

** Установить Tesseract-OCR по ссылке: https://github.com/UB-Mannheim/tesseract/wiki Добавить путь tesseract к переменным среды Чтобы убедиться в правильности установки все в порядке, проверьте версию В PowerShell 

tesseract --version

** Установите ImageMagick по ссылке: https://www.imagemagick.org/script/download.php

Добавьте путь ImageMagick к переменным среды в командной строке запустите эти строки 

magick logo: logo.gif
magick identify logo.gif
magick logo.gif win:

** Откройте Windows PowerShell ISE, затем создайте новый файл и поместите эти строки (измените имя пользователя) 

cd C:\Users\YOURUSERNAME\Desktop
magick convert Captcha.png -resize 400x100 -density 300 -quality 100 CaptchaNew.png
magick convert CaptchaNew.png -negate -lat 300x160+30% -negate CaptchaNew.png
tesseract.exe CaptchaNew.png OutCaptcha -l eng

Наконец сохраните файл на рабочем столе с именем «GetCaptcha» и расширением будет ps1.

** PowerShell должен быть настроен для запуска сценариев из него, поэтому в PowerShell выполните эти команды 

Get-ExecutionPolicy
Set-ExecutionPolicy Unrestricted
Set-ExecutionPolicy -Scope CurrentUser -ExecutionPolicy ByPass -Force

Код 

Public Sub Test_IECsite()
Dim e, bot As WebDriver, tbl As Selenium.TableElement, dlg As alert, obj As Object, lr As Long

Set bot = New WebDriver

With bot
    .Start "Chrome"

    For Each e In Array("0915011433", "6315000983")
        .Window.Maximize

backP:
        .Get "http://dgftebrc.nic.in:8090/MiscQry/Pan_index.jsp"
        Set obj = .FindElementById("capt").TakeScreenshot(3000)
        obj.SaveAs (ThisWorkbook.Path + "\Captcha.png")

        .FindElementById("panNo").SendKeys e
        .FindElementById("captVal").SendKeys GetCaptcha
        .FindElementById("submit").Click

        Set dlg = .SwitchToAlert(Raise:=False)
        If Not dlg Is Nothing Then dlg.accept: GoTo backP
        Set tbl = .FindElementByXPath("/html/body/center/table[2]").AsTable

        With ThisWorkbook.Sheets("Sheet1")
            lr = .Cells(Rows.Count, 1).End(xlUp).Row
            If lr > 1 Then lr = lr + 2
            With .Range("A" & lr).Resize(, 2)
                .HorizontalAlignment = xlCenterAcrossSelection
                .Font.Color = vbBlue
            End With
            With .Range("A" & lr + 1).Resize(, 7)
                .Font.Bold = True
                .Font.Color = vbRed
            End With

            tbl.ToExcel .Range("A" & lr)
        End With
    Next e

    Stop
End With
End Sub

Function GetCaptcha() As String
Dim wshShell As Object, sOutput As String, strCommand As String

sOutput = ThisWorkbook.Path & "\OutCaptcha.txt"
strCommand = "Powershell.exe -File ""C:\Users\" & Application.UserName & "\Desktop\GetCaptcha.ps1"""
Set wshShell = CreateObject("WScript.Shell")
wshShell.Run strCommand, 0, True

GetCaptcha = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(sOutput).ReadAll, vbLf)(0)
End Function
...