* Improve on ideas of merge request !570

packages/fcl-web/examples/httpclient/httpget.pas

@@ -101,6 +101,7 @@ begin
     end;
   With TFPHTTPClient.Create(Nil) do
     try
+      RequestCookies.Add.Name:='me';
       AllowRedirect:=True;
       OnRedirect:=@ShowRedirect;
       OnPassword:=@DoPassword;

packages/fcl-web/src/base/fphttpclient.pp

@@ -74,6 +74,7 @@ Type
   private
     FDataRead : Int64;
     FContentLength : Int64;
+    FRequestCookies: TCookies;
     FRequestDataWritten : Int64;
     FRequestContentLength : Int64;
     FAllowRedirect: Boolean;
@@ -90,6 +91,7 @@ Type
     FPassword: String;
     FIOTimeout: Integer;
     FConnectTimeout: Integer;
+    FResponseCookies: TCookies;
     FSentCookies,
     FCookies: TStrings;
     FCookieList: TCookies;
@@ -113,6 +115,7 @@ Type
     FTrustedCertsDir: String;
     function CheckContentLength: Int64;
     function CheckTransferEncoding: string;
+    function CreateCookies: TCookies;
     function GetCookies: TStrings;
     function GetCookieList: TCookies;
     function GetProxy: TProxyData;
@@ -123,6 +126,7 @@ Type
     procedure SetHTTPVersion(const AValue: String);
     procedure SetKeepConnection(AValue: Boolean);
     procedure SetProxy(AValue: TProxyData);
+    procedure SetRequestCookies(AValue: TCookies);
     Procedure SetRequestHeaders(const AValue: TStrings);
     procedure SetIOTimeout(AValue: Integer);
     Procedure ExtractHostPort(AURI: TURI; Out AHost: String; Out APort: Word);
@@ -325,9 +329,10 @@ Type
     // Additional headers for request. Host; and Authentication are automatically added.
     Property RequestHeaders : TStrings Read FRequestHeaders Write SetRequestHeaders;
     // Cookies. Set before request to send cookies to server.
-    // After request the property is filled with the cookies sent by the server.
-    Property CookieList : TCookies Read GetCookieList Write SetCookieList;
-    // the implementation was buggy, use CookieList above instead
+    Property RequestCookies : TCookies Read FRequestCookies Write SetRequestCookies;
+    // After request the property is filled with the set-cookies sent by the server.
+    Property ResponseCookies : TCookies Read FResponseCookies;
+    // the implementation was buggy, use RequestCookie/ResponseCookies above instead
     Property Cookies : TStrings Read GetCookies Write SetCookies; deprecated 'use CookieList';
     // Optional body to send (mainly in POST request)
     Property RequestBody : TStream read FRequestBody Write FRequestBody;
@@ -397,11 +402,14 @@ Type
 
 
   TFPHTTPClient = Class(TFPCustomHTTPClient)
+  public
+    Property ResponseCookies;
   Published
     Property KeepConnection;
     Property Connected;
     Property IOTimeout;
     Property ConnectTimeout;
+    Property RequestCookies;
     Property RequestHeaders;
     Property RequestBody;
     Property ResponseHeaders;
@@ -762,8 +770,7 @@ begin
   end;
 end;
 
-Procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String;
-  APort: Integer; UseSSL: Boolean);
+procedure TFPCustomHTTPClient.ReconnectToServer(const AHost: String; APort: Integer; UseSSL: Boolean);
 begin
   DisconnectFromServer;
   ConnectToServer(AHost, APort, UseSSL);
@@ -795,7 +802,7 @@ begin
   Result:=(AHeader<>'') and (Pos(':',AHeader)<>0);
 end;
 
-Function TFPCustomHTTPClient.HasConnectionClose: Boolean;
+function TFPCustomHTTPClient.HasConnectionClose: Boolean;
 begin
   Result := CompareText(GetHeader('Connection'), 'close') = 0;
 end;
@@ -847,15 +854,22 @@ begin
     FRequestHeaders.Delete(FRequestHeaders.IndexOfName('Content-Length'));
   if Assigned(FCookies) then
     begin
-    L:='Cookie: ';
+    L:='';
     For I:=0 to FCookies.Count-1 do
       begin
       If (I>0) then
         L:=L+'; ';
       L:=L+FCookies[i];
-      if AllowHeader(L) then
-        S:=S+L+CRLF;
       end;
+    For I:=0 to FRequestCookies.Count-1 do
+      begin
+      if L<>'' then
+        L:=L+'; ';
+      L:=FRequestCookies[I].Name+'='+FRequestCookies[I].Value;
+      end;
+    L:='Cookie: '+L;
+    if AllowHeader(L) then
+      S:=S+L+CRLF;
     end;
   FreeAndNil(FSentCookies);
   FSentCookies:=FCookies;
@@ -1061,7 +1075,7 @@ function TFPCustomHTTPClient.ReadResponseHeaders: integer;
       If (P=0) then
         P:=Length(S)+1;
       C:=Trim(Copy(S,1,P-1));
-      Cookies.Add(C);
+      FCookies.Add(C);
       System.Delete(S,1,P);
     Until (S='') or Terminated;
   end;
@@ -1085,7 +1099,7 @@ begin
       If StartsText(SetCookie,S) then
         begin
         DoCookies(S);
-        CookieList.AddFromString(S);
+        ResponseCookies.AddFromString(S);
         end;
       end
   Until (S='') or Terminated;
@@ -1180,8 +1194,6 @@ end;
 
 function TFPCustomHTTPClient.GetCookieList: TCookies;
 begin
-  If (FCookieList=Nil) then
-    FCookieList:=TCookies.Create(TCookie);
   Result:=FCookieList;
 end;
 
