Wednesday, April 15, 2020

POST GET Lazarus-IDE * slanje i prijem podataka sa i na server * koristi enkripciju

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;


//------------------>
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.

https://medium.com/@marcusfernstrm/create-a-web-scraper-with-freepascal-lazarus-ffe644f8c34


fphttpclient

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

Коментар: