Skip to content

Commit

Permalink
#27
Browse files Browse the repository at this point in the history
  • Loading branch information
Mercury13 committed Mar 28, 2015
1 parent 1f538e9 commit 03e1e5d
Show file tree
Hide file tree
Showing 5 changed files with 76 additions and 15 deletions.
19 changes: 14 additions & 5 deletions Examples/Easy_Http/PhotoInfo/f_Main.dfm
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
25 changes: 25 additions & 0 deletions Examples/Easy_Http/PhotoInfo/f_Main.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
36 changes: 26 additions & 10 deletions Src/Curl.Easy.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -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.');
Expand All @@ -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;
Expand Down
9 changes: 9 additions & 0 deletions Src/Curl.Interfaces.pas
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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.
2 changes: 2 additions & 0 deletions readme.md
Original file line number Diff line number Diff line change
Expand Up @@ -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.

0 comments on commit 03e1e5d

Please sign in to comment.