При выполнении запроса api v3 true api cises info возникла ошибка код состояния http 403

1
2
3
4

Dim wshA As Object
Set wshA = CreateObject("WScript.Shell")
wshA.Run "cmd /c curl -X POST -H ""Accept: application/xml"" -H ""Content-Type: application/json"" -H @C:TokenGIS.txt -d ""[""""" & DM & """""]"" ""https://markirovka.crpt.ru/api/v3/true-api/cises/info"" > C:dok.xml", 0, True
Set wshA = Nothing

1
2
3
4
5
6
7
8
9
10
11
12
13
14

Dim Token
Dim txtReply
Open "C:TokenGIS.txt" For Input As #1: Token = Input(LOF(1), 1): Close #1
Dim rq As WinHttp.WinHttpRequest
 
  Set rq = New WinHttpRequest
  
  rq.Open "POST", "https://markirovka.crpt.ru/api/v3/true-api/cises/info", 0 ' в Me.txtURI.Value лежит 'http://www.ru''
  rq.setRequestHeader "Content-Type", "application/json"
  rq.setRequestHeader "Accept", "application/xml"
  rq.setRequestHeader "Authorization: Bearer", Replace(Token, "Authorization: Bearer ", "")
  
  rq.send "[""" & DM & """]"
  txtReply = rq.responseText

1

rq.setRequestHeader "Authorization", "Bearer " & Replace(Token, "Authorization: Bearer ", "")

1
2
3
4
5
6
7
8
9
10

Dim http As WinHttp.WinHttpRequest
  Set http = New WinHttpRequest
 http.Open "POST", "https://markirovka.crpt.ru/api/v3/true-api/cises/info", False
 http.setRequestHeader "Accept", "application/xml"
 http.setRequestHeader "Content-Type", "application/json"
 http.setRequestHeader "Authorization", Replace(Token, "Authorization: ", "")
 
 
 http.send "[""" & DM & """]"
 otvet = http.responseText

1

http.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300

1

on error resume next

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

Dim http As Object
Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
Dim otvet
 
 http.Open "POST", "http://localhost:8080/opt/in/ActFixBarCode", False
 http.Option(WinHttpRequestOption_SslErrorIgnoreFlags) = &H3300
 
 
Dim xmlDoc As Object
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
 xmlDoc.async = False
 xmlDoc.Load ("C:555555СтароеActFixBarCode.xml")
 
 http.send xmlDoc
 otvet = http.responseText
 
MsgBox otvet
Set http = Nothing
Set xmlDoc = Nothing

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

Private Function ÎòïðàâêàPOST(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As String
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String
 
    '--- read file
    nFile = FreeFile
    Open sFileName For Binary Access Read As nFile
    If LOF(nFile) > 0 Then
        ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
        Get nFile, , baBuffer
        sPostData = StrConv(baBuffer, vbUnicode)
    End If
    Close nFile
    '--- prepare body
    sPostData = "--" & STR_BOUNDARY & vbCrLf & _
        "Content-Disposition: form-data; name=""xml_file""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "") + 1) & """" & vbCrLf & _
        "Content-Type: application/xml" & vbCrLf & vbCrLf & _
        sPostData & vbCrLf & _
        "--" & STR_BOUNDARY & "--"
    '--- post
    With CreateObject("Microsoft.XMLHTTP")
        .Open "POST", sUrl, bAsync
        .setRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
        .send pvToByteArray(sPostData)
        If Not bAsync Then
            pvPostFile = .responseText
            MsgBox .status
        End If
    End With
End Function
 
Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28

Процедура АвторизацияНаСервере()
    GUID = Новый УникальныйИдентификатор();
    СтрокаGUID = СтрЗаменить(Строка(GUID),"-","");
    ID = "837c77a6-2aab-4480-9271-71b85b28****";
    Secret = "M3kJ5bS3pA8nF1bC7tP0tR6hY8dF6rX4lM1oI4rE8wV4fA****";
    IDSecret64 = ШтрихкодВBase64(ID + ":" + Secret); 
    Authorization = "Basic " + IDSecret64; 
                                        
    ssl = Новый ЗащищенноеСоединениеOpenSSL
            (Новый СертификатКлиентаФайл("H:QRnikiforovvn@mail.ru.p12","PlatiQR2021"));
 
    HTTPСоединение = Новый HTTPСоединение("dev.api.sberbank.ru",443,,,,,ssl);
            
    ПараметрыЗапроса = "?grant_type=client_credentials&scope=https%3A%2F%2Fapi.sberbank.ru%2Forder.create"; //
    ТекстЗапроса = "https://api.sberbank.ru/ru/prod/tokens/v2/oauth";
        
    HTTPЗапрос = Новый HTTPЗапрос(ТекстЗапроса);
    HTTPЗапрос.АдресРесурса = ТекстЗапроса + ПараметрыЗапроса; 
    HTTPЗапрос.Заголовки.Вставить("x-ibm-client-id", ID);    
    HTTPЗапрос.Заголовки.Вставить("authorization", Authorization);    
    HTTPЗапрос.Заголовки.Вставить("rquid", СтрокаGUID);    
    HTTPЗапрос.Заголовки.Вставить("content-type","application/x-www-form-urlencoded" ); //"json"    
    HTTPЗапрос.Заголовки.Вставить("accept", "application/json");
 
 
    Ответ = HTTPСоединение.ОтправитьДляОбработки(HTTPЗапрос);
 
КонецПроцедуры

1
2

 ssl = Новый ЗащищенноеСоединениеOpenSSL
            (Новый СертификатКлиентаФайл("H:QRnikiforovvn@mail.ru.p12","PlatiQR2021"));

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20

Public Function GetHTMLPageByURL(URL$) As String
' Функция возвращает тело переданной в URL страницы
'--------------------------------------------------------------------
 
Dim objHTTP As Object
Dim iTimeOut%
    
    Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
    
    'iTimeOut = 2000 'Milliseconds
    'objHTTP.setTimeouts iTimeOut, iTimeOut, iTimeOut, iTimeOut
    
    objHTTP.Open "GET", URL$, False
    objHTTP.Send
    
    GetHTMLPageByURL = objHTTP.ResponseText
    
    Set objHTTP = Nothing
 
End Function

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32

Public Function GetHTMLPageByURL2(URL$) As String
Const READYSTATE_COMPLETE = 4
Dim IE As Object
Dim html As Object
Dim htmlBody As Variant
 
 
    Set IE = CreateObject("InternetExplorer.Application")
    'IE.Top = 0
    'IE.Left = 0
    'IE.Width = 800
    'IE.Height = 600
    
    'IE.Visible = True
    IE.Visible = False
    IE.navigate URL$
 
 
'Wait until IE is done loading page
    Do While IE.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Loop
 
'HTML document returned
    Set html = IE.Document
    GetHTMLPageByURL2 = html.DocumentElement.innerHTML
 
    'IE.Visible = True
    IE.Quit
    Set IE = Nothing
 
End Function