Malicious Office (OOXML) / .XLSX — malware analysis report

Static analysis result for SHA-256 84a33da9a031f07e…

MALICIOUS

Office (OOXML) / .XLSX

880.7 KB Created: 2014-08-18 08:57:48 UTC Authoring application: Microsoft Excel 14.0300 First seen: 2026-06-28
MD5: 30e0aa80c353b661e2914054aedbbf02 SHA-1: 5fb01f5bb91395b1b2b7898625672425ca0715cf SHA-256: 84a33da9a031f07eabf7be4d849bb45ff07def350b2bb47bd10a7eba1890ded6
150 Risk Score

Heuristics 6

  • VBA project inside OOXML medium 4 related findings OOXML_VBA
    Document contains a VBA project — VBA macros present
  • CreateObject call high OLE_VBA_CREATEOBJ
    CreateObject call
    Matched line in script
      Set objASYNC_XMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
  • VBA polls global keyboard state (keylogger) high OLE_VBA_KEYLOGGER_SPYWARE
    The macro declares or calls a Win32 keystroke-monitoring API (GetAsyncKeyState, SetWindowsHookEx WH_KEYBOARD, or GetKeyboardState) to capture keystrokes system-wide. No legitimate document automation polls global key state; this is the core of a VBA keylogger, usually paired with active-window capture (GetForegroundWindow) and a log file. A high-confidence spyware behaviour independent of any download / Shell evidence.
    Matched line in script
      Private Declare PtrSafe Function SetWindowsHookEx Lib "User32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As Long
  • VBA p-code auto-exec with execution tokens high OLE_VBA_PCODE_AUTOEXEC_EXEC
    Triggers on the COMBINATION of two tokens co-occurring in the same compiled VBA/cache stream: an auto-execution entry point (Auto_Open / AutoOpen / Document_Open / Workbook_Open / Auto_Close / AutoClose) AND a shell/download/object-execution token (Shell, CreateObject, GetObject, PowerShell, cmd.exe, URLDownloadToFile, WinHttp, XMLHTTP, ADODB.Stream, ShellExecute, ExecuteExcel4Macro). Neither token alone fires it — it is the pairing that flags p-code-only or source-extraction-failure macro documents where the visible VBA source is unavailable. The matched tokens are named in the detail line below.
  • Workbook_Open macro low OLE_VBA_WBOPEN
    Workbook_Open macro
    Matched line in script
    Private Sub Workbook_Open()
  • Embedded URL info EMBEDDED_URL
    One or more URLs were extracted from the document. The URL itself is not a detection — see the per-URL labels for which channel (macro, JS, link annotation, document body, ...) reached each URL.
    URL https://eias.ru/procwsxls/ In document text (OOXML body / shared strings)
    • https://eias.fstrf.ru/disclo/get_file?p_guid=????????-????-????-????-In document text (OOXML body / shared strings)
    • https://eias.fstrf.ru/disclo/get_file?p_guid=In document text (OOXML body / shared strings)
    • https://portal.eias.ru/Portal/DownloadPage.aspx?type=12&guid=In document text (OOXML body / shared strings)
    • https://eias.fas.gov.ru/procwsxls/In document text (OOXML body / shared strings)
    • http://www.w3.org/1999/02/22-rdf-syntax-ns#In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/mm/In document text (OOXML body / shared strings)
    • http://ns.adobe.com/xap/1.0/sType/ResourceRef#In document text (OOXML body / shared strings)

Extracted artifacts 3

Files carved from inside the sample during analysis.

FilenameKindSourceSize
macros.bas vba-macro oletools.olevba.extract_macros (decoded VBA source from OOXML) 507226 bytes
SHA-256: 5eba94a7926a6106b0abc0ded975c90fe1d91775df4c5f5a3262d5d04dc40a00
Preview script
First 1,000 lines of the extracted script
Attribute VB_Name = "xlsBook"
Attribute VB_Base = "0{00020819-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  modThisWorkbook.Workbook_BeforeSave_Handler SaveAsUI, Cancel, Me

  On Error GoTo ErrHandler

  Dim status As Integer

''  status = Me.CustomDocumentProperties("Status")
''  If status > 2 Then
''    MsgBox "Документ подписан ЭЦП и не может быть изменен", vbExclamation + vbOKOnly, ThisWorkbook.name
''    Cancel = True
''    Exit Sub
''  End If

  Exit Sub

ErrHandler:
  MsgBox err.Description, vbOKOnly + vbExclamation, ThisWorkbook.name
End Sub

Private Sub Workbook_Open()
  modThisWorkbook.Workbook_Open_Handler Me
End Sub

Attribute VB_Name = "modHTTP"
Attribute VB_Base = "0{00020820-0000-0000-C000-000000000046}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = True
Option Explicit
Option Base 1

Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_NAME As String = "MO_REESTR?"
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_2 As String = "p_TC="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_3 As String = "P_OPTIONS="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_4 As String = "P_MO_START_DATE="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_5 As String = "P_MO_END_DATE="

Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_NAME As String = "MO_REESTR_RI?"
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_2 As String = "p_TC="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_3 As String = "P_SPHERE="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_4 As String = "P_ORG="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_5 As String = "P_INN="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_6 As String = "P_KPP="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_7 As String = "P_PRD="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_8 As String = "P_FIL="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_9 As String = "P_EXTENDED_INFO="
Const STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_10 As String = "P_OPTIONS="

Const STR_HTTP_REQUEST_PROC_ORG_FULL As String = "ORG_REESTR?"
Const STR_HTTP_REQUEST_PROC_ORG_FULL_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_2 As String = "p_AS="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_3 As String = "p_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_4 As String = "p_TC="

