https://forum.lazarus.freepascal.org/index.php?topic=39806.0
function ReadURL(url:string):string;
begin
with TFPHTTPClient.Create(nil) do
try
ReadURL:= Get('https://api.bitfinex.com/v1/ticker/btcusd');
finally
Free;
end;
end;
//------------------>
with TFPHTTPClient.Create(nil) do
try
SimplePost(); // or Post();
finally
Free;
end;
https://svn.freepascal.org/svn/fpc/tags/release_3_0_0/packages/fcl-web/src/base/fphttpclient.pp
//------------------>
Procedure Post(const URL: string; const Response: TStream);
Procedure Post(const URL: string; Response : TStrings);
Procedure Post(const URL: string; const LocalFileName: String);
function Post(const URL: string) : String;
Class Procedure SimplePost(const URL: string; const Response: TStream);
Class Procedure SimplePost(const URL: string; Response : TStrings);
Class Procedure SimplePost(const URL: string; const LocalFileName: String);
Class function SimplePost(const URL: string) : String;
//------------------>
uses
Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,IdHTTP;
function StringToHex(S: String): string;
var I: Integer;
begin
Result:= '';
for I := 1 to length (S) do
Result:= Result+IntToHex(ord(S[i]),2);
end;
function HexToString(H: String): String;
var I: Integer;
begin
Result:= '';
for I := 1 to length (H) div 2 do
Result:= Result+Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));
end;
function GetDosOutput(CommandLine: string; Work: string = 'C:\Windows\System32'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
//------------------>
https://medium.com/@marcusfernstrm/create-a-web-scraper-with-freepascal-lazarus-ffe644f8c34
function ReadURL(url:string):string;
begin
with TFPHTTPClient.Create(nil) do
try
ReadURL:= Get('https://api.bitfinex.com/v1/ticker/btcusd');
finally
Free;
end;
end;
//------------------>
with TFPHTTPClient.Create(nil) do
try
SimplePost(); // or Post();
finally
Free;
end;
https://svn.freepascal.org/svn/fpc/tags/release_3_0_0/packages/fcl-web/src/base/fphttpclient.pp
//------------------>
Procedure Post(const URL: string; const Response: TStream);
Procedure Post(const URL: string; Response : TStrings);
Procedure Post(const URL: string; const LocalFileName: String);
function Post(const URL: string) : String;
Class Procedure SimplePost(const URL: string; const Response: TStream);
Class Procedure SimplePost(const URL: string; Response : TStrings);
Class Procedure SimplePost(const URL: string; const LocalFileName: String);
Class function SimplePost(const URL: string) : String;
//------------------>
uses
Windows, Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,IdHTTP;
function StringToHex(S: String): string;
var I: Integer;
begin
Result:= '';
for I := 1 to length (S) do
Result:= Result+IntToHex(ord(S[i]),2);
end;
function HexToString(H: String): String;
var I: Integer;
begin
Result:= '';
for I := 1 to length (H) div 2 do
Result:= Result+Char(StrToInt('$'+Copy(H,(I-1)*2+1,2)));
end;
function GetDosOutput(CommandLine: string; Work: string = 'C:\Windows\System32'): string;
var
SA: TSecurityAttributes;
SI: TStartupInfo;
PI: TProcessInformation;
StdOutPipeRead, StdOutPipeWrite: THandle;
WasOK: Boolean;
Buffer: array[0..255] of AnsiChar;
BytesRead: Cardinal;
WorkDir: string;
Handle: Boolean;
begin
Result := '';
with SA do begin
nLength := SizeOf(SA);
bInheritHandle := True;
lpSecurityDescriptor := nil;
end;
CreatePipe(StdOutPipeRead, StdOutPipeWrite, @SA, 0);
try
with SI do
begin
FillChar(SI, SizeOf(SI), 0);
cb := SizeOf(SI);
dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
wShowWindow := SW_HIDE;
hStdInput := GetStdHandle(STD_INPUT_HANDLE); // don't redirect stdin
hStdOutput := StdOutPipeWrite;
hStdError := StdOutPipeWrite;
end;
WorkDir := Work;
Handle := CreateProcess(nil, PChar('cmd.exe /C ' + CommandLine),
nil, nil, True, 0, nil,
PChar(WorkDir), SI, PI);
CloseHandle(StdOutPipeWrite);
if Handle then
try
repeat
WasOK := ReadFile(StdOutPipeRead, Buffer, 255, BytesRead, nil);
if BytesRead > 0 then
begin
Buffer[BytesRead] := #0;
Result := Result + Buffer;
end;
until not WasOK or (BytesRead = 0);
WaitForSingleObject(PI.hProcess, INFINITE);
finally
CloseHandle(PI.hThread);
CloseHandle(PI.hProcess);
end;
finally
CloseHandle(StdOutPipeRead);
end;
end;
//------------------>
unit main;{$mode objfpc}{$H+}interfaceuses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, fphttpclient, regexpr;type{ TForm1 }TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); procedure downloadBook(bookname: String); privatepublicend;var Form1: TForm1;implementation{$R *.lfm}{ TForm1 }const baseUrl = 'https://books.goalkicker.com/';var targetDirectory: AnsiString;procedure TForm1.Button1Click(Sender: TObject); var page, bookname: AnsiString; re: TRegExpr; begin targetDirectory := GetUserDir + 'downloads' + DirectorySeparator + 'GoalKickerBooks' + DirectorySeparator;if Not DirectoryExists(targetDirectory) then CreateDir(targetDirectory);// Grab the base page page := TFPHTTPClient.SimpleGet(baseUrl);// Find all book urls re := TRegExpr.Create('<a href="([\w]+)/"'); try if re.Exec(page) then begin bookname := re.Match[1]; downloadBook(bookname); while re.ExecNext do begin bookname := re.Match[1]; downloadBook(bookname); Application.ProcessMessages; end; end;Memo1.Append(''); Memo1.Append('All books downloaded'); finally re.Free; end; end;procedure TForm1.downloadBook(bookname: String); var page: AnsiString; re: TRegExpr; begin // Get page page := TFPHTTPClient.SimpleGet(baseUrl + bookname + '/index.html');// Grab PDF url re := TRegExpr.Create('location.href=''([\w]+.pdf)'''); try if re.Exec(page) then begin Memo1.Append('Downloading ' + baseUrl + bookname + '/' + re.Match[1]); TFPHTTPClient.SimpleGet(baseUrl + bookname + '/' + re.Match[1], targetDirectory + re.Match[1]); end; finally re.Free; end; end;end.
fphttpclient
Contents
[hide]Overview
fphttpclient is supplied with FPC as part of the fcl-web package, and can be used by itself as well.
HTTPS (TLS/SSL)
Since April 2014, the trunk/development fphttpclient supports SSL/TLS connections using the OpenSSL library (will ship with version 2.8.0 and above). This requires the OpenSSL .so/.dll/.dylib library/libraries to be installed (e.g. present in your application or system directory on Windows).
- If you do not use client side certificates, just specifying the proper port (e.g. 443 for https) is enough to enable TLS/SSL as long as you have OpenSSL libraries installed (or e.g. in the application directory)
- If you want to use e.g. a client side certificate, do something like this:
uses ...ssockets, sslsockets..
// Callback for setting up SSL client certificate
procedure TSSLHelper.SSLClientCertSetup(Sender: TObject; const UseSSL: Boolean;
out AHandler: TSocketHandler);
begin
AHandler := nil;
if UseSSL and (FClientCertificate <> '') then
begin
// Only set up client certificate if needed.
// If not, let normal fphttpclient flow create
// required socket handler
AHandler := TSSLSocketHandler.Create;
// Example: use your own client certificate when communicating with the server:
(AHandler as TSSLSocketHandler).Certificate.FileName := FClientCertificate;
end;
end;
//... and in your TFPHTTPClient creation:
myclient := TFPHTTPClient.Create(nil);
if FClientCertificate <> '' then
myclient.OnGetSocketHandler := @SSLClientCertSetup;
Examples
Examples are included in your FPC directory: packages/fcl-web/examples/
Apart from those, please see below:
Get body of a web page via HTTP protocol
uses fphttpclient;
Var
S : String;
begin
With TFPHttpClient.Create(Nil) do
try
S := Get(ParamStr(1));
finally
Free;
end;
Writeln('Got : ',S);
end.
If you want to write even fewer lines of code, in FPC 2.7.1 you can use the class method:
s := TFPCustomHTTPClient.SimpleGet('http://a_site/a_page');
Download a file via HTTP protocol
Let's show you the simplest example using HTTP only. This example retrieves just an html page and writes it to the screen.
It uses one of the class Get methods of TfpHttpClient. You don't need to create and free the class. There are several overloads for e.g. TStrings or TStream (file) as well:
program dl_fphttp_a;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses
fphttpclient;
begin
writeln(TFPHttpClient.SimpleGet('http://example.com'));
end.
That's all! For simple purposes this will suffice. You can even use it for HTTPS, which needs just the inclusion of two units:
program dl_fphttp_b;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses
fphttpclient,
fpopenssl,
openssl;
begin
writeln(TFPHttpClient.SimpleGet('https://freepascal.org'));
end.
This really is all there is to do in simple scenarios, usually if you have enough control.
But there are some caveats with this code. The foremost one being that this code does not allow for redirects. Let me demo that:
program dl_fphttp_redirect_error;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses
sysutils, fphttpclient, fpopenssl, openssl;
begin
try
writeln(TFPHttpClient.SimpleGet('https://google.com'));
except on E:EHttpClient do
writeln(e.message) else raise;
end;
end.
Because the Google URL uses redirects, there is an exception: "Unexpected response status code: 301". In such a case we need more control, which I will show you in the next example:
program dl_fphttp_c;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses
classes,
fphttpclient,
fpopenssl,
openssl;
var
Client: TFPHttpClient;
begin
{ SSL initialization has to be done by hand here }
InitSSLInterface;
Client := TFPHttpClient.Create(nil);
try
{ Allow redirections }
Client.AllowRedirect := true;
writeln(Client.Get('https://google.com/'));
finally
Client.Free;
end;
end.
You see this requires slightly more code, but it is still a very small program. Well, now we go to the last example, which downloads any file and saves it to disk. You can use it as a template for your own code, it demonstrates almost everything you need.
program dl_fphttp_d;
{$mode delphi}{$ifdef windows}{$apptype console}{$endif}
uses
sysutils,
classes,
fphttpclient,
fpopenssl,
openssl;
const
Filename = 'testdownload.txt';
var
Client: TFPHttpClient;
FS: TStream;
SL: TStringList;
begin
{ SSL initialization has to be done by hand here }
InitSSLInterface;
Client := TFPHttpClient.Create(nil);
FS := TFileStream.Create(Filename,fmCreate or fmOpenWrite);
try
try
{ Allow redirections }
Client.AllowRedirect := true;
Client.Get('https://google.com/',FS);
except
on E: EHttpClient do
writeln(E.Message)
else
raise;
end;
finally
FS.Free;
Client.Free;
end;
{ Test our file }
if FileExists(Filename) then
try
SL := TStringList.Create;
SL.LoadFromFile(Filename);
writeln(SL.Text);
finally
SL.Free;
end;
end.
Upload a file using POST
Use TFPHTTPClient.FileFormPost()
uses fphttpclient;
Var
Respo: TStringStream;
S : String;
begin
With TFPHttpClient.Create(Nil) do
try
Respo := TStringStream.Create('');
FileFormPost('http://example.com/upload.php','PostFilenameParam (ex. 'file')',edtSourceFile.Text,Respo);
S := Respo.DataString;
Respo.Destroy;
finally
Free;
end;
end.
Form data and encoding
FormPost(const URL: string; FormData: TStrings; const Response: TStream);
FormPost(const URL, FormData: string; const Response: TStream);
If you pass FormData as TStrings the FormPost procedure performs EncodeURLElement but if you pass FormData as simple string to FormPost, then EncodeURLElement is not performed.
There is no difference in the behaviour if the data in FormData does not need to be encoded, but there is different behaviour for strings which include characters which are not allowed (eg '@', '=', etc).
Get external IP address
If your computer is connected to the internet via a LAN (cabled or wireless), the IP address of your network card most probably is not your external IP address.
You can retrieve your external IP address from e.g. your router or an external site. The code below tries to get it from an external site (thanks to JoStudio on the forum for the inspiration: [1]):
{$mode objfpc}{$H+}
uses
Classes, SysUtils, fphttpclient, RegexPr;
function GetExternalIPAddress: string;
var
HTTPClient: TFPHTTPClient;
IPRegex: TRegExpr;
RawData: string;
begin
try
HTTPClient := TFPHTTPClient.Create(nil);
IPRegex := TRegExpr.Create;
try
//returns something like:
{
<html><head><title>Current IP Check</title></head><body>Current IP Address: 44.151.191.44</body></html>
}
RawData:=HTTPClient.Get('http://checkip.dyndns.org');
// adjust for expected output; we just capture the first IP address now:
IPRegex.Expression := RegExprString('\b\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}\b');
//or
//\b(?:\d{1,3}\.){3}\d{1,3}\b
if IPRegex.Exec(RawData) then
begin
result := IPRegex.Match[0];
end
else
begin
result := 'Got invalid results getting external IP address. Details:'+LineEnding+
RawData;
end;
except
on E: Exception do
begin
result := 'Error retrieving external IP address: '+E.Message;
end;
end;
finally
HTTPClient.Free;
IPRegex.Free;
end;
end;
begin
writeln('External IP address:');
writeln(GetExternalIPAddress);
end.
No comments:
Post a Comment
Коментар: