*----------------
*!* Procedure Init
*----------------

Lparameters m.tcTable && курсор источник

With Thisform

    .txtINN.ControlSource = m.tcTable + ".INN"
    .txtName.ControlSource = m.tcTable + ".cName"

*!* и т.д.

    .cINN = Alltrim(.txtINN.Value) 

    .Poisk_Kontur() && сразу ищем в контуре, капча там не нужна 

    .GetCaptcha() && считываем капчу

Endwith


*----------------
*!* Procedure Poisk_Kontur
*----------------

With Thisform

    If Empty(.txtINN.Value)
        Return
    Endif

    .cServiceName = 'KONTUR.RU' && Поиск на контуре
    .cServiceURL = 'https://focus.kontur.ru' && сайт

    .Poisk()

Endwith


*----------------
*!* Procedure Poisk_Nalog
*----------------

With Thisform

    If Empty(.txtINN.Value)
        Return
    Endif

    .cServiceName = 'NALOG.RU' && имя сервиса
    .cServiceURL = 'http://egrul.nalog.ru' && сайт

    .Poisk()

Endwith


*----------------
*!* Procedure GetCaptcha
*----------------
* в основе код Евгения Банщикова (FoxClub.ru)

Local m.lOk, m.lcImgFile, m.lcTMP_DIR
m.lcTMP_DIR = Addbs(Sys(2023))
*!* m.lcImageFile = Addbs(Fullpath(''))+'def.png'
m.lcImageFile = m.lcTMP_DIR+'def.png'
m.lOk=.F.

With Thisform

    .oXMLHTTP = Createobject("MSXML2.XMLHTTP")

    With .oXMLHTTP

        .Open("GET", "http://egrul.nalog.ru/i/def.png")
        .setRequestHeader("Accept", "image/png,image/*;q=0.8,*/*;q=0.5")
        .setRequestHeader("Accept-Language", "ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3")
        .setRequestHeader("Accept-Encoding", "gzip, deflate")
        .setRequestHeader("Connection", "keep-alive")
        .Send()
        Wait Window " .. Ждите .. " Noclear Timeout 0.1
        Do While .readyState <> 4
            Wait Window " .. Ждите .. " Noclear Timeout 0.1
            DoEvents
        Enddo
        If .statustext = "OK"
            = Strtofile(.responseBody, m.lcImageFile)
            m.lOk = .T.
        Endif
        Wait Clear

    Endwith

    *!* если vfp7 и ниже - преобразуем картинку из PNG в JPG

    If Version(5)<=700

        Local loGP, lnH, lnB
        loGP = Newobject('GdiPlus','GdiPlus.PRG')

        With loGP
            .LoadFromFile(m.lcImageFile)
            lcImageFile = Forceext(m.lcImageFile,'jpg')
            lnH = .ImageHeight()
            lnB = .ImageWidth()
            .CopyToFile(m.lcImageFile, 100, m.lnb, m.lnh, 7)
        Endwith

    Endif

    Clear Resources

    .imgCaptcha.Picture = ""
    .imgCaptcha.Picture = m.lcImageFile
    .txtCaptcha.Value = ""

Endwith

Return m.lOk


*----------------
*!* Procedure GetHTML
*----------------
* в основе код Евгения Банщикова (FoxClub.ru)

Lparameters tcInn, tcCaptcha
Local lcParam, lOk
lOk = .F.

With Thisform

    Do Case

        Case .cServiceName = 'NALOG.RU'

            m.lcParam = ;
                [num=]+Alltrim(m.tcInn);
                +[&]+[Name=];
                +[&]+[address=];
                +[&]+[Region=%C2%F1%E5+%F1%F3%E1%FA%E5%EA%F2%FB+%D0%D4];
                +[&]+[Date=];
                +[&]+[action=%C8%F1%EA%E0%F2%FC];
                +[&]+[ccc=]+Alltrim(m.tcCaptcha) && редактировано 15.03.2012 

