paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 09:27:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

* Demo for OnData and OnHeaders events

Browse Source 
git-svn-id: trunk@26718 -
This commit is contained in:
michael 2014-02-08 10:41:08 +00:00
parent 0fefb74a12
commit c4918b6329
1 changed files with 29 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
packages/fcl-web/examples/httpclient/httpget.pas
View File

@ -10,11 +10,35 @@ Type
{ TTestApp }
TTestApp = Class(Tobject)
procedure DoProgress(Sender: TObject; Const ContentLength, CurrentPos : Int64);
procedure DoHeaders(Sender : TObject);
procedure DoPassword(Sender: TObject; var RepeatRequest: Boolean);
procedure ShowRedirect(ASender : TObject; Const ASrc : String; Var ADest : String);
Procedure Run;
procedure ShowRedirect(ASender : TObject; Const ASrc : String; Var ADest : String);
Procedure Run;
end;
procedure TTestApp.DoHeaders(Sender : TObject);
Var
I : Integer;
begin
Writeln('Response headers received:');
With (Sender as TFPHTTPClient) do
For I:=0 to ResponseHeaders.Count-1 do
Writeln(ResponseHeaders[i]);
end;
procedure TTestApp.DoProgress(Sender: TObject; const ContentLength, CurrentPos: Int64);
begin
If (ContentLength=0) then
Writeln('Reading headers : ',CurrentPos,' Bytes.')
else If (ContentLength=-1) then
Writeln('Reading data (no length available) : ',CurrentPos,' Bytes.')
else
Writeln('Reading data : ',CurrentPos,' Bytes of ',ContentLength);
end;
procedure TTestApp.DoPassword(Sender: TObject; var RepeatRequest: Boolean);
Var
@ -68,11 +92,9 @@ begin
AllowRedirect:=True;
OnRedirect:=@ShowRedirect;
OnPassword:=@DoPassword;
OnDataReceived:=@DoProgress;
OnHeaders:=@DoHeaders;
Get(ParamStr(1),ParamStr(2));
Writeln('Response headers:');
For I:=0 to ResponseHeaders.Count-1 do
Writeln(ResponseHeaders[i]);
finally
Free;
end;