powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Невозможность получения куков, в том числе NetHTTPClient
22 сообщений из 22, страница 1 из 1
Невозможность получения куков, в том числе NetHTTPClient
    #39753181
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Странные дела нынче творятся, в Delphi среде. Я перепробовал разные способы

NetHTTPClient
Код: pascal
1.
2.
3.
4.
5.
6.
  Client1:= NetHTTPClient1.Get('URL');
  for value in Client1.Cookies do
    ShowMessage(value.ToString);

  for value2 in Client1.Headers do
    ShowMessage(value2.Name + ' : ' + value2.value);



TJCookieManager
Код: pascal
1.
2.
3.
4.
5.
6.
    t := TJCookieManager.JavaClass.getInstance;
    t.setAcceptCookie(True);
    t.setAcceptThirdPartyCookies(WebBrowser1.GetJWebBrowser, True);

    s := JStringToString(t.getCookie(StringToJString('URL')));
    ShowMessage(s);



WebBrowser2
Код: pascal
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.
  TScriptCallback = class(TJavaLocal, JValueCallback)
  public
    constructor Create;
    procedure onReceiveValue(value: JObject); cdecl;
  end;

var
 FResultCallback: JValueCallback;
...
FResultCallback := TScriptCallback.Create;


begin
  WebBrowser2.GetJWebBrowser.evaluateJavascript
    (StringToJString('(function() { return document.cookie; })();'), FResultCallback);
end;


procedure TScriptCallback.onReceiveValue(value: JObject);
var
  Str: String;
begin
  try
    Str := TJSONObject.ParseJSONValue(JStringToString(JString(value))).ToString;
  except
    Str := '';
  end;
  if Str <> '' then
  begin

     ShowMessage(Str);
  end;
end;



Но все эти варианты возвращают
- 'PHPSESSID=****************; referal=**; last_visit=******::******; on=0'

Почему?????

....


Если взять тот же PHP с его get_headers То он возвращает полностью Куки
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753347
Фотография makhaon
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

смотри заголовки там и там
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753358
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
makhaon,

Заголовки то смотрел. Они все выдают такое содержимое.

Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
Cache-Control : no-store, no-cache, must-revalidate
Connection : keep-alive
Date : Wed, 26 Dec 2018 10:03:37 GMT
Pragma : no-cache
Transfer-Encoding : chunked
Content-Type : text/html; charset=UTF-8
Expires : Thu, 19 Nov 1981 08:52:00 GMT
Server : nginx/1.12.2
X-Powered-By : PHP/7.0.33




А в PHP вот такое
Код: sql
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
Array
(
    [0] => HTTP/1.1 200 OK
    [Server] => nginx/1.12.2
    [Date] => Wed, 26 Dec 2018 10:04:56 GMT
    [Content-Type] => text/html; charset=UTF-8
    [Connection] => close
    [X-Powered-By] => PHP/7.0.33
    [Set-Cookie] => Array
        (
            [0] => on=0; expires=Tue, 10-Nov-5187 19:51:35 GMT; Max-Age=99999999999; path=/; domain=.****; secure **********
            [1] => PHPSESSID=***************; path=/
            [2] => p_up2=deleted; expires=Thu, 01-Jan-1970 00:00:01 GMT; Max-Age=0; path=/; domain=.******; secure **********
        )

    [Expires] => Thu, 19 Nov 1981 08:52:00 GMT
    [Cache-Control] => no-store, no-cache, must-revalidate
    [Pragma] => no-cache
)
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753371
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоОни все выдают такое содержимое.
Значит эта страница не устанавливает никакие куки.

ГирлионайльдоА в PHP вот такое

Значит это вопрос к документации PHP откуда оно эти куки подтягивает. Скорее всего - из
перманентного хранилища.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753375
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Dimitry Sibiryakov,

Значит, Delphi не умеет такого???

В принципе если нажать F12 в браузере, и просмотреть куки страницы. То там все эти же куки и будут, как в PHP
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753388
Dimitry Sibiryakov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоЗначит, Delphi не умеет такого???

Не конечно, это же всего лишь тупой компилятор + текстовый редактор. К нему программист
должен прилагаться.
Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753480
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Штатными способами не получается достать.
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753537
s62
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдо,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
procedure TForm1.Button8Click(Sender: TObject);
var i: integer;
    s: string;
begin
  Memo.Clear;
  s := idHttp.Get('https://www.rambler.ru');