*!*                   +[&]+[cc=]+Alltrim(m.tcCaptcha) - поменяли имя поля

        Case .cServiceName = 'KONTUR.RU'
            m.lcParam = '/search?query='+Alltrim(m.tcInn);
                +[&]+[Region=]

    Endcase

    .oXMLHTTP = Createobject("MSXML2.XMLHTTP")

    With .oXMLHTTP

        If Thisform.cServiceName = 'KONTUR.RU'
            .Open("GET", Thisform.cServiceURL+m.lcParam)
            .setRequestHeader("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
            .setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
            .setRequestHeader("Accept-Language", "ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3")
            .setRequestHeader("Accept-Encoding", "gzip, deflate")
            .setRequestHeader("Connection", "keep-alive")
            .Send()
        Else
            .Open("POST", Thisform.cServiceURL)
            .setRequestHeader("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
            .setRequestHeader("Accept-Language", "ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3")
            .setRequestHeader("Accept-Encoding", "gzip, deflate")
            .setRequestHeader("Content-Type", "application/x-www-form-urlencoded")
            .setRequestHeader("Content-length", Transform(Len(m.lcParam)))
            .setRequestHeader("Connection", "keep-alive")
            .Send(m.lcParam)
        Endif

        Wait Window " .. Ждите .. " Noclear Timeout 0.1 && Без этого иногда намертво виснем
        Do While .readyState <> 4
            Wait Window " .. Ждите .. " Noclear Timeout 0.1
            DoEvents
        Enddo

        If .statustext = "OK"
            m.lOk=.T.
        Endif

    Endwith

Endwith

Return m.lOk


*!*           *----------------
*!*       Procedure Poisk()
*!*           *----------------
*!* в основе код Евгения Банщикова (FoxClub.ru)

Wait Window " Выполняется запрос .. ждите .. " Nowait Noclear
Local m.lcTable, m.lcBody, m.loHTML

Local m.lcINN, m.lcCaptcha
m.lcINN = Alltrim(.txtINN.Value)
m.lcCaptcha = Alltrim(.txtCaptcha.Value)

With Thisform

    .LockScreen=.T.

    If .GetHTML(m.lcINN, m.lcCaptcha)

        m.loHTML = Createobject('htmlfile')

        Do Case

            Case .cServiceName = 'NALOG.RU'
                *******************************
                m.lcBody = .oXMLHTTP.responseBody
                If m.Otladka
                    Local m.tmp_txt
                    m.tmp_txt = m.lcBody
                    =Strtofile(m.tmp_txt,"Nalog_ru.txt")
                Endif

                If [id="Result"]$m.lcBody
                    _Cliptext = m.lcBody
                    m.loHTML.Write(_Cliptext)
                    m.lcTable = loHTML.body.Document.getElementById('result')
                    .txtName.Value = m.lcTable.Rows(0).cells(1).innerTEXT
                    .txtAdres.Value = m.lcTable.Rows(1).cells(1).innerTEXT
                    .txtOGRN.Value = m.lcTable.Rows(2).cells(1).innerTEXT
                    .txtINN.Value = m.lcTable.Rows(3).cells(1).innerTEXT
                    .txtKPP.Value = m.lcTable.Rows(4).cells(1).innerTEXT
                Else
                    Messagebox('Не найдено или ошибка ввода Кода с картинки')
                Endif

                .GetCaptcha()

            Case .cServiceName = 'KONTUR.RU'
                ********************************
                m.lcBody = .oXMLHTTP.responseText
                If [class="search-result"]$m.lcBody
                    _Cliptext = m.lcBody
                    m.loHTML.Write(_Cliptext)
                    m.oResult = m.loHTML.body.Document.getElementsByTagName('li')
                    If m.oResult.Length > 0
                        For m.nIndex = 0 To m.oResult.Length-1
                            m.oRecv = m.oResult.Item(m.nIndex)
                            With m.oRecv
                                If Lower(.classname) == 'search-result'
                                    If '</B>'$Upper(.innerhtml) && Если выделено жирным
                                        Local m.lcHtmlFile
                                        m.lcHTMLFile = m.lcTmp_DIR+"html.txt"
                                        = Strtofile(.innerTEXT, m.lcHTMLFile)
                                        m.lcBody = Alltrim(Filetostr(m.lcHTMLFile))
                                        Do While(Isdigit(m.lcBody)) && Убираем порядковый номер
                                            m.lcBody = Substr(m.lcBody,2)
                                        Enddo
                                        Thisform.txtPrim.Value = Alltrim(m.lcBody)
                                    Endif
                                Endif
                            Endwith
                        Endfor
                    Endif
                Else
                    Messagebox('увы - запрос не правильный')
                Endif

        Endcase

    Endif

    Wait Clear

    .LockScreen=.F.

Endwith



*----------------
*!* Procedure Command1.Click && кнопка поиск
*----------------

With Thisform

    Local m.lcINN
    m.lcINN = Alltrim(.txtINN.Value)

    If Empty(m.lcINN)
        Messagebox("! Не указан ИНН для поиска ")
        Return
    Endif

    If !INN_Check(m.lcINN)
        Messagebox("! Некорректный ИНН")
        Return
    Endif

    If !.cINN == m.lcINN
        .cINN = m.lcINN
        .Poisk_Kontur() && поиск на сайте Контур
    Endif

    If !Empty(.txtCaptcha.Value)
        If Len(m.lcINN) # 10 && поиск только юрлиц
            Messagebox(" ! на сайте ФНС поиск только юридических лиц ")
            Return
        Else
            .Poisk_Nalog()
        Endif
    Endif

Endwith


*----------------
*!* Procedure INN_Check && тоже взято на Foxclub.ru
*----------------

lParameters tcINN
*!*   Проверка корректности ИНН
*!*   1. tcINN - Значение ИНН, которое необходимо проверить(символьного или числового типа)
*!*   !ВНИМАНИЕ !
*!*   В процессе выполнения функции значение параметров может меняться, поэтому
*!*   не следует использовать передачу параметров по ссылке
*!*   Возвращает .T. - если ИНН записаны корректно и .F. - если нет
*!*   Код программы написан на основе методики описанной по данному адресу
*!*   myriadsoftware.al.ru
*!*   Для справки: структура ИНН анализируемая данной программой
*!*   10-ти разрядный ИНН - NNNNXXXXXC
*!*   11-ти разрядный ИНН - FNNNNXXXXXC
*!*   12-ти разрядный ИНН - NNNNXXXXXXCC
*!*   где: NNNN - номер налоговой инспекции
*!*   XXXXX, XXXXXX - порядковый номер налогоплательщика
*!*   (номер записи в госреестре)
*!*   C - контрольное число в 10-ти разрядном ИНН
*!*   CC - контрольное число в 12-ти разрядном ИНН
*!*   (фактически, идущие подряд две контрольные цифры)
*!*   F - это буква (символ) "F", используется для иностранных организаций работающих в РФ
*!*   в остальном 11-ти разрядный ИНН полный аналог 10-ти разрядного ИНН

Local llIsCorrect
llIsCorrect = .T.
Do Case
    Case Type("tcINN")="N"
        ** tcINN=Ltrim(Str(m.tcINN,20))
        tcINN=Transform(m.tcINN)
    Case Type("tcINN")="C"
        tcINN=Alltrim(m.tcINN)
    Otherwise
        llIsCorrect = .F.
Endcase
* Проверка правильности длины ИНН (количества символов)
If m.llIsCorrect = .T.
    Do Case
        Case Len(m.tcINN)<=10
            tcINN=Padl(m.tcINN,10,"0")
        Case Len(m.tcINN)=11
            If Left(m.tcINN,1)="F"
                tcINN = Substr(m.tcINN,2,10)
            Else
                llIsCorrect = .F.
            Endif
        Case Len(m.tcINN)=12
        Otherwise
            llIsCorrect = .F.
    Endcase
Endif
* Проверка того, что ИНН состоит только из цифр
Local lnI
If m.llIsCorrect = .T.
    For lnI=1 To Len(m.tcINN)
        If Isdigit(Substr(m.tcINN,m.lnI,1))=.F.
            llIsCorrect = .F.
        Endif
    Endfor
Endif
* Весовые коэффициенты для ссответствующих символов в ИНН
Local la10(12), la11(12), la12(12)
Store 0 To m.la10, m.la11, m.la12
la10[1]=2
la10[2]=4
la10[3]=10
la10[4]=3
la10[5]=5
la10[6]=9
la10[7]=4
la10[8]=6
la10[9]=8

la11[1]=7
la11[2]=2
la11[3]=4
la11[4]=10
la11[5]=3
la11[6]=5
la11[7]=9
la11[8]=4
la11[9]=6
la11[10]=8

la12[1]=3
la12[2]=7
la12[3]=2
la12[4]=4
la12[5]=10
la12[6]=3
la12[7]=5
la12[8]=9
la12[9]=4
la12[10]=6
la12[11]=8
* Собственно расчет контрольных сумм
If m.llIsCorrect = .T.
    Local lnCheckSum10,lnCheckSum11,lnCheckSum12
    Store 0 To m.lnCheckSum10,m.lnCheckSum11,m.lnCheckSum12
    For lnI=1 To 12
        lnCheckSum10 = m.lnCheckSum10+la10[m.lnI]*Val(Substr(m.tcINN,m.lnI,1))
        lnCheckSum11 = m.lnCheckSum11+la11[m.lnI]*Val(Substr(m.tcINN,m.lnI,1))
        lnCheckSum12 = m.lnCheckSum12+la12[m.lnI]*Val(Substr(m.tcINN,m.lnI,1))
    Endfor
    lnCheckSum10 = Mod(Mod(m.lnCheckSum10,11),10)
    lnCheckSum11 = Mod(Mod(m.lnCheckSum11,11),10)
    lnCheckSum12 = Mod(Mod(m.lnCheckSum12,11),10)
    If Len(m.tcINN)=10 And m.lnCheckSum10<>Val(Right(m.tcINN,1)) Or ;
            LEN(m.tcINN)=12 And (m.lnCheckSum11<>Val(Substr(m.tcINN,11,1)) Or m.lnCheckSum12<>Val(Right(m.tcINN,1)))
        llIsCorrect = .F.
    Endif
Endif


Return m.llIsCorrect

       * запросить капчу, нарисовать ее на экране
       CASE m.l=="K"
            .imgCaptcha.Picture = ""  && сотрем предыдущий рисунок
            .TextCaptcha.Value  = EMPTYVAL(.TextCaptcha.Value)  && сотрем предыдущий код капчи

            m.h = SRAZDS("#ACCEPT=*", CHR(13),;  && [GET]. Запрашиваем любой вид данных (MIME */*)  "#ACCEPT=*"
                         "#OK=Body",;            && вернуть ResponseBody
                         "#NOK=Empty",;          && при неудаче вернуть ""
                         CVCT("#COOKIE=", m.c))  && если задан файл куков, то с поддержкой куков
*!*               m.h = SRAZDS(m.h, CHR(13),;  && отладочные файлы, чтобы смотреть страницу/ответ, которую послал сервер
*!*                            "#FileBody="+"D:\xxx_responsebody.txt",;
*!*                            "#FileText="+"D:\xxx_responsetext.txt")

            * Возвращает с сервера специфический код (СК) вида {"h":"0123456789abcdefgh"},
            * который нужно отправить обратно на сервер для получения рисунка
            m.s = OpenURL(m.u+"/",;              && оказывается слеш в конце - это обязательно!
                          m.h,;                  && заголовки запроса (список через ВК: имя=значение)
                          "r=new_captcha")       && параметры запроса (список через ВК: имя=значение)

            IF !GETWORDCOUNT(m.s, '"')=5  && ожидаем СК вышеуказанного вида...
               WAIT LEFT("Получен неверный код:"+CHR(13)+m.s, 250) WINDOW NOWAIT
               DO BEEPER WITH 3
            ELSE  && CR принят успешно
               m.s = GETWORDNUM(m.s, 4, '"')  && собственно СК, надо вернуть его на сервер побыстрее (timeout=5, max=100)
               m.h = SRAZDS("#IMAGE", CHR(13),;     && [GET]. Вернуть картинку (ResponseBody), или ""
                            CVCT("#COOKIE=", m.c))  && если задан файл куков, то с поддержкой куков
               m.x = OpenURL(m.u+"/",;  && оказывается слеш в конце - это обязательно!
                             m.h,;      && заголовки запроса (список через ВК: имя=значение)
                             SRAZDS("r=captcha", CHR(13),;   && параметры запроса (список через ВК: имя=значение)
                                    "h="+m.s))
               .imgCaptcha.PictureVal = m.x
               * картинку бы расшифровать... если суметь поделить картинку на цифры, и самообучающимся нейропроцессором...
               * или сканировать слева направо на предмет наличия цифры 0...9, отмечая координаты всплеска корреляции...
               * .TextCaptcha.Value  = РасшифровкаКапчи(m.x)
            ENDIF

m.u = ALLTRIM(m.parURL)  && например, egrul.nalog.ru
Do Case
   Case m.parName='NALOG.RU'
        m.u = SRAZDS(m.u, "/", "?r=search")  && URL, передаем-то методом POST, но в URL также указывается вот такой параметр запроса...
   
        m.h = SRAZDS("#POST", CHR(13),;  && посылаем методом POST
                     "#UTF-8=",;         && на этом сайте посылаем запрос БЕЗ [UTF8] кодирования... почему так... не понял
                     "#HTMLbody")        && Ожидаем HTML-контент, body - потому что сервер возвращает html с charset=1251, поэтому раскодировать ответ не надо (будем брать в ResponseBody)
        m.z = ""
        IF parПереданыПараметрыЗапроса
           m.z = SRAZDS('num='+ALLTRIM(m.parINN), CHR(13),;  && параметры формы (ИНН)
                       "captcha" + '=' + ALLTRIM(m.parCaptcha))  && почему-то меняют разработчики... было недавно cc, ccc ...
        ENDIF