Тема: Послать POST запрос на https страничку сайта / вебсервис.
Вот пример скрипта, который мтодом POST на вебсервис отсылает инфу с лотусовых документов по некоторому признаку.
Sub Initialize '
On Error Goto ErrH
Print "ForGTK-Старт!"
Dim session As New NotesSession, db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim xml As Variant
Dim xmlhttp As Variant
Dim DateIsm As String ' дата изменения
'Set xmlhttp = CreateObject("Msxml2.XMLHTTP.3.0")
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
Set db = session.CurrentDatabase
Set collection = db.AllDocuments
Print "в окне документов: " & collection.Count
likvdoc% = 0 ' счетчик для Print
reorgdoc% = 0 ' счетчик для Print
flagLicvReorg% = 0 ' 1 - ликвдидация, 2 - реорганизация. 0 - нечего слать
Set doc = collection.GetFirstDocument
While Not(doc Is Nothing)
If doc.tGTK_flag(0) <>"1" Then
FullName = Replace(doc.FullName(0),{"},{ \"})
ShortName = Replace(doc.ShortName(0),{"},{ \"})
Liquid = Replace(doc.Liquid(0),{"},{ \"})
MainLiquid = Replace(doc.MainLiquid(0),{"},{ \"})
DateIsm = Format$( doc.DateIsm(0) , "dd.mm.yyyy" )
If (doc.TypeReorganization(0)<>"") And (doc.IsValid And Not doc.IsDeleted ) Then ' Реорганизация
reorgdoc% = reorgdoc% + 1
Print reorgdoc% & ". реорг " & FullName & " - " & doc.DateIsm(0)
mystr = |"MsTitle":"Реорганизация"|
mystr = mystr + |, "MesDateTime":"| & DateIsm & |"| '12/22/2016 ММ/ДД/ГГГГ а надо ДД.ММ.ГГГГ
mystr = mystr + |, "MesDescription":"| & doc.PSComment(0) & |"|
mystr = mystr + |, "MesUNID":"| & doc.IdDoc(0) & |"|
mystr = mystr + |, "MesULName":"| & FullName & |"|
mystr = mystr + |, "MesULFK":"| & doc.Afiscod(0) & |"|
'mystr = |"FullName":"| & FullName & |"|
'mystr = mystr + |, "ShortName":"| & ShortName & |"|
'mystr = mystr + |, "Datareg":"| & doc.Adatereg(0) & |"|
'mystr = mystr + |, "DateIsm":"| & doc.DateIsm(0) & |"|
'mystr = mystr + |, "Afiscod":"| & doc.Afiscod(0) & |"|
'mystr = mystr + |, "unidsall":"| & doc.IDSHAREDOC(0) & |"|
'mystr = mystr + |, "TypeReorganization":"| & doc.TypeReorganization(0) & |"|
flagLicvReorg% = 2 ' Реорганизация
End If
If (doc.SartedLiquid(0)<>"" Or doc.BeginLiquid(0)<>"") And (doc.IsValid And Not doc.IsDeleted ) Then ' Ликвидация
likvdoc% = likvdoc% + 1
Print likvdoc% & ". ликв " & FullName & " - " & doc.DateIsm(0)
mystr = |"MsTitle":"Ликвидация"|
mystr = mystr + |, "MesDateTime":"| & DateIsm & |"|
mystr = mystr + |, "MesDescription":"| & doc.PSComment(0) & |"|
mystr = mystr + |, "MesUNID":"| & doc.IdDoc(0) & |"|
mystr = mystr + |, "MesULName":"| & FullName & |"|
mystr = mystr + |, "MesULFK":"| & doc.Afiscod(0) & |"|
'mystr = |"FullName":"| & FullName & |"|
'mystr = mystr + |, "ShortName":"| & ShortName & |"|
'mystr = mystr + |, "Datareg":"| & doc.Adatereg(0) & |"|
'mystr = mystr + |, "DateIsm":"| & doc.DateIsm(0) & |"|
'mystr = mystr + |, "Afiscod":"| & doc.Afiscod(0) & |"|
'mystr = mystr + |, "unid":"| & doc.IdDoc(0) & |"|
'mystr = mystr + |, "unidsall":"| & doc.IDSHAREDOC(0) & |"|
'mystr = mystr + |, "DataLiquid":"| & doc.DataLiquid(0) & |"| 'Дата исключения из Государственного реестра
'mystr = mystr + |, "Liquid ":"| & Liquid & |"|
'mystr = mystr + |, "MainLiquid":"| & MainLiquid & |"|
'mystr = mystr + |, "BeginLiquid":"| & doc.BeginLiquid(0) & |"| ' Дата уведомления о принятии решения
'mystr = mystr + |, "SartedLiquid":"| & doc.SartedLiquid(0) & |"| 'Находится в стадии ликвидации
'mystr = mystr + |, "LiquidComissionDate":"| & doc.LiquidComissionDate(0) & |"|
'mystr = mystr + |, "MiddleBalanceDate":"| & doc.MiddleBalanceDate(0) & |"|
'mystr = mystr + |, "Liquidremark":"| & doc.Liquidremark(0) & |"|
flagLicvReorg% = 1 ' ликвдидация
End If
If flagLicvReorg% <> 0 Then ' Или ликв, или реорг
xml = |username=username&password=password&pact_id=46&query={| & mystr & |}|
Print xml
Call xmlhttp.open("POST","https://123.org/api/v1/execute_query", False,"","")
Call xmlhttp.setRequestHeader ("Content-Type", "application/x-www-form-urlencoded")
Call xmlhttp.setRequestHeader ("User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)")
Call xmlhttp.send (xml)
'Print "readyState:" & xmlhttp.readyState & " Status:" & xmlhttp.Status
' readyState - Номер состояния запроса 0 - Unitialized 1 - Loading 2 - Loaded 3 - Interactive 4 - Complete
'status - 200 - OK, 404 - Not Found
If xmlhttp.Status = 200 Then ' ответ веб сервера - всё ок
getAllResponseHeaders = xmlhttp.getAllResponseHeaders()
responseText = xmlhttp.responseText
ok = Instr(responseText, "Ответ получен успешно")
If ok>1 Then
Print "ок"
doc.tGTK_flag = "1"
Call doc.Save( False, True )
Else
Print responseText
End If
End If
flagLicvReorg% = 0
End If
End If
Set doc = collection.GetNextDocument(doc)
Wend
Print "ForGTK-Конец!"
Exit Sub
ErrH:
Print "Ошибка: " & Err, Error & { В строке } & Erl
Dim dblog As notesdatabase
Dim doclog As NotesDocument
Set dblog = session.GetDatabase("","WebLog.nsf") ' ЛОГИ
Set doclog = New NotesDocument (dblog)
doclog.ERRMSG = "Ошибка: " & Err &", " & Error & { В строке } & Erl
doclog.BASE_NAME = "Агент ГТК - одно окно ЮЛ"
Dim dateTime As New NotesDateTime( "" )
dateTime.LSLocalTime = Now
doclog.log_time=dateTime.LSLocalTime
doclog.Form ="Log Entry"
Call doclog.Save(True, False)
End Sub