//  memCookies.Clear;
//  for i := 0 to IdCookieManager.CookieCollection.Count - 1
//  do memCookies.Lines.Add(IdCookieManager.CookieCollection.Cookies[i].CookieText);
  Memo.Lines.CommaText := idHTTP.Response.RawHeaders.CommaText;
end;



Server: nginx
Date: Wed, 26 Dec 2018 14:09:18 GMT
Content-Type: text/html; charset="utf-8"
Content-Length: 346917
Connection: keep-alive
Keep-Alive: timeout=50
X-Powered-By: Express
X-App-Version: 1.27.8
X-Redis-Cache: HIT
ETag: W/"54b25-J2sR/smYgiQlJ7YTb8PWsvMyGuE"
X-Frame-Options: SAMEORIGIN
Set-Cookie: proselytize=1; domain=.rambler.ru; path=/; expires=_Wed, 20-Jul-18 23:55:55 GMT
X-Back: 10.16.36.154:80
Vary: Accept-Encoding, User-Agent
Cache-Control: no-cache, no-store, must-revalidate
Pragma: no-cache
Expires: 0
X-Request-Id: 0455049f53399758030d634c1dad4a1e
Set-Cookie: ruid=vAsAAI6LI1zqDL9LAR/eEQB=; expires=Thu, 31-Dec-37 23:55:55 GMT; domain=.rambler.ru; path=/
P3P: CP="NON DSP NID ADMa DEVa TAIa PSAa PSDa OUR IND UNI COM NAV"
x-ua-compatible: ie=edge
У IdHTTP есть свойство CookieManager. Можно кинуть соотв. компонент, подключить и получать куки, как в закоментированных строчках. (Есть еще свойства CookieName, CookeValue).
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753575
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
s62,

Я не могу данный компонент использовать, из за того что он требует библиотеки SSL и тоже самое будет просить на андройде с ошибкой 'Could not load SSL library.'.

А вот компонент TNetHTTPClient сам находит все сертификаты для https
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753592
Tactical Nuclear Penguin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Гирлионайльдоs62,

Я не могу данный компонент использовать, из за того что он требует библиотеки SSL и тоже самое будет просить на андройде с ошибкой 'Could not load SSL library.'.

А вот компонент TNetHTTPClient сам находит все сертификаты для https

угу
только на винде
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753596
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tactical Nuclear Penguin,

А я данную ошибку на экране телефона наблюдал.
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753619
Tactical Nuclear Penguin
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоА вот компонент TNetHTTPClient сам находит все сертификаты для https

ГирлионайльдоTactical Nuclear Penguin,

А я данную ошибку на экране телефона наблюдал.

ты уж определись
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753621
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Tactical Nuclear Penguin,

Он писал про IdHTTP .
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753622
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я через отладчик ОТЫСКАЛ!!! Свои куки. В файле System.Net.HttpClient Строка 2019

Код: pascal
1.
2.
3.
4.
5.
6.
7.
procedure THTTPClient.UpdateCookiesFromResponse(const AResponse: THTTPResponse);
var
  I: Integer;
begin
  for I := 0 to AResponse.FCookies.Count -1 do
    FCookieManager.AddServerCookie(AResponse.FCookies[I], AResponse.FRequest.URL);
end;



Тут куки ещё есть! Веду дальнейшее развитие. Куда же куки пропадают в конечном итоге
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753626
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Мои куки не проходят в этой функции
Код: pascal
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.
procedure TCookieManager.UpdateCookie(const ACookie: TCookie; const AURL: TURI);
var
  I: Integer;
  Found: Boolean;
begin
  TMonitor.Enter(FCookies);
  try
    Found := False;
    DeleteExpiredCookies;
    for I := 0 to FCookies.Count - 1 do
    begin
      if SameText(ACookie.Name, FCookies[I].Name) and
         SameText(ACookie.Domain, FCookies[I].Domain) and
         SameText(ACookie.Path, FCookies[I].Path) then
      begin
        Found := True;
        FCookies[I] := ACookie;
        Break;
      end
    end;
    if not Found and ((ACookie.Expires = 0) or (ACookie.Expires > Now)) then
      FCookies.Add(ACookie);
  finally
    TMonitor.Exit(FCookies);
  end;
end;



