Skip to content

Commit 214faf8

Browse files
committed
Added option to fetch website content.
1 parent 55cf0fe commit 214faf8

File tree

6 files changed

+171
-58
lines changed

6 files changed

+171
-58
lines changed

README.md

+1-1
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
![Example Application](https://github.com/dryas/LazSimpleHTTPsGet/blob/main/doc/example_screenshot.png)
44

5-
LazSimpleHTTPsGet is a simple asynchronous (threads) file download Unit with progress indicator for Lazarus/Free Pascal. It supports downloads from HTTP and HTTPS sources and the developer can choose if he wants to use Ararat Synapse or FCL/TFPHttpClient in the background. That said it supports OpenSSLv1 and OpenSSLv3.
5+
LazSimpleHTTPsGet is a simple asynchronous (threads) file download and content fetch (e.g. website source, JSON, XML etc.) Unit with progress indicator for Lazarus/Free Pascal. It supports downloads from HTTP and HTTPS sources and the developer can choose if he wants to use Ararat Synapse or FCL/TFPHttpClient in the background. That said it supports OpenSSLv1 and OpenSSLv3.
66

77
The Unit has been tested with Windows but should also work on other Systems which are supported by FCL/TFPHttpClient or Synapse (Linux, Mac etc.).
88

doc/example_screenshot.png

958 Bytes
Loading

example/Example.lpi

+3
Original file line numberDiff line numberDiff line change
@@ -98,6 +98,9 @@
9898
<Item>
9999
<PackageName Value="FCL"/>
100100
</Item>
101+
<Item>
102+
<PackageName Value="laz_synapse"/>
103+
</Item>
101104
<Item>
102105
<PackageName Value="LCL"/>
103106
</Item>

example/main.lfm

+20-12
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,20 @@
11
object MainForm: TMainForm
22
Left = 350
3-
Height = 269
3+
Height = 348
44
Top = 250
55
Width = 517
66
BorderStyle = bsSingle
77
Caption = 'LazSimpleHTTPsGet'
8-
ClientHeight = 269
8+
ClientHeight = 348
99
ClientWidth = 517
1010
OnDestroy = FormDestroy
1111
object GroupBox1: TGroupBox
1212
Left = 8
13-
Height = 256
13+
Height = 336
1414
Top = 8
1515
Width = 504
1616
Caption = 'Download File Example'
17-
ClientHeight = 236
17+
ClientHeight = 316
1818
ClientWidth = 500
1919
TabOrder = 0
2020
object DownloadProgressLabel: TLabel
@@ -33,7 +33,7 @@ object MainForm: TMainForm
3333
end
3434
object StatusInfoMemo: TMemo
3535
Left = 112
36-
Height = 64
36+
Height = 152
3737
Top = 112
3838
Width = 374
3939
ReadOnly = True
@@ -43,9 +43,9 @@ object MainForm: TMainForm
4343
object DownloadBtn: TButton
4444
Left = 112
4545
Height = 33
46-
Top = 192
47-
Width = 184
48-
Caption = 'Start Download'
46+
Top = 272
47+
Width = 104
48+
Caption = 'Download File'
4949
TabOrder = 2
5050
OnClick = DownloadBtnClick
5151
end
@@ -78,15 +78,23 @@ object MainForm: TMainForm
7878
Caption = 'Progress:'
7979
end
8080
object StopBtn: TButton
81-
Left = 302
81+
Left = 374
8282
Height = 33
83-
Top = 192
84-
Width = 184
83+
Top = 272
84+
Width = 112
8585
Caption = 'Stop Download'
86-
Enabled = False
8786
TabOrder = 4
8887
OnClick = StopBtnClick
8988
end
89+
object FetchBtn: TButton
90+
Left = 240
91+
Height = 33
92+
Top = 272
93+
Width = 104
94+
Caption = 'Fetch Content'
95+
TabOrder = 5
96+
OnClick = FetchBtnClick
97+
end
9098
end
9199
object SaveDialog: TSaveDialog
92100
Left = 40

example/main.pas

+62-10
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ interface
4141
{ TMainForm }
4242

4343
TMainForm = class(TForm)
44+
FetchBtn: TButton;
4445
StopBtn: TButton;
4546
DownloadBtn: TButton;
4647
DownloadProgressLabel: TLabel;
@@ -52,11 +53,12 @@ TMainForm = class(TForm)
5253
ProgressStaticLabel: TLabel;
5354
URLEdit: TEdit;
5455
UrlStaticLabel: TLabel;
56+
procedure FetchBtnClick(Sender: TObject);
5557
procedure StopBtnClick(Sender: TObject);
5658
procedure DownloadBtnClick(Sender: TObject);
5759
procedure FormDestroy(Sender: TObject);
5860
procedure UpdateProgress(ALen, APos: Int64; AHRLen, AHRPos: String);
59-
procedure UpdateStatus(Status: TStatus; ResponseCode: Integer; Msg: String);
61+
procedure UpdateStatus(Status: TStatus; ResponseCode: Integer; Msg: String; Body: String);
6062
private
6163
LazSimpleHTTPsGet: TLazSimpleHTTPsGet;
6264
public
@@ -78,9 +80,12 @@ procedure TMainForm.DownloadBtnClick(Sender: TObject);
7880
Filename: String;
7981
begin
8082
try
81-
if not Assigned(LazSimpleHTTPsGet) then
83+
if Length(URLEdit.Text) > 0 then
8284
begin
83-
LazSimpleHTTPsGet := TLazSimpleHTTPsGet.Create();
85+
if not Assigned(LazSimpleHTTPsGet) then
86+
begin
87+
LazSimpleHTTPsGet := TLazSimpleHTTPsGet.Create();
88+
end;
8489

8590
Filename := LazSimpleHTTPsGet.GetFileNameFromURL(URLEdit.Text);
8691
SaveDialog.FileName := Filename;
@@ -90,14 +95,20 @@ procedure TMainForm.DownloadBtnClick(Sender: TObject);
9095
LazSimpleHTTPsGet.Filename := SaveDialog.FileName;
9196
LazSimpleHTTPsGet.OnProgress := @UpdateProgress;
9297
LazSimpleHTTPsGet.onStatus := @UpdateStatus;
93-
LazSimpleHTTPsGet.Start;
94-
DownloadBtn.Enabled := False;
95-
StopBtn.Enabled := True;
98+
if LazSimpleHTTPsGet.Get then
99+
begin
100+
DownloadBtn.Enabled := False;
101+
StopBtn.Enabled := True;
102+
end
103+
else
104+
begin
105+
ShowMessage('Download already running');
106+
end;
96107
end;
97108
end
98109
else
99110
begin
100-
ShowMessage('Download already running');
111+
ShowMessage('Please enter a url');
101112
end;
102113
except
103114
on E: Exception do
@@ -112,7 +123,6 @@ procedure TMainForm.StopBtnClick(Sender: TObject);
112123
begin
113124
if Assigned(LazSimpleHTTPsGet) then
114125
begin
115-
LazSimpleHTTPsGet.Stop;
116126
StatusInfoMemo.Append('Download stopped');
117127
FreeAndNil(LazSimpleHTTPsGet);
118128
DownloadBtn.Enabled := True;
@@ -122,12 +132,46 @@ procedure TMainForm.StopBtnClick(Sender: TObject);
122132
end;
123133
end;
124134

135+
procedure TMainForm.FetchBtnClick(Sender: TObject);
136+
begin
137+
try
138+
if Length(URLEdit.Text) > 0 then
139+
begin
140+
if not Assigned(LazSimpleHTTPsGet) then
141+
begin
142+
LazSimpleHTTPsGet := TLazSimpleHTTPsGet.Create();
143+
end;
144+
145+
LazSimpleHTTPsGet.URL := URLEdit.Text;
146+
LazSimpleHTTPsGet.OnProgress := @UpdateProgress;
147+
LazSimpleHTTPsGet.onStatus := @UpdateStatus;
148+
if LazSimpleHTTPsGet.Fetch then
149+
begin
150+
DownloadBtn.Enabled := False;
151+
StopBtn.Enabled := True;
152+
end
153+
else
154+
begin
155+
ShowMessage('Download already running');
156+
end;
157+
end
158+
else
159+
begin
160+
ShowMessage('Please enter a url');
161+
end;
162+
except
163+
on E: Exception do
164+
begin
165+
ShowMessage(E.Message);
166+
end;
167+
end;
168+
end;
169+
125170
// Form closed, stop downloads and free and nil LazSimpleHTTPsGet:
126171
procedure TMainForm.FormDestroy(Sender: TObject);
127172
begin
128173
if Assigned(LazSimpleHTTPsGet) then
129174
begin
130-
LazSimpleHTTPsGet.Stop;
131175
FreeAndNil(LazSimpleHTTPsGet);
132176
end;
133177
end;
@@ -146,7 +190,7 @@ procedure TMainForm.UpdateProgress(ALen, APos: Int64; AHRLen, AHRPos: String);
146190
end;
147191

148192
// Status event (download start, done, error):
149-
procedure TMainForm.UpdateStatus(Status: TStatus; ResponseCode: Integer; Msg: String);
193+
procedure TMainForm.UpdateStatus(Status: TStatus; ResponseCode: Integer; Msg: String; Body: String);
150194
begin
151195
if Status = TStatus.sStart then
152196
begin
@@ -155,6 +199,14 @@ procedure TMainForm.UpdateStatus(Status: TStatus; ResponseCode: Integer; Msg: St
155199
else if Status = TStatus.sDone then
156200
begin
157201
StatusInfoMemo.Append('Download done -> (HTTP Status: ' + IntToStr(ResponseCode) + '/' + Msg + ')');
202+
if Length(Body) > 0 then
203+
begin
204+
StatusInfoMemo.Append('-- Body Start ------------------');
205+
StatusInfoMemo.Append(Body);
206+
StatusInfoMemo.Append('-- Body End --------------------');
207+
end;
208+
DownloadBtn.Enabled := True;
209+
StopBtn.Enabled := False;
158210
DownloadProgressLabel.Caption := '-/-';
159211
ProgressBar.Position := 0;
160212
end

0 commit comments

Comments
 (0)