MALICIOUS
150
Risk Score
Heuristics 6
-
VBA project inside OOXML medium 4 related findings OOXML_VBADocument contains a VBA project — VBA macros present
-
CreateObject call high OLE_VBA_CREATEOBJCreateObject callMatched line in script
Set objASYNC_XMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0") -
VBA polls global keyboard state (keylogger) high OLE_VBA_KEYLOGGER_SPYWAREThe 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_EXECTriggers 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_WBOPENWorkbook_Open macroMatched line in script
Private Sub Workbook_Open() -
Embedded URL info EMBEDDED_URLOne 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.
| Filename | Kind | Source | Size |
|---|---|---|---|
macros.bas |
vba-macro | oletools.olevba.extract_macros (decoded VBA source from OOXML) | 507226 bytes |
SHA-256: 5eba94a7926a6106b0abc0ded975c90fe1d91775df4c5f5a3262d5d04dc40a00 |
|||
Preview scriptFirst 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 |
|||
Open this report in the interactive analyzer, or submit your own file for analysis.