Код: pascal
1.
 ((ACookie.Expires = 0)



Должен быть 0 что бы куки добавились в базу.!!!. А там стоит текущая дата
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753628
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
И что с этим делать???
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753629
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Не.. Это я протупил. На год не посмотрел

Expires 11.11.5187 5:24:11
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753632
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
А нет. Ничего не протупил. Просто куки переполняются
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753683
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоА нет. Ничего не протупил. Просто куки переполняются
Запили в QC
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753689
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоА нет. Ничего не протупил. Просто куки переполняются
Хотя в System.SysUtils
Код: pascal
1.
2.
3.
const
  MinDateTime: TDateTime = -657434.0;      { 01/01/0100 12:00:00.000 AM }
  MaxDateTime: TDateTime =  2958465.99999; { 12/31/9999 11:59:59.999 PM }
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39753714
Гирлионайльдо
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
X-Cite,

Да. Баг! Можете за меня отправить.

Баг в функции StrExpiresToDateTime в файле System.Net.HttpClient строка 2576

Привожу баг

Функция сама, вне юнита (Так как приват)
Код: pascal
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.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
function StrExpiresToDateTime(const AStrDate: string): TDateTime;
var
  LDate: TDateTime;
  LTime: TDateTime;
  Pos: Integer;
  Len: Integer;
  LFoundTime: Boolean;
  LFoundDayOfMonth: Boolean;
  LFoundMonth: Boolean;
  LFoundYear: Boolean;
  LHours: Integer;
  LMinutes: Integer;
  LSeconds: Integer;
  LYear: Integer;
  LMonth: Integer;
  LDayOfMonth: Integer;
  Token: string;

  function IsDelimiter(C: Char): Boolean;
  // delimiter = %x09 / %x20-2F / %x3B-40 / %x5B-60 / %x7B-7E
  begin
    case C of
      Char($09), Char($20) .. Char($2F), Char($3B) .. Char($40),
        Char($5B) .. Char($60), Char($7B) .. Char($7E):
        Result := True;
    else
      Result := False;
    end;
  end;

  function IsNonDelimiter(C: Char): Boolean;
  // non-delimiter = %x00-08 / %x0A-1F / DIGIT / ":" / ALPHA / %x7F-FF
  begin
    case C of
      Char($00) .. Char($08), Char($0A) .. Char($1F), '0' .. '9', ':',
        'A' .. 'Z', 'a' .. 'z', Char($7F) .. Char($FF):
        Result := True;
    else
      Result := False;
    end;
  end;

  procedure CleanDelimiters;
  begin
    while (Pos < Len) and IsDelimiter(AStrDate.Chars[Pos]) do
      Inc(Pos);
  end;

  function ReadToken: string;
  begin
    Result := '';
    while (Pos < Len) and IsNonDelimiter(AStrDate.Chars[Pos]) do
    begin
      Result := Result + AStrDate.Chars[Pos];
      Inc(Pos);
    end;
  end;

  function CheckTime: Boolean;
  const
    HoursPart = 0;
    MinutesPart = 1;
    SecondsPart = 2;
  var
    Parts: TArray<string>;
  begin
    Result := False;
    if not LFoundTime then
    begin
      Parts := Token.Split([Char(':')]);
      if Length(Parts) = 3 then
      begin
        if (Parts[HoursPart].Length = 1) or (Parts[HoursPart].Length = 2) then
          if not TryStrToInt(Parts[HoursPart], LHours) or (LHours > 23) then
            Exit;

        if (Parts[MinutesPart].Length = 1) or (Parts[MinutesPart].Length = 2)
        then
          if not TryStrToInt(Parts[MinutesPart], LMinutes) or (LMinutes > 59)
          then
            Exit;

        if (Parts[SecondsPart].Length = 1) or (Parts[SecondsPart].Length = 2)
        then
          if not TryStrToInt(Parts[SecondsPart], LSeconds) or (LSeconds > 59)
          then
            Exit;

        LFoundTime := True;
        Result := True;
      end;
    end;
  end;

  function CheckDayOfMonth: Boolean;
  begin
    Result := False;
    if not LFoundDayOfMonth then
    begin
      if (Token.Length = 1) or (Token.Length = 2) then
        if TryStrToInt(Token, LDayOfMonth) and (LDayOfMonth >= 1) and
          (LDayOfMonth <= 31) then
        begin
          LFoundDayOfMonth := True;
          Result := True;
        end;
    end;
  end;

  function CheckMonth: Boolean;
  const
    Months: array [1 .. 12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
      'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); // do not localize
  var
    I: Integer;
  begin
    Result := False;
    if not LFoundMonth then
    begin
      for I := 1 to 12 do
        if SameText(Token, Months[I]) then
        begin
          LMonth := I;
          LFoundMonth := True;
          Result := True;
          Break;
        end;
    end;
  end;

  function CheckYear: Boolean;
  begin
    Result := False;
    if not LFoundYear then
    begin
      if (Token.Length = 2) or (Token.Length = 4) then
        if TryStrToInt(Token, LYear) then
        begin
          if (LYear >= 70) and (LYear <= 99) then
            LYear := LYear + 1900
          else if (LYear >= 0) and (LYear <= 69) then
            LYear := LYear + 2000;

          if LYear > 1600 then
          begin
            LFoundYear := True;
            Result := True;
          end;
        end;
    end;
  end;

begin
  LFoundTime := False;
  LFoundDayOfMonth := False;
  LFoundMonth := False;
  LFoundYear := False;
  Pos := 0;
  Len := AStrDate.Length;

  while Pos < Len do
  begin
    CleanDelimiters;
    Token := ReadToken;

    if CheckTime then
      Continue;

    if CheckDayOfMonth then
      Continue;

    if CheckMonth then
      Continue;

    if CheckYear then
      Continue;

    if LFoundTime and LFoundDayOfMonth and LFoundMonth and LFoundYear then
      Break;
  end;

  if LFoundTime and LFoundDayOfMonth and LFoundMonth and LFoundYear then
  begin
    if TryEncodeDate(LYear, LMonth, LDayOfMonth, LDate) and
      TryEncodeTime(LHours, LMinutes, LSeconds, 0, LTime) then
    begin
      LDate := LDate + LTime;
      Result := TTimeZone.Local.ToLocalTime(LDate);
      if Result = 0 then
        // To avoid to create a session cookie if the expire date is in the delphi date limit
        Result := 1;
    end
    else
      Result := 0;
  end
  else
    Result := 0;
end;



Вызываем
Код: pascal
1.
2.
  LTime := StrExpiresToDateTime('11.11.5187 5:24:11');
  ShowMessage(DateTimeToStr(LTime));



И получаем 30.12.1899

Почему он, мне возвращал текущую дату.. Это уже другой разговор... Этот момент я не отследил...
...
Рейтинг: 0 / 0
Невозможность получения куков, в том числе NetHTTPClient
    #39754701
Фотография X-Cite
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ГирлионайльдоX-Cite,

Да. Баг! Можете за меня отправить.

Баг в функции StrExpiresToDateTime в файле System.Net.HttpClient строка 2576

Привожу баг

Функция сама, вне юнита (Так как приват)
Код: pascal
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.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
152.
153.
154.
155.
156.
157.
158.
159.
160.
161.
162.
163.
164.
165.
166.
167.
168.
169.
170.
171.
172.
173.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
192.
193.
194.
195.
196.
197.
198.
function StrExpiresToDateTime(const AStrDate: string): TDateTime;
var
  LDate: TDateTime;
  LTime: TDateTime;
  Pos: Integer;
  Len: Integer;
  LFoundTime: Boolean;
  LFoundDayOfMonth: Boolean;
  LFoundMonth: Boolean;
  LFoundYear: Boolean;
  LHours: Integer;
  LMinutes: Integer;
  LSeconds: Integer;
  LYear: Integer;
  LMonth: Integer;
  LDayOfMonth: Integer;
  Token: string;

  function IsDelimiter(C: Char): Boolean;
  // delimiter = %x09 / %x20-2F / %x3B-40 / %x5B-60 / %x7B-7E
  begin
    case C of
      Char($09), Char($20) .. Char($2F), Char($3B) .. Char($40),
        Char($5B) .. Char($60), Char($7B) .. Char($7E):
        Result := True;
    else
      Result := False;
    end;
  end;

  function IsNonDelimiter(C: Char): Boolean;
  // non-delimiter = %x00-08 / %x0A-1F / DIGIT / ":" / ALPHA / %x7F-FF
  begin
    case C of
      Char($00) .. Char($08), Char($0A) .. Char($1F), '0' .. '9', ':',
        'A' .. 'Z', 'a' .. 'z', Char($7F) .. Char($FF):
        Result := True;
    else
      Result := False;
    end;
  end;

  procedure CleanDelimiters;
  begin
    while (Pos < Len) and IsDelimiter(AStrDate.Chars[Pos]) do
      Inc(Pos);
  end;

  function ReadToken: string;
  begin
    Result := '';
    while (Pos < Len) and IsNonDelimiter(AStrDate.Chars[Pos]) do
    begin
      Result := Result + AStrDate.Chars[Pos];
      Inc(Pos);
    end;
  end;

  function CheckTime: Boolean;
  const
    HoursPart = 0;
    MinutesPart = 1;
    SecondsPart = 2;
  var
    Parts: TArray<string>;
  begin
    Result := False;
    if not LFoundTime then
    begin
      Parts := Token.Split([Char(':')]);
      if Length(Parts) = 3 then
      begin
        if (Parts[HoursPart].Length = 1) or (Parts[HoursPart].Length = 2) then
          if not TryStrToInt(Parts[HoursPart], LHours) or (LHours > 23) then
            Exit;

        if (Parts[MinutesPart].Length = 1) or (Parts[MinutesPart].Length = 2)
        then
          if not TryStrToInt(Parts[MinutesPart], LMinutes) or (LMinutes > 59)
          then
            Exit;

        if (Parts[SecondsPart].Length = 1) or (Parts[SecondsPart].Length = 2)
        then
          if not TryStrToInt(Parts[SecondsPart], LSeconds) or (LSeconds > 59)
          then
            Exit;

        LFoundTime := True;
        Result := True;
      end;
    end;
  end;

  function CheckDayOfMonth: Boolean;
  begin
    Result := False;
    if not LFoundDayOfMonth then
    begin
      if (Token.Length = 1) or (Token.Length = 2) then
        if TryStrToInt(Token, LDayOfMonth) and (LDayOfMonth >= 1) and
          (LDayOfMonth <= 31) then
        begin
          LFoundDayOfMonth := True;
          Result := True;
        end;
    end;
  end;

  function CheckMonth: Boolean;
  const
    Months: array [1 .. 12] of string = ('Jan', 'Feb', 'Mar', 'Apr', 'May',
      'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'); // do not localize
  var
    I: Integer;
  begin
    Result := False;
    if not LFoundMonth then
    begin
      for I := 1 to 12 do
        if SameText(Token, Months[I]) then
        begin
          LMonth := I;
          LFoundMonth := True;
          Result := True;
          Break;
        end;
    end;
  end;

  function CheckYear: Boolean;
  begin
    Result := False;
    if not LFoundYear then
    begin
      if (Token.Length = 2) or (Token.Length = 4) then
        if TryStrToInt(Token, LYear) then
        begin
          if (LYear >= 70) and (LYear <= 99) then
            LYear := LYear + 1900
          else if (LYear >= 0) and (LYear <= 69) then
            LYear := LYear + 2000;

          if LYear > 1600 then
          begin
            LFoundYear := True;
            Result := True;
          end;
        end;
    end;
  end;

begin
  LFoundTime := False;
  LFoundDayOfMonth := False;
  LFoundMonth := False;
  LFoundYear := False;
  Pos := 0;
  Len := AStrDate.Length;

  while Pos < Len do
  begin
    CleanDelimiters;
    Token := ReadToken;

    if CheckTime then
      Continue;

    if CheckDayOfMonth then
      Continue;

    if CheckMonth then
      Continue;

    if CheckYear then
      Continue;

    if LFoundTime and LFoundDayOfMonth and LFoundMonth and LFoundYear then
      Break;
  end;

  if LFoundTime and LFoundDayOfMonth and LFoundMonth and LFoundYear then
  begin
    if TryEncodeDate(LYear, LMonth, LDayOfMonth, LDate) and
      TryEncodeTime(LHours, LMinutes, LSeconds, 0, LTime) then
    begin
      LDate := LDate + LTime;
      Result := TTimeZone.Local.ToLocalTime(LDate);
      if Result = 0 then
        // To avoid to create a session cookie if the expire date is in the delphi date limit
        Result := 1;
    end
    else
      Result := 0;
  end
  else
    Result := 0;
end;



Вызываем
Код: pascal
1.
2.
  LTime := StrExpiresToDateTime('11.11.5187 5:24:11');
  ShowMessage(DateTimeToStr(LTime));



И получаем 30.12.1899

Почему он, мне возвращал текущую дату.. Это уже другой разговор... Этот момент я не отследил...
Эта функция работает верно.
Нельзя туда передавать 11.11.5187 5:24:11. У нее формат даты другой, согласно RFC. надо так, как указано в Cookies
Код: pascal
1.
a := StrExpiresToDateTime('10-Nov-5187 19:51:35 GMT');


Вернет 10.11.5187
Ищите ошибку в другом.
...
Рейтинг: 0 / 0
22 сообщений из 22, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Невозможность получения куков, в том числе NetHTTPClient
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]