Skip to content

Commit 3877e08

Browse files
Mercury13Mercury13
committed
#28 + simple GET URL builder
1 parent 121b2cd commit 3877e08

File tree

9 files changed

+237
-57
lines changed

9 files changed

+237
-57
lines changed

‎Examples/Easy_Http/AplusB_Get/AplusB_Get.dpr‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,10 @@ uses
55
Curl.Lib in '..\..\..\Src\Curl.Lib.pas',
66
Curl.RawByteStream in '..\..\..\Src\Curl.RawByteStream.pas',
77
Curl.Easy in '..\..\..\Src\Curl.Easy.pas',
8-
Curl.Form in '..\..\..\Src\Curl.Form.pas',
98
f_Main in 'f_Main.pas' {fmMain},
109
Curl.Interfaces in '..\..\..\Src\Curl.Interfaces.pas',
11-
Curl.Slist in '..\..\..\Src\Curl.Slist.pas';
10+
Curl.Slist in '..\..\..\Src\Curl.Slist.pas',
11+
Curl.Encoders in '..\..\..\Src\Curl.Encoders.pas';
1212

1313
{$R *.res}
1414

‎Examples/Easy_Http/AplusB_Get/AplusB_Get.dproj‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
<MainSource>AplusB_Get.dpr</MainSource>
77
<Base>True</Base>
88
<Config Condition="'$(Config)'==''">Debug</Config>
9-
<Platform Condition="'$(Platform)'==''">Win32</Platform>
9+
<Platform Condition="'$(Platform)'==''">Win64</Platform>
1010
<TargetedPlatforms>3</TargetedPlatforms>
1111
<AppType>Application</AppType>
1212
</PropertyGroup>
@@ -92,12 +92,12 @@
9292
<DCCReference Include="..\..\..\Src\Curl.Lib.pas"/>
9393
<DCCReference Include="..\..\..\Src\Curl.RawByteStream.pas"/>
9494
<DCCReference Include="..\..\..\Src\Curl.Easy.pas"/>
95-
<DCCReference Include="..\..\..\Src\Curl.Form.pas"/>
9695
<DCCReference Include="f_Main.pas">
9796
<Form>fmMain</Form>
9897
</DCCReference>
9998
<DCCReference Include="..\..\..\Src\Curl.Interfaces.pas"/>
10099
<DCCReference Include="..\..\..\Src\Curl.Slist.pas"/>
100+
<DCCReference Include="..\..\..\Src\Curl.Encoders.pas"/>
101101
<BuildConfiguration Include="Release">
102102
<Key>Cfg_2</Key>
103103
<CfgParent>Base</CfgParent>

‎Examples/Easy_Http/AplusB_Get/f_Main.pas‎

Lines changed: 7 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,7 @@ TfmMain = class(TForm)
2929
implementation
3030

3131
uses
32-
Curl.Interfaces, Curl.Easy, Curl.Form, Curl.Lib, Curl.RawByteStream,
33-
Curl.Slist;
32+
Curl.Interfaces, Curl.Easy, Curl.Lib, Curl.RawByteStream, Curl.Encoders;
3433

3534
{$R *.dfm}
3635

@@ -40,24 +39,20 @@ procedure TfmMain.btAddClick(Sender: TObject);
4039
'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:36.0) Gecko/20100101 Firefox/36.0';
4140
var
4241
curl : ICurl;
43-
form : ICurlForm;
4442
stream : TRawByteStream;
4543
begin
4644
curl := CurlGet;
47-
form := CurlGetForm;
4845
stream := TRawByteStream.Create;
4946

50-
curl.SetUrl(edUrl.Text);
51-
// I tested it on my free hosting — it has a bot protection.
5247
curl.SetUserAgent(UserAgent);
53-
form.Add('a', edA.Text);
54-
form.Add('b', edB.Text);
55-
56-
curl.Form := form;
57-
curl.SetOpt(CURLOPT_HTTPGET, true);
48+
curl.SetUrl(CurlGetBuilder(edUrl.Text)
49+
.Param('a', edA.Text)
50+
.Param('b', edB.Text));
5851
curl.SetRecvStream(stream, [csfAutoDestroy]);
5952
curl.Perform;
60-
memoResponse.Text := string(stream.Data);
53+
memoResponse.Text := string(stream.Data)
54+
+ #13#10#13#10'URL: ' +
55+
string(curl.GetInfo(CURLINFO_EFFECTIVE_URL));
6156
end;
6257

