Set objWinHttp = New WinHttp.WinHttpRequest
    objWinHttp.SetTimeouts 30000, 30000, 0, 0

Public Function ProcesSetCookie(Site As String, Pole As String, Cookie As String) As String ' Доповнення куків або знищення - встановити
  If Site = "" Or Pole = "" Then Exit Function
  Site = LCase(Site)
If MDB_InternetData.RecordCount > 0 Then MDB_InternetData.MoveFirst
If MDB_InternetData.EOF = False Then
   MDB_InternetData.FindFirst "Site = '" & Site & "'" 
  Do While MDB_InternetData.NoMatch = False
    If MDB_InternetData.Fields("Site").value = Site Then
      If MDB_InternetData.Fields("Pole").value = Pole Then
        If MDB_InternetData.Fields("Cookie").value = Cookie Then
          ProcesSetCookie = "без змін"
          Exit Function
        ElseIf Cookie = "" Then
          MDB_InternetData.Delete
          ProcesSetCookie = "знищено"
          Exit Function
        Else
          MDB_InternetData.Edit
          MDB_InternetData.Fields("Cookie").value = Cookie
          MDB_InternetData.Update
          ProcesSetCookie = "обновлено"
          Exit Function
        End If
      End If
     End If
      MDB_InternetData.FindNext "Site = '" & Site & "'"
  Loop
End If
  MDB_InternetData.AddNew
  MDB_InternetData.Fields("Site") = Site
  MDB_InternetData.Fields("Pole") = Pole
  MDB_InternetData.Fields("Cookie") = Cookie
  ProcesSetCookie = "доповнено"
  MDB_InternetData.Update
End Function

Public Function ProcesGetCookie(Site As String) As String ' Готова стрічка для куків щоб відразу її підставити
  Dim PerRaz As Boolean
  Dim Pole As String, Cookie As String
  If Site = "" Then Exit Function
  Site = LCase(Site)
If MDB_InternetData.RecordCount > 0 Then MDB_InternetData.MoveFirst
If MDB_InternetData.EOF = False Then
   MDB_InternetData.FindFirst "Site = '" & Site & "'"
  Do While MDB_InternetData.NoMatch = False
    If MDB_InternetData.Fields("Site").value = Site Then
      Pole = MDB_InternetData.Fields("Pole").value
      Cookie = MDB_InternetData.Fields("Cookie").value
        If PerRaz = False Then
          ProcesGetCookie = Pole & "=" & Cookie
        Else
          ProcesGetCookie = ProcesGetCookie & "; " & Pole & "=" & Cookie
        End If
        PerRaz = True
     End If
      MDB_InternetData.FindNext "Site = '" & Site & "'"
  Loop
End If
End Function

'Розбирає стрічку на частини і виконує інструкції
Public Sub PbCookieParsing(Vhid As String, Site As String)
Dim s As String, s1 As String, s2 As String, s3 As String

Do
 s = PbFnStringPoshuk(Vhid, "Set-Cookie: ,;", Вибираємо_все_що_в_середині)
 Vhid = PbFnStringPoshuk(Vhid, "Set-Cookie: ,;", Пропускаємо)
 If s <> "" Then
  s1 = Left(s, InStr(s, "=") - 1)
  s2 = Mid(s, InStr(s, "=") + 1)
  If s2 = Chr(34) & Chr(34) Then s2 = ""
  Call ProcesSetCookie(Site, s1, s2)
 End If
Loop While s <> ""
End Sub
'=====================================================================================================
Public Enum PbEnDiyaForStringPoshuk
  Вибираємо_все_що_в_середині = 1
  Викидуємо = 2
  Вибираємо_все = 3
  Пропускаємо = 4
End Enum

Public Function PbFnStringPoshuk(ByVal Vhid As String, ByVal StrokaIzZrazkom As String, Regim As PbEnDiyaForStringPoshuk) As String
'Вибір чи пропуск послідовності тегів
    Dim i As Long
    Dim b As Boolean
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    Dim s4 As String
    Dim s5 As String: Dim sS5 As String
    Dim s6 As String: Dim sS6 As String
    Dim q As String
    Dim w As String
    Dim bl1 As String
    Dim bl2 As String
    Dim vh4 As String
    Dim vh3 As String
    Dim vh1 As String
    b = False

Dim sS0 As String
Dim sS1 As String
Dim sS2 As String
Dim sS3 As String
Dim sS4 As String
            sS0 = Vhid
            sS1 = sS0
            vh3 = StrokaIzZrazkom
            w = vh3
            b = False
Cicl2:
       If Trim(w) <> "" Then
         i = InStr(w, ",")
         If i > 1 Then
           q = Left(w, i - 1)
           w = Trim(Mid(w + " ", i + 1))
         Else
           q = w
           b = True ' Не забути обезвредити якщо інша перевірка не пройде
         End If
       i = InStr(1, sS1, q, vbTextCompare)
         If i = 0 Then b = False: GoTo Dali2
         bl1 = q
         sS5 = Left(sS1, i - 1)
         sS2 = Mid(sS1, i + Len(q))
         sS1 = Mid(sS1, i)
         If b = True Then sS3 = "": GoTo Dali2
Cicl3:
         i = InStr(w, ",")
         If i > 1 Then
           q = Left(w, i - 1)
           w = Trim(Mid(w + " ", i + 1))
         Else
           q = w
           b = True ' Не забути обезвредити якщо інша перевірка не пройде
           bl2 = q
         End If
       i = InStr(1, sS2, q, vbTextCompare)
          If i = 0 Then b = False: sS1 = "": GoTo Dali2
          If Len(q) + i - 1 = 0 Then b = False: sS1 = "": GoTo Dali2
          sS2 = Mid(sS2, Len(q) + i)
          sS3 = Left(sS1, Len(sS1) - Len(sS2))
          If b = True Then GoTo Dali2
         GoTo Cicl3
       End If
Dali2:
        If b = True Then
          If Regim = 3 Then
             PbFnStringPoshuk = sS3
          End If
          If Regim = 1 And bl1 <> "" And bl2 <> "" Then
             sS0 = sS3
              sS0 = Mid(sS0, Len(bl1) + 1)
              PbFnStringPoshuk = Left(sS0, Len(sS0) - Len(bl2))
          End If
          If Regim = 4 Then
             PbFnStringPoshuk = sS2
          End If
          If Regim = 2 Then
             PbFnStringPoshuk = sS5 + sS2
          End If
          
        Else
          PbFnStringPoshuk = ""
          If Regim = 2 Then PbFnStringPoshuk = Vhid
        End If
End Function