@@ -1232,8 +1244,14 @@ begin
   Proxy.Assign(AValue);
 end;
 
-Function TFPCustomHTTPClient.ReadResponse(Stream: TStream;
-  const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean): Boolean;
+procedure TFPCustomHTTPClient.SetRequestCookies(AValue: TCookies);
+begin
+  if FRequestCookies=AValue then Exit;
+  FRequestCookies.Assign(AValue);
+end;
+
+function TFPCustomHTTPClient.ReadResponse(Stream: TStream; const AllowedResponseCodes: array of Integer; HeadersOnly: Boolean
+  ): Boolean;
 
   Function Transfer(LB : Integer) : Integer;
 
@@ -1419,8 +1437,7 @@ begin
     end;
 end;
 
-Procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; Out AHost: String;
-  Out APort: Word);
+procedure TFPCustomHTTPClient.ExtractHostPort(AURI: TURI; out AHost: String; out APort: Word);
 Begin
   if ProxyActive then
     begin
@@ -1457,10 +1474,8 @@ begin
     AddHeader('Connection', 'close');
 end;
 
-Procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI;
-  const AMethod: string; AStream: TStream;
-  const AAllowedResponseCodes: array of Integer;
-  AHeadersOnly, AIsHttps: Boolean);
+procedure TFPCustomHTTPClient.DoNormalRequest(const AURI: TURI; const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer; AHeadersOnly, AIsHttps: Boolean);
 Var
   CHost: string;
   CPort: Word;
@@ -1477,10 +1492,8 @@ begin
   End;
 end;
 
-Procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI;
-  const AMethod: string; AStream: TStream;
-  const AAllowedResponseCodes: array of Integer;
-  AHeadersOnly, AIsHttps: Boolean);
+procedure TFPCustomHTTPClient.DoKeepConnectionRequest(const AURI: TURI; const AMethod: string; AStream: TStream;
+  const AAllowedResponseCodes: array of Integer; AHeadersOnly, AIsHttps: Boolean);
 Var
   SkipReconnect: Boolean;
   CHost: string;
@@ -1534,8 +1547,7 @@ begin
   Until SkipReconnect or Terminated;
 end;
 
-Procedure TFPCustomHTTPClient.DoMethod(Const AMethod, AURL: String;
-  Stream: TStream; Const AllowedResponseCodes: Array of Integer);
+procedure TFPCustomHTTPClient.DoMethod(const AMethod, AURL: String; Stream: TStream; const AllowedResponseCodes: array of Integer);
 
 Var
   URI: TURI;
@@ -1568,12 +1580,16 @@ begin
   FResponseHeaders.NameValueSeparator:=':';
   HTTPVersion:='1.1';
   FMaxRedirects:=DefMaxRedirects;
+  FRequestCookies:=CreateCookies;
+  FResponseCookies:=CreateCookies;
 end;
 
 destructor TFPCustomHTTPClient.Destroy;
 begin
   if IsConnected then
     DisconnectFromServer;
+  FreeAndNil(FRequestCookies);
+  FreeAndNil(FResponseCookies);
   FreeAndNil(FProxy);
   FreeAndNil(FCookies);
   FreeAndNil(FSentCookies);
@@ -1582,6 +1598,11 @@ begin
   inherited Destroy;
 end;
 
+function TFPCustomHTTPClient.CreateCookies : TCookies;
+begin
+  Result:=TCookies.Create(TCookie);
+end;
+
 class procedure TFPCustomHTTPClient.AddHeader(HTTPHeaders: TStrings;
   const AHeader, AValue: String);
 
@@ -1640,6 +1661,7 @@ end;
 procedure TFPCustomHTTPClient.ResetResponse;
 
 begin
+  FResponseCookies.Clear;
   FResponseStatusCode:=0;
   FResponseStatusText:='';
   FResponseHeaders.Clear;
@@ -2294,7 +2316,7 @@ begin
     end;
 end;
 
-procedure TFPCustomHTTPClient.FormPost(const URL : String; FormData: RawBytestring; const Response: TStream);
+procedure TFPCustomHTTPClient.FormPost(const URL: String; FormData: RawByteString; const Response: TStream);
 
 begin
   RequestBody:=TRawByteStringStream.Create(FormData);
@@ -2338,7 +2360,7 @@ begin
   Response.Text:=FormPost(URL,FormData);
 end;
 
-function TFPCustomHTTPClient.FormPost(const URL : String;  Const FormData: RawBytestring): RawByteString;
+function TFPCustomHTTPClient.FormPost(const URL: String; const FormData: RawByteString): RawByteString;
 Var
   SS : TRawByteStringStream;
 begin
@@ -2364,7 +2386,7 @@ begin
   end;
 end;
 
-class procedure TFPCustomHTTPClient.SimpleFormPost(const URL : String; Const FormData: RawByteString; const Response: TStream);
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: String; const FormData: RawByteString; const Response: TStream);
 
 begin
   With Self.Create(nil) do
@@ -2391,7 +2413,7 @@ begin
 end;
 
 
-class procedure TFPCustomHTTPClient.SimpleFormPost(const URL : String; Const FormData: RawBytestring; const Response: TStrings);
+class procedure TFPCustomHTTPClient.SimpleFormPost(const URL: String; const FormData: RawByteString; const Response: TStrings);
 
 begin
   With Self.Create(nil) do
@@ -2416,7 +2438,7 @@ begin
     end;
 end;
 
-class function TFPCustomHTTPClient.SimpleFormPost(const URL: string;Const FormData : RawByteString): RawByteString;
+class function TFPCustomHTTPClient.SimpleFormPost(const URL: String; const FormData: RawByteString): RawByteString;
 
 begin
   With Self.Create(nil) do