6358
end.

‎Src/Curl.Easy.pas‎

Lines changed: 18 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ interface
3636
procedure SetUrl(aData : PAnsiChar); overload;
3737
procedure SetUrl(aData : RawByteString); overload;
3838
procedure SetUrl(aData : UnicodeString); overload;
39+
procedure SetUrl(aData : ICurlStringBuilder); overload;
3940

4041
/// Sets a CA file for SSL
4142
procedure SetCaFile(aData : PAnsiChar); overload;
@@ -179,6 +180,7 @@ TEasyCurlImpl = class (TInterfacedObject, ICurl)
179180
procedure SetUrl(aData : PAnsiChar); overload; inline;
180181
procedure SetUrl(aData : RawByteString); overload; inline;
181182
procedure SetUrl(aData : UnicodeString); overload; inline;
183+
procedure SetUrl(aData : ICurlStringBuilder); overload; inline;
182184

183185
procedure SetCaFile(aData : PAnsiChar); overload; inline;
184186
procedure SetCaFile(aData : RawByteString); overload; inline;
@@ -225,15 +227,6 @@ TEasyCurlImpl = class (TInterfacedObject, ICurl)
225227
/// reference-counting, use TEasyCurlImpl.Create(someCurl).
226228
function Clone : ICurl;
227229

228-
class function StreamWrite(
229-
var Buffer;
230-
Size, NItems : NativeUInt;
231-
OutStream : pointer) : NativeUInt; cdecl; static;
232-
class function StreamRead(
233-
var Buffer;
234-
Size, NItems : NativeUInt;
235-
OutStream : pointer) : NativeUInt; cdecl; static;
236-
237230
property Form : ICurlCustomForm read GetForm write SetForm;
238231

239232
procedure CloseStreams;
@@ -438,6 +431,11 @@ procedure TEasyCurlImpl.SetUrl(aData : UnicodeString);
438431
SetOpt(CURLOPT_URL, aData);
439432
end;
440433

434+
procedure TEasyCurlImpl.SetUrl(aData : ICurlStringBuilder);
435+
begin
436+
SetUrl(aData.Build);
437+
end;
438+
441439
procedure TEasyCurlImpl.SetCaFile(aData : PAnsiChar);
442440
begin
443441
SetOpt(CURLOPT_CAINFO, aData);
@@ -473,40 +471,25 @@ procedure TEasyCurlImpl.SetUserAgent(aData : UnicodeString);
473471
SetOpt(CURLOPT_USERAGENT, PAnsiChar(UTF8Encode(aData)));
474472
end;
475473

476-
class function TEasyCurlImpl.StreamWrite(
477-
var Buffer;
478-
Size, NItems : NativeUInt;
479-
OutStream : pointer) : NativeUInt; cdecl;
480-
begin
481-
Result := TStream(OutStream).Write(Buffer, Size * NItems);
482-
end;
483-
484-
485-
class function TEasyCurlImpl.StreamRead(
486-
var Buffer;
487-
Size, NItems : NativeUInt;
488-
OutStream : pointer) : NativeUInt; cdecl;
489-
begin
490-
Result := TStream(OutStream).Read(Buffer, Size * NItems);
491-
end;
492-
493-
494474
procedure TEasyCurlImpl.SetRecvStream(aData : TStream; aFlags : TCurlStreamFlags);
495475
begin
496476
fRecvStream.Assign(aData, aFlags);
497477
SetOpt(CURLOPT_WRITEDATA, aData);
498478
if aData = nil
499479
then SetOpt(CURLOPT_WRITEFUNCTION, nil)
500-
else SetOpt(CURLOPT_WRITEFUNCTION, @StreamWrite);
480+
else SetOpt(CURLOPT_WRITEFUNCTION, @CurlStreamWrite);
501481
end;
502482

503483

504484
procedure TEasyCurlImpl.SetSendStream(aData : TStream; aFlags : TCurlStreamFlags);
505485
begin
486+
// Form and sender stream exclude each other
487+
fForm := nil;
506488
fSendStream.Assign(aData, aFlags);
507489
SetOpt(CURLOPT_READDATA, aData);
508-
// Don’t set NULL to read function, as the function may be needed by form
509-
SetOpt(CURLOPT_READFUNCTION, @StreamRead);
490+
if aData = nil
491+
then SetOpt(CURLOPT_READFUNCTION, nil)
492+
else SetOpt(CURLOPT_READFUNCTION, @CurlStreamRead);
510493
end;
511494

