#27

Author: Mercury13

Examples/Easy_Http/PhotoInfo/f_Main.dfm

@@ -6,7 +6,7 @@ object fmMain: TfmMain
   BorderStyle = bsSingle
   Caption = 'File upload demo'
   ClientHeight = 200
-  ClientWidth = 309
+  ClientWidth = 321
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
@@ -46,15 +46,15 @@ object fmMain: TfmMain
   object edUrl: TEdit
     Left = 37
     Top = 8
-    Width = 257
+    Width = 272
     Height = 21
     TabOrder = 1
     Text = 'http://localhost/php_curl/photoinfo/action.php'
   end
   object memoResponse: TMemo
     Left = 15
     Top = 97
-    Width = 282
+    Width = 294
     Height = 95
     TabOrder = 0
   end
@@ -94,10 +94,19 @@ object fmMain: TfmMain
     TabOrder = 5
     OnClick = btSynthMemoryClick
   end
+  object btCloneDemo: TButton
+    Left = 216
+    Top = 35
+    Width = 93
+    Height = 25
+    Caption = 'ICurl.Clone demo'
+    TabOrder = 6
+    OnClick = btCloneDemoClick
+  end
   object od: TOpenDialog
     Filter = 'Images (*.jpg; *.jpeg; *.png)|*.jpg; *.jpeg; *.png'
     Options = [ofHideReadOnly, ofPathMustExist, ofFileMustExist, ofEnableSizing]
-    Left = 264
-    Top = 8
+    Left = 24
+    Top = 108
   end
 end

Examples/Easy_Http/PhotoInfo/f_Main.pas

@@ -18,12 +18,14 @@   TfmMain = class(TForm)
     btSynthStream: TButton;
     od: TOpenDialog;
     btSynthMemory: TButton;
+    btCloneDemo: TButton;
     procedure btHardClick(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure btEasyClick(Sender: TObject);
     procedure btSynthStreamClick(Sender: TObject);
     procedure btSynthMemoryClick(Sender: TObject);
+    procedure btCloneDemoClick(Sender: TObject);
   private
     { Private declarations }
     stream : TRawByteStream;
@@ -84,6 +86,29 @@ function TfmMain.GetFile(
   Exit(true);
 end;
 
+procedure TfmMain.btCloneDemoClick(Sender: TObject);
+var
+  curl1, curl2 : ICurl;
+  fname : string;
+  ftype : RawByteString;
+begin
+  // It is BAD code!! — it is just an illustration that options are copied.
+  // cur1 and curl2 share streams, so problems will rise when we use them
+  // simultaneously, or destroy curl1 prematurely.
+  if not GetFile(fname, ftype) then Exit;
+
+  curl1 := CurlGet;
+  curl1.SetRecvStream(stream, [csfAutoRewind]);
+  curl1.SetUrl(edUrl.Text);
+  curl1.SetOpt(CURLOPT_POST, true);
+
+  curl1.Form := CurlGetForm.AddFile('photo', fname, ftype);
+
+  curl2 := curl1.Clone;
+  curl2.Perform;
+  memoResponse.Text := UTF8ToString(stream.Data);
+end;
+
 procedure TfmMain.btEasyClick(Sender: TObject);
 var
   curl : ICurl;

Src/Curl.Easy.pas

@@ -130,19 +130,20 @@ interface
     function GetResponseCode : longint;
 
     ///  Makes an exact copy, e.g. for multithreading.
+    ///  @warning  Receiver, sender and header streams will be shared,
+    ///        but not auto-destroyed. Form, together with its streams,
+    ///        will be shared. So it is wise to replace all streams with unique
+    ///        copies for each clone.
+    ///  @warning  String lists assigned via SetXXX are shared and,
+    ///        as they are ref-counted, destroyed when the last reference
+    ///        disappears. For large objects assigned via SetOpt the programmer
+    ///        should bother about destruction for himself.
     function Clone : ICurl;
 
     property Form : ICurlForm read GetForm write SetForm;
   end;
 
   TEasyCurlImpl = class (TInterfacedObject, ICurl)
-  private
-    type
-      TSListEntry = record
-        str : RawByteString;
-        entry : TCurlSList;
-      end;
-      OaSListEntry = array of TSListEntry;
   private
     fHandle : TCurlHandle;
     fCustomHeaders, fPostQuote, fTelnetOptions, fPreQuote,
@@ -290,6 +291,9 @@ constructor ECurlError.Create(aObject : TEasyCurlImpl; aCode : TCurlCode);
 constructor TEasyCurlImpl.Create;
 begin
   inherited;
+  fSendStream.Init;
+  fRecvStream.Init;
+  fHeaderStream.Init;
   fHandle := curl_easy_init;
   if fHandle = nil then
     raise ECurlInternal.Create('[TEasyCurlImpl.Create] Cannot create cURL object.');
@@ -298,12 +302,24 @@ constructor TEasyCurlImpl.Create;
 constructor TEasyCurlImpl.Create(aSource : TEasyCurlImpl);
 begin
   inherited Create;
-  fSendStream.Init;
-  fRecvStream.Init;
-  fHeaderStream.Init;
+  // Streams
+  fSendStream.InitFrom(aSource.fSendStream);
+  fRecvStream.InitFrom(aSource.fRecvStream);
+  fHeaderStream.InitFrom(aSource.fHeaderStream);
+  // Handle
   fHandle := curl_easy_duphandle(aSource.fHandle);
   if fHandle = nil then
     raise ECurlInternal.Create('[TEasyCurlImpl.Create(TEasyCurlImpl)] Cannot clone cURL object.');
+  // Copy settings!
+  fForm := aSource.fForm;
+  fCustomHeaders := aSource.fCustomHeaders;
+  fPostQuote := aSource.fPostQuote;
+  fTelnetOptions := aSource.fTelnetOptions;
+  fPreQuote := aSource.fPreQuote;
+  fHttp200Aliases := aSource.fHttp200Aliases;
+  fMailRcpt := aSource.fMailRcpt;
+  fResolveList := aSource.fResolveList;
+  fProxyHeader := aSource.fProxyHeader;
 end;
 
 destructor TEasyCurlImpl.Destroy;

Src/Curl.Interfaces.pas

@@ -25,6 +25,7 @@   TCurlAutoStream = record
     Flags : TCurlStreamFlags;
 
     procedure Init;  inline;
+    procedure InitFrom(const v : TCurlAutoStream);
     procedure Assign(aStream : TStream; aFlags : TCurlStreamFlags);
     procedure RewindRead;
     procedure RewindWrite;
@@ -173,4 +174,12 @@ procedure TCurlAutoStream.Assign(aStream : TStream; aFlags : TCurlStreamFlags);
     then Flags := aFlags;
 end;
 
+
+procedure TCurlAutoStream.InitFrom(const v : TCurlAutoStream);
+begin
+  Stream := v.Stream;
+  Flags := v.Flags - [csfAutoDestroy];
+end;
+
+
 end.

readme.md

@@ -65,4 +65,6 @@ Forms (one field is set in a simple way, the other in more complex one).
 
 File uploading: disk file (2 ways), memory buffer, stream.
 
+ICurl cloning demo (not particularly good, it is more an illustration that Clone works).
+
 Please copy `php_curl` directory to a PHP-capable web server.