Const STR_HTTP_REQUEST_PROC_ORG_FULL_OWNER As String = "ORG_REESTR_OWNER?"
Const STR_HTTP_REQUEST_PROC_ORG_FULL_OWNER_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_OWNER_2 As String = "p_AS="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_OWNER_3 As String = "p_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_FULL_OWNER_4 As String = "p_TC="

Const STR_HTTP_REQUEST_PROC_ORG_STAT As String = "ORG_STAT_REESTR?"
Const STR_HTTP_REQUEST_PROC_ORG_STAT_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_STAT_2 As String = "p_TC="

' реестр новый (Жуков Д. 28.01.2016)
Const STR_HTTP_REQUEST_PROC_ORG_REDU As String = "ORG_REESTR_FULL_REDUCED?"
Const STR_HTTP_REQUEST_PROC_ORG_REDU_1 As String = "P_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_2 As String = "P_AS="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_3 As String = "P_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_4 As String = "P_INCL_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_5 As String = "P_ORG_START_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_6 As String = "P_ORG_END_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_7 As String = "P_VDET_START_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_8 As String = "P_VDET_END_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_REDU_9 As String = "P_TC="

Const STR_HTTP_REQUEST_PROC_ORG_ENER As String = "ORG_EE_REESTR?"
Const STR_HTTP_REQUEST_PROC_ORG_ENER_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_ENER_2 As String = "p_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_ENER_3 As String = "p_TC="

' любые данные
Const STR_HTTP_REQUEST_PROC_GET_DATA As String = "GET_DATA?"
Const STR_HTTP_REQUEST_PROC_GET_DATA_1 As String = "p_DATA_TYPE="
Const STR_HTTP_REQUEST_PROC_GET_DATA_2 As String = "p_TC="

' реестр настроек (Неустроева Е. 06.10.2014)
Const STR_HTTP_REQUEST_PROC_GET_DATA_SET_NAME As String = "GET_SETTINGS?"
Const STR_HTTP_REQUEST_PROC_GET_DATA_SET_1 As String = "P_PROC_NAME="
Const STR_HTTP_REQUEST_PROC_GET_DATA_SET_2 As String = "P_NSRF="
Const STR_HTTP_REQUEST_PROC_GET_DATA_SET_3 As String = "P_TC="

' реестр тарифов
Const STR_HTTP_REQUEST_PROC_GET_VT As String = "OPEN_INFO_VT?"
Const STR_HTTP_REQUEST_PROC_GET_VT_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_GET_VT_2 As String = "p_SP="
Const STR_HTTP_REQUEST_PROC_GET_VT_3 As String = "p_TC="

' реестр видов деятельности
Const STR_HTTP_REQUEST_PROC_GET_VED As String = "OPEN_INFO_VED?"
Const STR_HTTP_REQUEST_PROC_GET_VED_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_GET_VED_2 As String = "p_SP="
Const STR_HTTP_REQUEST_PROC_GET_VED_3 As String = "p_TC="

' для обновления шаблона
Const STR_HTTP_REQUEST_PROC_NSRF As String = "p_NSRF="

'Описание територии
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS As String = "GET_DATA_OPEN_PRICE?"
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_2 As String = "p_TC="
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_3 As String = "p_INN="
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_4 As String = "p_KPP="
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_5 As String = "p_PRD="
Const STR_HTTP_REQUEST_PROC_GET_DS_CHS_6 As String = "p_DT="

'URL
Const STR_HTTP_REQUEST_PROC_GET_URL As String = "GET_DATA_URL?"

' реестр резрешенных ссылок для доков
Const STR_HTTP_REQUEST_PROC_GET_LINK As String = "GET_ALLOW_LINK?"
Const STR_HTTP_REQUEST_PROC_GET_LINK_1 As String = "p_NSRF="
Const STR_HTTP_REQUEST_PROC_GET_LINK_2 As String = "p_TC="