512495
procedure TEasyCurlImpl.SetHeaderStream(aData : TStream; aFlags : TCurlStreamFlags);
@@ -515,7 +498,7 @@ procedure TEasyCurlImpl.SetHeaderStream(aData : TStream; aFlags : TCurlStreamFla
515498
SetOpt(CURLOPT_HEADERDATA, aData);
516499
if aData = nil
517500
then SetOpt(CURLOPT_HEADERFUNCTION, nil)
518-
else SetOpt(CURLOPT_HEADERFUNCTION, @StreamWrite);
501+
else SetOpt(CURLOPT_HEADERFUNCTION, @CurlStreamWrite);
519502
end;
520503

521504
function TEasyCurlImpl.GetResponseCode : longint;
@@ -602,12 +585,14 @@ procedure TEasyCurlImpl.SetSslVerifyPeer(aData : boolean);
602585

603586
procedure TEasyCurlImpl.SetForm(aForm : ICurlCustomForm);
604587
begin
588+
// Form and sender stream exclude each other
589+
fSendStream.Destroy;
605590
if aForm <> nil then begin
606591
SetOpt(CURLOPT_HTTPPOST, aForm.RawValue);
607-
if aForm.DoesUseStream
608-
then SetOpt(CURLOPT_READFUNCTION, @StreamRead);
592+
SetOpt(CURLOPT_READFUNCTION, @aForm.ReadFunction);
609593
end else begin
610594
SetOpt(CURLOPT_HTTPPOST, nil);
595+
SetOpt(CURLOPT_READFUNCTION, nil);
611596
end;
612597
fForm := aForm;
613598
end;

‎Src/Curl.Encoders.pas‎

Lines changed: 163 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,163 @@
1+
unit Curl.Encoders;
2+
3+
interface
4+
5+
uses
6+
Curl.Interfaces;
7+
8+
type
9+
TCurlChars = set of AnsiChar;
10+
11+
ICurlGetBuilder = interface (ICurlStringBuilder)
12+
function Param(aName, aValue : RawByteString) : ICurlGetBuilder; overload;
13+
function Param(aName : RawByteString; aValue : string) : ICurlGetBuilder; overload;
14+
end;
15+
16+
function CurlUrlEncodeCustom(
17+
const s : RawByteString;
18+
const aAllowedChars : TCurlChars) : RawByteString; overload;
19+
function CurlUrlEncodeCustom(
20+
const s : UnicodeString;
21+
const aAllowedChars : TCurlChars) : RawByteString; overload;
22+
function CurlUrlEncodeFull(const s : RawByteString) : RawByteString; overload;
23+
function CurlUrlEncodeFull(const s : UnicodeString) : RawByteString; overload;
24+
function CurlUrlEncodeParam(const s : RawByteString) : RawByteString; overload;
25+
function CurlUrlEncodeParam(const s : UnicodeString) : RawByteString; overload;
26+
27+
function CurlGetBuilder(const aUrl : RawByteString) : ICurlGetBuilder; overload;
28+
function CurlGetBuilder(const aUrl : UnicodeString) : ICurlGetBuilder; overload;
29+
30+
const
31+
CurlFullChars = [ '0'..'9', 'A'..'Z', 'a'..'z', '-', '_', '.', '~' ];
32+
CurlParamChars = CurlFullChars +
33+
[ '!', '*', '(', ')', '@', '$', ',', '/', '[', ']' ];
34+
35+
implementation
36+
37+
function CurlUrlEncodeCustom(
38+
const s : RawByteString;
39+
const aAllowedChars : TCurlChars) : RawByteString;
40+
const
41+
hexDigits : array [0..15] of AnsiChar = '0123456789ABCDEF';
42+
var
43+
i, n, n1 : integer;
44+
c : AnsiChar;
45+
begin
46+
n := length(s);
47+
n1 := n;
48+
for i := 1 to length(s) do begin
49+
c := s[i];
50+
if not (c in aAllowedChars)
51+
then Inc(n1, 2);
52+
end;
53+
if n1 = n
54+
then Exit(s);
55+
56+
// Start encoding
57+
SetLength(Result, n1);
58+
n1 := 1;
59+
60+
for i := 1 to n do begin
61+
c := s[i];
62+
if c in aAllowedChars then begin
63+
Result[n1] := c;
64+
Inc(n1);
65+
end else begin
66+
Result[n1] := '%';
67+
Result[n1 + 1] := hexDigits[ord(c) shr 4];
68+
Result[n1 + 2] := hexDigits[ord(c) and $0F];
69+
Inc(n1, 3);
70+
end;
71+
end;
72+
end;
73+
74+
75+
function CurlUrlEncodeCustom(
76+
const s : UnicodeString;
77+
const aAllowedChars : TCurlChars) : RawByteString;
78+
begin
79+
Result := CurlUrlEncodeCustom(UTF8Encode(s), aAllowedChars);
80+
end;
81+
82+
83+
function CurlUrlEncodeFull(const s : RawByteString) : RawByteString;
84+
begin
85+
Result := CurlUrlEncodeCustom(s, CurlFullChars);
86+
end;
87+
88+
function CurlUrlEncodeFull(const s : UnicodeString) : RawByteString;
89+
begin
90+
Result := CurlUrlEncodeCustom(s, CurlFullChars);
91+
end;
92+
93+
94+
function CurlUrlEncodeParam(const s : RawByteString) : RawByteString;
95+
begin
96+
Result := CurlUrlEncodeCustom(s, CurlParamChars);
97+
end;
98+
99+
100+
function CurlUrlEncodeParam(const s : UnicodeString) : RawByteString; overload;
101+
begin
102+
Result := CurlUrlEncodeCustom(s, CurlParamChars);
103+
end;
104+
105+
///// TCurlGetBuilder //////////////////////////////////////////////////////////
106+
107+
108+
type
109+
TCurlGetBuilder = class (TInterfacedObject, ICurlGetBuilder)
110+
private
111+
fUrl : RawByteString;
112+
fHasParam : boolean;
113+
public
114+
constructor Create(aUrl : RawByteString);
115+
function Build : RawByteString;
116+
function Param(aName, aValue : RawByteString) : ICurlGetBuilder; overload;
117+
function Param(aName : RawByteString; aValue : string) : ICurlGetBuilder; overload;
118+
end;
119+
120+
121+
constructor TCurlGetBuilder.Create(aUrl : RawByteString);
122+
const
123+
Question : RawByteString = '?';
124+
begin
125+
inherited Create;
126+
fUrl := aUrl;
127+
fHasParam := (Pos(Question, aUrl) <> 0);
128+
end;
129+
130+
131+
function TCurlGetBuilder.Build : RawByteString;
132+
begin
133+
Result := fUrl;
134+
end;
135+
136+
function TCurlGetBuilder.Param(aName, aValue : RawByteString) : ICurlGetBuilder;
137+
var
138+
c : AnsiChar;
139+
begin
140+
if fHasParam
141+
then c := '&'
142+
else c := '?';
143+
fUrl := fUrl + (c + CurlUrlEncodeParam(aName) + '=' + CurlUrlEncodeParam(aValue));
144+
fHasParam := true;
145+
Result := Self;
146+
end;
147+
148+
function TCurlGetBuilder.Param(aName : RawByteString; aValue : string) : ICurlGetBuilder;
149+
begin
150+
Result := Param(aName, UTF8Encode(aValue));
151+
end;
152+
153+
function CurlGetBuilder(const aUrl : RawByteString) : ICurlGetBuilder;
154+
begin
155+
Result := TCurlGetBuilder.Create(aUrl);
156+
end;
157+
158+
function CurlGetBuilder(const aUrl : UnicodeString) : ICurlGetBuilder;
159+
begin
160+
Result := CurlGetBuilder(UTF8Encode(aUrl));
161+
end;
162+
163+
end.

‎Src/Curl.Form.pas‎

Lines changed: 5 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ TCurlStreamStorage = class (TInterfacedObject, IRewindable)
102102
procedure Store(aStream : TStream; aFlags : TCurlStreamFlags);
103103
procedure RewindStreams; virtual;
104104
procedure CloseStreams; virtual;
105-
function DoesUseStream : boolean;
105+
function ReadFunction : EvCurlRead;
106106
end;
107107

108108
constructor TCurlStreamStorage.Create;
@@ -153,9 +153,11 @@ procedure TCurlStreamStorage.CloseStreams;
153153
end;
154154
end;
155155

156-
function TCurlStreamStorage.DoesUseStream : boolean;
156+
function TCurlStreamStorage.ReadFunction : EvCurlRead;
157157
begin
158-
Result := fDoesUseStream;
158+
if fDoesUseStream
159+
then Result := @CurlStreamRead
160+
else Result := nil;
159161
end;
160162

161163

0 commit comments

Comments
 (0)