From 03e1e5d9e0ce598381e3b2d6bfbee6ef00528838 Mon Sep 17 00:00:00 2001 From: Mercury Date: Sat, 28 Mar 2015 18:13:27 +0200 Subject: [PATCH] #27 --- Examples/Easy_Http/PhotoInfo/f_Main.dfm | 19 +++++++++---- Examples/Easy_Http/PhotoInfo/f_Main.pas | 25 +++++++++++++++++ Src/Curl.Easy.pas | 36 ++++++++++++++++++------- Src/Curl.Interfaces.pas | 9 +++++++ readme.md | 2 ++ 5 files changed, 76 insertions(+), 15 deletions(-) diff --git a/Examples/Easy_Http/PhotoInfo/f_Main.dfm b/Examples/Easy_Http/PhotoInfo/f_Main.dfm index bab88ce..81306b7 100644 --- a/Examples/Easy_Http/PhotoInfo/f_Main.dfm +++ b/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,7 +46,7 @@ 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' @@ -54,7 +54,7 @@ object fmMain: TfmMain 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 diff --git a/Examples/Easy_Http/PhotoInfo/f_Main.pas b/Examples/Easy_Http/PhotoInfo/f_Main.pas index 238b72a..05d6d8a 100644 --- a/Examples/Easy_Http/PhotoInfo/f_Main.pas +++ b/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; diff --git a/Src/Curl.Easy.pas b/Src/Curl.Easy.pas index 724a875..3056963 100644 --- a/Src/Curl.Easy.pas +++ b/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; diff --git a/Src/Curl.Interfaces.pas b/Src/Curl.Interfaces.pas index 2a3b364..cc20b64 100644 --- a/Src/Curl.Interfaces.pas +++ b/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. diff --git a/readme.md b/readme.md index 20e5d94..56883bd 100644 --- a/readme.md +++ b/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. \ No newline at end of file