' реестр новый (Жуков Д. 28.01.2016)
Const STR_HTTP_REQUEST_PROC_ORG_NAME As String = "ORG_REESTR_FULL?"
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_1 As String = "P_NSRF="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_2 As String = "P_AS="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_3 As String = "P_VDET="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_4 As String = "P_ORG_START_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_5 As String = "P_ORG_END_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_6 As String = "P_VDET_START_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_7 As String = "P_VDET_END_DATE="
Const STR_HTTP_REQUEST_PROC_ORG_PARAM_8 As String = "P_TC="
''
''' получить файл (AnnSOBR, 02.06.2016)
''Const STR_HTTP_REQUEST_PROC_GET_FILE_SET_NAME As String = "GET_FILE?"
''Const STR_HTTP_REQUEST_PROC_GET_FILE_SET_1 As String = "P_NSRF="
''Const STR_HTTP_REQUEST_PROC_GET_FILE_SET_2 As String = "P_TYPE="
''Const STR_HTTP_REQUEST_PROC_GET_FILE_SET_3 As String = "P_TC="

Private rowCount As Long, colCount As Long

Public Property Get STR_HTTP_REQUEST_BASE_URL(lngNum As Long) As String
  If lngNum = 1 Then STR_HTTP_REQUEST_BASE_URL = "https://eias.ru/procwsxls/"
  If lngNum = 2 Then STR_HTTP_REQUEST_BASE_URL = "https://eias.fas.gov.ru/procwsxls/"
End Property

Public Property Get STR_REESTR_TYPE() As String
  STR_REESTR_TYPE = "REDU_N"
End Property

Public Property Get STR_ACTIVITY_SPHERE() As String
  STR_ACTIVITY_SPHERE = "WARM"
End Property

Public Property Get STR_REESTR_MR_MO_TYPE() As String
  STR_REESTR_MR_MO_TYPE = "MRMO"
End Property

Public Property Get STR_URL_FOR_PRINT_FORM(strProcName As String) As String
  STR_URL_FOR_PRINT_FORM = STR_HTTP_REQUEST_PROC_GET_DATA_SET_NAME & _
                           STR_HTTP_REQUEST_PROC_GET_DATA_SET_1 & strProcName & "&" & _
                           STR_HTTP_REQUEST_PROC_GET_DATA_SET_2 & ThisWorkbook.Names("region_name").RefersToRange.value & "&" & _
                           STR_HTTP_REQUEST_PROC_GET_DATA_SET_3 & modServiceModule.varGetDocumentProperty(ThisWorkbook, "Version")
End Property


' Выгрузка данных
Public Function Get_Data(strTypeData As String, _
                         ByRef ArrOut() As Variant, _
                         ByVal blnRegionalServer As Boolean, _
                         ParamArray ArrParams()) As String

  On Error GoTo ErrHandler

  Dim strUrl As String, strTemplateCode As String, strParam As String
  Dim lngI As Long

  Dim wbBook As Workbook
  
  Dim strORG_SD As String
  Dim strORG_ED As String
  Dim strVDET_SD As String
  Dim strVDET_ED As String
  
  Set wbBook = ThisWorkbook
  
  strTemplateCode = modServiceModule.varGetDocumentProperty(wbBook, "Version")
          
  strORG_SD = wbBook.Names("ORG_START_DATE").RefersToRange.cells(1, 1).value
  strORG_ED = wbBook.Names("ORG_END_DATE").RefersToRange.cells(1, 1).value
  strVDET_SD = wbBook.Names("VDET_START_DATE").RefersToRange.cells(1, 1).value
  strVDET_ED = wbBook.Names("VDET_END_DATE").RefersToRange.cells(1, 1).value
  
  Select Case strTypeData
    Case "ORG"
      Select Case modHTTP.STR_REESTR_TYPE
        Case "FULL"
          strUrl = STR_HTTP_REQUEST_PROC_ORG_FULL & _
                   STR_HTTP_REQUEST_PROC_ORG_FULL_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_FULL_2 & ArrParams(1) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_FULL_3 & ArrParams(2) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_FULL_4 & strTemplateCode
        Case "FULL_OWNER"
  '================================================================
          strUrl = STR_HTTP_REQUEST_PROC_ORG_NAME & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_2 & ArrParams(1) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_3 & ArrParams(2) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_4 & strORG_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_5 & strORG_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_6 & strVDET_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_7 & strVDET_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_PARAM_8 & strTemplateCode
  '================================================================
        Case "REDU_Y"
          strUrl = STR_HTTP_REQUEST_PROC_ORG_REDU & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_2 & ArrParams(1) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_3 & ArrParams(2) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_4 & "YES" & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_5 & strORG_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_6 & strORG_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_7 & strVDET_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_8 & strVDET_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_9 & strTemplateCode
        Case "REDU_N"
          strUrl = STR_HTTP_REQUEST_PROC_ORG_REDU & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_2 & ArrParams(1) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_3 & ArrParams(2) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_4 & "NO" & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_5 & strORG_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_6 & strORG_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_7 & strVDET_SD & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_8 & strVDET_ED & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_REDU_9 & strTemplateCode
        Case "STAT"
          strUrl = STR_HTTP_REQUEST_PROC_ORG_STAT & _
                   STR_HTTP_REQUEST_PROC_ORG_STAT_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_STAT_2 & strTemplateCode
        Case "ENER"
          strUrl = STR_HTTP_REQUEST_PROC_ORG_ENER & _
                   STR_HTTP_REQUEST_PROC_ORG_ENER_1 & ArrParams(0) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_ENER_2 & ArrParams(2) & "&" & _
                   STR_HTTP_REQUEST_PROC_ORG_ENER_3 & strTemplateCode
        Case Else
          GoTo ErrHandler
      End Select
      
    Case "MRMO"
      strUrl = STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_NAME & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_1 & ArrParams()(0) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_2 & strTemplateCode & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_3 & modHTTP.STR_ACTIVITY_SPHERE & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_4 & ArrParams()(1) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_5 & ArrParams()(2) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_6 & ArrParams()(3) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_7 & ArrParams()(4) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_8 & ArrParams()(5) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_PARAM_10 & ""
      Debug.Print strUrl
      
    Case "MRMO_ALL"
      strUrl = STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_NAME & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_1 & ArrParams()(0) & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_2 & strTemplateCode & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_3 & "" & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_4 & strORG_SD & "&" & _
               STR_HTTP_REQUEST_PROC_MR_MO_OKTMO_ALL_PARAM_5 & strORG_ED
    
    Case "ORGS_DATA"
      strUrl = STR_HTTP_REQUEST_PROC_GET_DATA & _
               STR_HTTP_REQUEST_PROC_GET_DATA_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_DATA_2 & strTemplateCode
               
    ' считывание настроек (Неустроева Е. 06.10.2015)
    Case "GET_SETTINGS"
      strUrl = STR_HTTP_REQUEST_PROC_GET_DATA_SET_NAME & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_2 & ArrParams(1) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_3 & strTemplateCode
                         
    Case "VT"
      strUrl = STR_HTTP_REQUEST_PROC_GET_VT & _
               STR_HTTP_REQUEST_PROC_GET_VT_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_VT_2 & ArrParams(1) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_VT_3 & strTemplateCode
    
    Case "VED"
      strUrl = STR_HTTP_REQUEST_PROC_GET_VED & _
               STR_HTTP_REQUEST_PROC_GET_VED_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_VED_2 & ArrParams(1) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_VED_3 & strTemplateCode
               
    Case "URL"
      strUrl = STR_HTTP_REQUEST_PROC_GET_URL & _
               STR_HTTP_REQUEST_PROC_NSRF & ArrParams(0)
             
    Case "LINK"
      strUrl = STR_HTTP_REQUEST_PROC_GET_LINK & _
               STR_HTTP_REQUEST_PROC_GET_LINK_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_LINK_2 & strTemplateCode

    Case "DS"
        strUrl = STR_HTTP_REQUEST_PROC_GET_DS_CHS & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_1 & ArrParams(0) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_2 & strTemplateCode & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_3 & ArrParams(1) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_4 & ArrParams(2) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_5 & ArrParams(3) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_6 & strTypeData
                 
    Case "CHS"
        strUrl = STR_HTTP_REQUEST_PROC_GET_DS_CHS & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_1 & ArrParams(0) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_2 & strTemplateCode & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_3 & ArrParams(1) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_4 & ArrParams(2) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_5 & ArrParams(3) & "&" & _
                 STR_HTTP_REQUEST_PROC_GET_DS_CHS_6 & strTypeData
    
    Case "GET_FILE"
      strUrl = STR_HTTP_REQUEST_PROC_GET_DATA_SET_NAME & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_1 & ArrParams(0) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_2 & ArrParams(1) & "&" & _
               STR_HTTP_REQUEST_PROC_GET_DATA_SET_3 & strTemplateCode
    Case Else
      GoTo ErrHandler
  End Select

  Get_Data = modHTTP.strQuery_Data(strUrl, ArrOut, blnRegionalServer)

  GoTo CleanUp

ErrHandler:
  Get_Data = STR_UPDATE_FAILED

CleanUp:
End Function

Public Function strQuery_Data(strUrl As String, ByRef ArrOut() As Variant, blnRegionalServer As Boolean) As String

  Dim strBaseURL() As String
  Dim xmlContent As String
  Dim lngICounter As Long
  Dim lngRequestCounter As Long
  Dim strPassErrs() As String

  Dim saxReader As New SAXXMLReader30
  Dim saxHandler As New ISAXHandler

  On Error GoTo ErrHandler

  ' Check Internet Connection Status
  If Not modInternetConnectionState.blnIsOnLine Then GoTo Offline

  strQuery_Data = vbNullString

  If blnRegionalServer And modServiceModule.IsNameExists(ThisWorkbook, STR_URL_NAME) Then
    If ThisWorkbook.Names(STR_URL_NAME).RefersToRange.Value2 <> "" Then
      ReDim strBaseURL(1 To 1)
      strBaseURL(1) = ThisWorkbook.Names(STR_URL_NAME).RefersToRange.Value2
    Else
      ReDim strBaseURL(1 To 2)
      strBaseURL(1) = modHTTP.STR_HTTP_REQUEST_BASE_URL(1)
      strBaseURL(2) = modHTTP.STR_HTTP_REQUEST_BASE_URL(2)
    End If
  Else
    ReDim strBaseURL(1 To 2)
    strBaseURL(1) = modHTTP.STR_HTTP_REQUEST_BASE_URL(1)
    strBaseURL(2) = modHTTP.STR_HTTP_REQUEST_BASE_URL(2)
  End If

  Set saxReader.contentHandler = saxHandler

  For lngRequestCounter = LBound(strBaseURL) To UBound(strBaseURL)

    On Error GoTo TryNextDNS

    rowCount = 0
    colCount = 0
    xmlContent = strLoad_XML(strBaseURL(lngRequestCounter) & strUrl)

    If colCount > 0 Then

      saxHandler.InitData rowCount, colCount
      saxReader.Parse xmlContent

      If saxHandler.GetStatus Then
        Exit For
      Else
        GoTo TryNextDNS
      End If

    End If

    GoTo Success

TryNextDNS:
    If lngRequestCounter = UBound(strBaseURL) Then GoTo ErrHandler
  Next lngRequestCounter

Success:
  On Error GoTo ErrHandler
  If colCount > 0 Then ArrOut = saxHandler.GetData
  strQuery_Data = STR_UPDATE_SUCCESS
  GoTo CleanUp

ErrHandler:
  strQuery_Data = STR_UPDATE_FAILED
  GoTo CleanUp

Offline:
  strQuery_Data = STR_INET_CONNECTION_IS_OFFLINE

CleanUp:
  Set saxHandler = Nothing
  Set saxReader = Nothing
End Function

Public Function strLoad_XML(strUrl As String) As String
  Dim strPassErrs() As String
  Dim GMT_Time$, m$, mv$
  On Error GoTo ErrHandler
  
  Debug.Print strUrl

  Dim objXMLHTTP As New MSXML2.XMLHTTP30
  Dim objXMLDOMDocument As MSXML2.DOMDocument30
  If frmProgressForm Is Nothing Then
    objXMLHTTP.Open "GET", strUrl, False
    objXMLHTTP.send
  Else
    objXMLHTTP.Open "GET", strUrl, True
    objXMLHTTP.send
    Do While objXMLHTTP.readyState <> 4
      frmProgressForm.ProgressTick
    Loop

  End If

  ' получим данные по текущей дате
  GMT_Time = objXMLHTTP.getResponseHeader("Date")
  If Not (GMT_Time Like "???, *# ??? #### ##:##:##*GMT*") Then
    GMT_Time = Date
  Else
    GMT_Time = Trim(Split(GMT_Time, ",")(1))
    GMT_Time = Trim(Split(GMT_Time, "GMT")(0))
    m$ = Trim(Split(GMT_Time)(1))
    mv$ = (InStr(1, "janfebmaraprmayjunjulaugsepoctnovdec", m$, vbTextCompare) + 2) / 3
    GMT_Time = Replace(GMT_Time, " " & m$ & " ", "." & Format(mv$, "00") & ".")
 
    GMT_Time = CDate(GMT_Time) + val(8) / 24
    TEHSHEET.Range("CURRENT_DATE").cells.value = CStr(GMT_Time)
  End If

  Set objXMLDOMDocument = objXMLHTTP.responseXML
  rowCount = objXMLDOMDocument.DocumentElement.ChildNodes.Length
  If rowCount > 0 Then colCount = objXMLDOMDocument.DocumentElement.ChildNodes.Item(0).ChildNodes.Length
  strLoad_XML = objXMLDOMDocument.XML

  GoTo CleanUp

ErrHandler:
  err.Raise err.Number
CleanUp:
  Set objXMLDOMDocument = Nothing
  Set objXMLHTTP = Nothing
End Function

Attribute VB_Name = "cHandleEvents"
Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_TemplateDerived = False
Attribute VB_Customizable = False
Option Explicit

Private WithEvents ptb As MSForms.TextBox
Attribute ptb.VB_VarHelpID = -1
Public strWSName As String

Public Property Set Control(p As MSForms.TextBox)
  Set ptb = p
End Property

Public Property Get Control() As Control
  Set Control = ptb
End Property

Private Sub ptb_Change()
''  modfrmReestr.FilterRange
  ThisWorkbook.Worksheets(strWSName).FilterRange
End Sub

Attribute VB_Name = "modInternetConnectionState"
Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

#If VBA7 And Win64 Then
Private Declare PtrSafe Function InternetGetConnectedState Lib "wininet" _
  (ByRef dwFlags As Long, _
   ByVal dwReserved As Long) As Long
#Else
Private Declare Function InternetGetConnectedState Lib "wininet" _
  (ByRef dwFlags As Long, _
   ByVal dwReserved As Long) As Long
#End If

' Local system uses a modem to connect to the Internet.
Private Const INTERNET_CONNECTION_MODEM As Long = &H1

' Local system uses a LAN to connect to the Internet.
Private Const INTERNET_CONNECTION_LAN As Long = &H2

' Local system uses a proxy server to connect to the Internet.
Private Const INTERNET_CONNECTION_PROXY As Long = &H4

' No longer used.
Private Const INTERNET_CONNECTION_MODEM_BUSY As Long = &H8

Private Const INTERNET_RAS_INSTALLED As Long = &H10
Private Const INTERNET_CONNECTION_OFFLINE As Long = &H20
Private Const INTERNET_CONNECTION_CONFIGURED As Long = &H40

Public Function blnIsOnLine() As Boolean
  If strGetNetConnectString = "Not connected to the internet now." Then
    blnIsOnLine = False
  Else
    blnIsOnLine = True
  End If
End Function

Private Function blnIsNetConnectViaLAN() As Boolean

  Dim dwFlags As Long
   
  ' pass an empty variable into which the API will
  ' return the flags associated with the connection
  Call InternetGetConnectedState(dwFlags, 0&)

  ' return True if the flags indicate a LAN connection
  blnIsNetConnectViaLAN = dwFlags And INTERNET_CONNECTION_LAN
     
End Function

Private Function blnIsNetConnectViaModem() As Boolean

  Dim dwFlags As Long
   
  ' pass an empty variable into which the API will
  ' return the flags associated with the connection
  Call InternetGetConnectedState(dwFlags, 0&)

  ' return True if the flags indicate a modem connection
  blnIsNetConnectViaModem = dwFlags And INTERNET_CONNECTION_MODEM
     
End Function

Private Function blnIsNetConnectViaProxy() As Boolean

  Dim dwFlags As Long
   
  ' pass an empty variable into which the API will
  ' return the flags associated with the connection
  Call InternetGetConnectedState(dwFlags, 0&)

  ' return True if the flags indicate a proxy connection
  blnIsNetConnectViaProxy = dwFlags And INTERNET_CONNECTION_PROXY
     
End Function

Private Function IsNetConnectOnline() As Boolean

  ' no flags needed here - the API returns True
  ' if there is a connection of any type
  IsNetConnectOnline = InternetGetConnectedState(0&, 0&)
     
End Function

Private Function blnIsNetRASInstalled() As Boolean

  Dim dwFlags As Long
   
  ' pass an empty variable into which the API will
  ' return the flags associated with the connection
  Call InternetGetConnectedState(dwFlags, 0&)

  ' return True if the flags include RAS installed
  blnIsNetRASInstalled = dwFlags And INTERNET_RAS_INSTALLED
     
End Function

Private Function strGetNetConnectString() As String

   Dim dwFlags As Long
   Dim strMsg As String

   ' Build a string for display
   If InternetGetConnectedState(dwFlags, 0&) Then
     
      If dwFlags And INTERNET_CONNECTION_CONFIGURED Then
         strMsg = strMsg & "You have a network connection configured." & vbCrLf
      End If

      If dwFlags And INTERNET_CONNECTION_LAN Then
         strMsg = strMsg & "The local system connects to the Internet via a LAN"
      End If
      
      If dwFlags And INTERNET_CONNECTION_PROXY Then
         strMsg = strMsg & ", and uses a proxy server. "
      Else
         strMsg = strMsg & "."
      End If
      
      If dwFlags And INTERNET_CONNECTION_MODEM Then
         strMsg = strMsg & "The local system uses a modem to connect to the Internet. "
      End If
      
      If dwFlags And INTERNET_CONNECTION_OFFLINE Then
         strMsg = strMsg & "The connection is currently offline. "
      End If
      
      If dwFlags And INTERNET_CONNECTION_MODEM_BUSY Then
         strMsg = strMsg & "The local system's modem is busy with a non-Internet connection. "
      End If
      
      If dwFlags And INTERNET_RAS_INSTALLED Then
         strMsg = strMsg & "Remote Access Services are installed on this system."
      End If
      
   Else
    
      strMsg = "Not connected to the internet now."
      
   End If
   
   strGetNetConnectString = strMsg

End Function

Attribute VB_Name = "modUpd_Templ_HTTP_Request"
Option Explicit
Option Base 1

' === These constants and corresponding values indicate HTTP status codes returned by servers on the Internet. ===
Public Const HTTP_STATUS_CONTINUE As Long = 100  ' The request can be continued.
Public Const HTTP_STATUS_SWITCH_PROTOCOLS As Long = 101  ' The server has switched protocols in an upgrade header.
Public Const HTTP_STATUS_OK As Long = 200                 ' The request completed successfully.
Public Const HTTP_STATUS_CREATED As Long = 201  ' The request has been fulfilled and resulted in the creation of a new resource.
Public Const HTTP_STATUS_ACCEPTED As Long = 202  ' The request has been accepted for processing, but the processing has not been completed.
Public Const HTTP_STATUS_PARTIAL As Long = 203  ' The returned meta information in the entity-header is not the definitive set available from the originating server.
Public Const HTTP_STATUS_NO_CONTENT As Long = 204  ' The server has fulfilled the request, but there is no new information to send back.
Public Const HTTP_STATUS_RESET_CONTENT As Long = 205  ' The request has been completed, and the client program should reset the document view that caused the request to be sent to allow the user to easily initiate another input action.
Public Const HTTP_STATUS_PARTIAL_CONTENT As Long = 206  ' The server has fulfilled the partial GET request for the resource.
Public Const HTTP_STATUS_WEBDAV_MULTI_STATUS As Long = 207  ' During a World Wide Web Distributed Authoring and Versioning (WebDAV) operation, this indicates multiple status codes for a single response. The response body contains Extensible Markup Language (XML) that describes the status codes. For more information, see HTTP Extensions for Distributed Authoring.
Public Const HTTP_STATUS_AMBIGUOUS As Long = 300  ' The requested resource is available at one or more locations.
Public Const HTTP_STATUS_MOVED As Long = 301                 ' The requested resource has been assigned to a new permanent Uniform Resource Identifier (URI), and any future references to this resource should be done using one of the returned URIs.
Public Const HTTP_STATUS_REDIRECT As Long = 302  ' The requested resource resides temporarily under a different URI.
Public Const HTTP_STATUS_REDIRECT_METHOD As Long = 303  ' The response to the request can be found under a different URI and should be retrieved using a GET HTTP verb on that resource.
Public Const HTTP_STATUS_NOT_MODIFIED As Long = 304  ' The requested resource has not been modified.
Public Const HTTP_STATUS_USE_PROXY As Long = 305  ' The requested resource must be accessed through the proxy given by the location field.
Public Const HTTP_STATUS_REDIRECT_KEEP_VERB As Long = 307  ' The redirected request keeps the same HTTP verb. HTTP/1.1 behavior.
Public Const HTTP_STATUS_BAD_REQUEST As Long = 400  ' The request could not be processed by the server due to invalid syntax.
Public Const HTTP_STATUS_DENIED As Long = 401  ' The requested resource requires user authentication.
Public Const HTTP_STATUS_PAYMENT_REQ As Long = 402  ' Not implemented in the HTTP protocol.
Public Const HTTP_STATUS_FORBIDDEN As Long = 403  ' The server understood the request, but cannot fulfill it.
Public Const HTTP_STATUS_NOT_FOUND As Long = 404  ' The server has not found anything that matches the requested URI.
Public Const HTTP_STATUS_BAD_METHOD As Long = 405  ' The HTTP verb used is not allowed.
Public Const HTTP_STATUS_NONE_ACCEPTABLE As Long = 406  ' No responses acceptable to the client were found.
Public Const HTTP_STATUS_PROXY_AUTH_REQ As Long = 407  ' Proxy authentication required.
Public Const HTTP_STATUS_REQUEST_TIMEOUT As Long = 408  ' The server timed out waiting for the request.
Public Const HTTP_STATUS_CONFLICT As Long = 409  ' The request could not be completed due to a conflict with the current state of the resource. The user should resubmit with more information.
Public Const HTTP_STATUS_GONE As Long = 410                 ' The requested resource is no longer available at the server, and no forwarding address is known.
Public Const HTTP_STATUS_LENGTH_REQUIRED As Long = 411  ' The server cannot accept the request without a defined content length.
Public Const HTTP_STATUS_PRECOND_FAILED As Long = 412  ' The precondition given in one or more of the request header fields evaluated to false when it was tested on the server.
Public Const HTTP_STATUS_REQUEST_TOO_LARGE As Long = 413  ' The server cannot process the request because the request entity is larger than the server is able to process.
Public Const HTTP_STATUS_URI_TOO_LONG As Long = 414  ' The server cannot service the request because the request URI is longer than the server can interpret.
Public Const HTTP_STATUS_UNSUPPORTED_MEDIA As Long = 415  ' The server cannot service the request because the entity of the request is in a format not supported by the requested resource for the requested method.
Public Const HTTP_STATUS_RETRY_WITH As Long = 449  ' The request should be retried after doing the appropriate action.
Public Const HTTP_STATUS_SERVER_ERROR As Long = 500  ' The server encountered an unexpected condition that prevented it from fulfilling the request.
Public Const HTTP_STATUS_NOT_SUPPORTED As Long = 501  ' The server does not support the functionality required to fulfill the request.
Public Const HTTP_STATUS_BAD_GATEWAY As Long = 502  ' The server, while acting as a gateway or proxy, received an invalid response from the upstream server it accessed in attempting to fulfill the request.
Public Const HTTP_STATUS_SERVICE_UNAVAIL As Long = 503  ' The service is temporarily overloaded.
Public Const HTTP_STATUS_GATEWAY_TIMEOUT As Long = 504  ' The request was timed out waiting for a gateway.
Public Const HTTP_STATUS_VERSION_NOT_SUP As Long = 505  ' The server does not support the HTTP protocol version that was used in the request message.

' ===================================================
' ===================================================

Private objASYNC_XMLHTTP As MSXML2.XMLHTTP
Private objASYNC_XMLDOMDocument As MSXML2.DOMDocument
Private lngASYNC_Attempt As Long
Private tviASYNC_Result As TVersionInfo
Private strASYNC_URL As String
Private strASYNC_BaseURL() As String
Private strASYNC_XMLTagNames() As String
Private lngASYNC_RequestCounter As Long

' ===================================================
' ===================================================

Private Function GET_TEMPLATE_CODE() As String
  
  On Error GoTo ErrHandler
  
  GET_TEMPLATE_CODE = ThisWorkbook.CustomDocumentProperties("Version").value

  GoTo CleanUp
  
ErrHandler:
  GoTo CleanUp
CleanUp:
End Function

Private Function GET_TEMPLATE_VERSION() As String
  
  On Error GoTo ErrHandler
  
  GET_TEMPLATE_VERSION = ThisWorkbook.CustomDocumentProperties("CurrentVersion").value

  GoTo CleanUp
  
ErrHandler:
  GoTo CleanUp
CleanUp:
End Function

Private Function GET_TEMPLATE_REGION() As String
  
  On Error GoTo ErrHandler
  
  GET_TEMPLATE_REGION = ThisWorkbook.Names("region_name").RefersToRange.cells(1, 1).value

  GoTo CleanUp
  
ErrHandler:
  GoTo CleanUp
CleanUp:
End Function

Private Function GET_TEMPLATE_ENTITY() As String

    On Error GoTo ErrHandler

    GET_TEMPLATE_ENTITY = "_INN:" & ThisWorkbook.Names("inn").RefersToRange.cells(1, 1).value & "_KPP:" & _
                          ThisWorkbook.Names("kpp").RefersToRange.cells(1, 1).value

    GoTo CleanUp

ErrHandler:
    GoTo CleanUp
CleanUp:

End Function

Private Function GET_TEMPLATE_EXTENDED_INFO() As String
  
  On Error GoTo ErrHandler
  
  GET_TEMPLATE_EXTENDED_INFO = ""

  GoTo CleanUp
  
ErrHandler:
  GoTo CleanUp
CleanUp:
End Function

' ===================================================
' ===================================================

' Запросить информацию о доступных обновлениях
Public Sub Async_Query_Update_Info(ByRef strXMLTagNames() As String, _
                                   ByVal strTemplateCode As String)
  
  On Error GoTo ErrHandler

  Dim lngICounter As Long

  If Len(strTemplateCode) > 0 Then
    ' Сформировать URL-запрос
    strASYNC_URL = STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_NAME & _
                   STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_PARAM_1 & GET_TEMPLATE_CODE & "&" & _
                   STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_PARAM_2 & GET_TEMPLATE_VERSION & "&" & _
                   STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_PARAM_3 & GET_TEMPLATE_REGION & "&" & _
                   STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_PARAM_4 & GET_TEMPLATE_ENTITY & "&" & _
                   STR_HTTP_REQUEST_PROC_GET_UPDATE_INFO_PARAM_5 & GET_TEMPLATE_EXTENDED_INFO
  Else
    GoTo ErrHandler
  End If

  tviASYNC_Result.lngFileSize = 0
  tviASYNC_Result.strDescription = vbNullString
  tviASYNC_Result.strVersion = vbNullString
  tviASYNC_Result.strNewVersionURL = vbNullString
  tviASYNC_Result.strUpdatePriority = vbNullString

  ReDim strASYNC_XMLTagNames(UBound(strXMLTagNames))
  
  For lngICounter = 1 To UBound(strXMLTagNames)
    ' Проверить, что все запрашиваемые поля валидные
    If Len(strXMLTagNames(lngICounter)) = 0 Then
      GoTo ErrHandler
    End If
    strASYNC_XMLTagNames(lngICounter) = strXMLTagNames(lngICounter)
  Next lngICounter

  Set objASYNC_XMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
  
  ReDim strASYNC_BaseURL(2)

  strASYNC_BaseURL(1) = modHTTP.STR_HTTP_REQUEST_BASE_URL(1) ' (!) FEDERAL
  strASYNC_BaseURL(2) = modHTTP.STR_HTTP_REQUEST_BASE_URL(2) ' (!) FEDERAL
  
  lngASYNC_RequestCounter = 1

  ' Отправить HTTP-запрос...
  lngSend_Request objASYNC_XMLHTTP, objASYNC_XMLDOMDocument, _
                  strASYNC_BaseURL(lngASYNC_RequestCounter) & strASYNC_URL, True ' нет смысла проверки статуса здесь

  lngASYNC_Attempt = 1

  Application.OnTime Now + TimeValue("0:00:1"), "modUpd_Templ_HTTP_Request.Get_Update_Info_Response"
  
  GoTo Success
  
Success:
  GoTo CleanUp
ErrHandler:
  Set objASYNC_XMLHTTP = Nothing
  GoTo CleanUp
CleanUp:
End Sub

Public Sub Get_Update_Info_Response()

  On Error GoTo ErrHandler
  
  Dim lngICounter As Long
  Dim strMaxVersion As String
  Dim strDescription As String
  Dim strFileSize As String
  Dim strNewVersionURL As String
  Dim strUpdatePriority As String
  
  If Not objASYNC_XMLHTTP Is Nothing Then
  
    If objASYNC_XMLHTTP.readyState = 4 Then
    
      If Not objASYNC_XMLHTTP.status = HTTP_STATUS_OK Then
        GoTo TryNextDNS
      End If
    
      Set objASYNC_XMLDOMDocument = objASYNC_XMLHTTP.responseXML

      If objASYNC_XMLDOMDocument Is Nothing Then
        GoTo TryNextDNS
      End If
    
      If objASYNC_XMLDOMDocument.DocumentElement Is Nothing Then
        GoTo TryNextDNS
      End If
  
      If objASYNC_XMLDOMDocument.DocumentElement.ChildNodes Is Nothing Then
        GoTo TryNextDNS
      End If
  
      If objASYNC_XMLDOMDocument.DocumentElement.ChildNodes.Length >= 0 Then
        
        ' It's OK
      
        If objASYNC_XMLDOMDocument.DocumentElement.ChildNodes.Length > 0 Then
      
          For lngICounter = 0 To objASYNC_XMLDOMDocument.DocumentElement.ChildNodes.Length - 1
      
            Dim rec As MSXML2.IXMLDOMElement
            Set rec = objASYNC_XMLDOMDocument.DocumentElement.ChildNodes.Item(lngICounter)
      
            strMaxVersion = rec.getElementsByTagName(strASYNC_XMLTagNames(1)).Item(0).Text          ' Поиск тэга "версия"
            strDescription = rec.getElementsByTagName(strASYNC_XMLTagNames(2)).Item(0).Text         ' Поиск тэга "описание"
            strFileSize = rec.getElementsByTagName(strASYNC_XMLTagNames(3)).Item(0).Text            ' Поиск тэга "размер обновления"
            strNewVersionURL = rec.getElementsByTagName(strASYNC_XMLTagNames(4)).Item(0).Text       ' Поиск тэга "ссылка на отчётную форму"
            strUpdatePriority = rec.getElementsByTagName(strASYNC_XMLTagNames(5)).Item(0).Text      ' Поиск тэга "важность обновления"
      
          Next lngICounter
      
        End If
      
        If Len(strFileSize) = 0 Then
          tviASYNC_Result.lngFileSize = 0
        Else
          tviASYNC_Result.lngFileSize = CLng(strFileSize)
        End If
        tviASYNC_Result.strDescription = strDescription
        tviASYNC_Result.strVersion = strMaxVersion
        tviASYNC_Result.strNewVersionURL = strNewVersionURL
        tviASYNC_Result.strUpdatePriority = strUpdatePriority
        
        ' Return results
        
        modUpdTemplMain.Upd_TVI_Set tviASYNC_Result
        
        modUpdTemplMain.Check_Updates ThisWorkbook, False, True, True
      
        GoTo Success
      
      End If
    
TryNextDNS:

      ' =============================================================================================
      
      lngASYNC_RequestCounter = lngASYNC_RequestCounter + 1
      
      If lngASYNC_RequestCounter <= UBound(strASYNC_BaseURL) Then
      
        lngSend_Request objASYNC_XMLHTTP, objASYNC_XMLDOMDocument, _
                        strASYNC_BaseURL(lngASYNC_RequestCounter) & strASYNC_URL, True ' нет смысла проверки статуса здесь
      
        lngASYNC_Attempt = 1
      
        Application.OnTime Now + TimeValue("0:00:1"), "modUpd_Templ_HTTP_Request.Get_Update_Info_Response"
      
      Else
      
        ' Unable to retrieve info
        
        tviASYNC_Result.strDescription = "offline"
        
        ' Return results
        
        modUpdTemplMain.Upd_TVI_Set tviASYNC_Result
        
        modUpdTemplMain.Check_Updates ThisWorkbook, False, True, True
      
      End If
    
      ' =============================================================================================
    
    Else
    
      If lngASYNC_Attempt > 3 Then
      
        ' Sorry...
      
      Else
      
        lngASYNC_Attempt = lngASYNC_Attempt + 1
      
        ' Try later ...
        Application.OnTime Now + TimeValue("0:00:1"), "modUpd_Templ_HTTP_Request.Get_Update_Info_Response"
        
      End If
    
    End If
  
  End If
  
  GoTo Success
  
Success:
  GoTo CleanUp
ErrHandler:
  Set objASYNC_XMLHTTP = Nothing
  GoTo CleanUp
CleanUp:
End Sub

' ==================================================================================
…
vbaProject_00.bin vba-project OOXML VBA project: xl/vbaProject.bin 1525760 bytes
SHA-256: cda3f6094ca189d41ab981c1254d70f4da93cce4df2199367ca79d8fbf8705ab
emf_00.emf ooxml-emf OOXML EMF part: xl/media/image15.emf 26536 bytes
SHA-256: 2596b446726e5518313f61ff1220832637cea80e74b44e012ae5f2da158af4ed