[Pas2js] THttpRequest non visual component for pas2js

[warleyalex]

This is an example of a generic non-graphical component THTTPRequest for
Pas2JS.
How to use:
a) Just drag n' drop the THttpRequest component into lazarus designer.
ensure you set correctly the values in the Object Inspector, when you
serialize the component you'll get something like this:

  with WebHttpRequest1 do begin
    Name:='WebHttpRequest1';
    URL:='http:\\jsonplaceholder.typicode.com\albums';
    Method:=mGet;
    UserName:='User';
    Password:='synopse';
    Timeout:=0;
    with Params do begin
      Clear;
      Add('param1=valor1');
      Add('param2=valor2');
    end;
    with RequestHeaders do begin
      Clear;
      Add('Content-Type=text/plain');
      Add('Cache-Control=no-cache');
    end;
    with RequestContent do begin
      Clear;
      Add('User=User');
      Add('Password=synopse');
    end;
    OnResponse:=@WebHttpRequest1Response;
    WebHttpRequest1.DesignInfo:=19857474;     // --> what this doing here
  end;

b) Double click at the OnResponse event, and type this:

procedure TWebForm1.WebHttpRequest1Response(Sender: TObject; AResponse:
String);
var
  js: TJSON;
  ja: TJSONArray;
  jo: TJSONObject;
   i: JSValue;

begin
  js := TJSON.Create;
  try
    ja := js.Parse(AResponse);
    console.log('Retrieved items:' + IntToStr(ja.GetCount));
    for i:= 0 to ja.GetCount - 1 do
    begin
      jo := ja.GetItem(i);
      //WebListBox1.FItems.Add(jo.Get('title'));
      console.log(jo.Get('title'));
    end;
  finally
    js.Free;
  end;
end;  

c) In some part of your code, you must "execute" this http request, for
instance, at the button click or on form Create/LoadLFMValues method.

WebHttpRequest1.Execute;

d) look at the console

=========>> BEGIN  CODE<<=============
unit uHTTP;

{$MODE objfpc}{$H+}

interface

uses
  Classes, SysUtils, Web, JS;

type
  THTTPResponseEvent = procedure(Sender: TObject; aResponse: string) of
object;
  THTTPAbortEvent = procedure(Sender: TObject) of object;
  THttpResponse = procedure(Sender: TObject; aResponse: string) of object;
  THTTPRequestMethod = (mGet, mPost, mHead, mPut, mDelete);

type
  TJSONValue = class(TObject)
  end;

type
  { TJSONObject }
  TJSONObject = class(TJSONValue)
  private
    { private declarations }
    fjo: TJSObject;
  protected
    { protected declarations }
  public
    { public declarations }
    function Get(Name: string): string;
  published
    { published declarations }
  end;

type
  { TJSONArray }
  TJSONArray = class(TJSONObject)
  private
    { private declarations }
    fja: TJSObject;
  protected
    { protected declarations }
  public
    { public declarations }
    function GetItem(index: JSValue): TJSONObject; overload;
    function GetCount: Integer;
  published
    { published declarations }
  end;

type
  { TJSON }
  TJSON = class(TObject)
  private
    { private declarations }
  protected
    { protected declarations }
  public
    { public declarations }
    function Parse(s: string): TJSONArray;
  published
    { published declarations }
  end;

  {╔══════════════════════════════════════════════╗
    ║ THttpRequest non visual component for pas2js                    ║
    ╚══════════════════════════════════════════════╝ }
type
  { THttpRequest }
  THttpRequest = class(TComponent)
  private
    FReq: TJSXMLHttpRequest;
    FURL: string;
    FMeth: THTTPRequestMethod;
    FTimeout: Integer;
    FParams: TStrings;
    FReqHeaders: TStrings;
    FReqContent: TStrings;
    FRespHeaders: TStrings;
    FRespContent: TStrings;
    FUserName: string;
    FPassword: string;
    FStatusCode: Integer;
    FOnResponse: THTTPResponseEvent;
    FOnAbort: THTTPAbortEvent;	
  protected
    function DoHandleResponse(Event: TJSEvent): boolean;
    function DoHandleAbort(Event: TJSEvent): boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetParams(const AValue: TStrings);
    procedure SetReqHeaders(const AValue: TStrings);
    procedure SetReqContent(const AValue: TStrings);	
    procedure Execute; virtual;
    property ResponseHeaders: TStrings read FRespHeaders;
    property ResponseContent: TStrings read FRespContent;
    property StatusCode: Integer read FStatusCode;	
  published
    { inform the URL of the request }
    property URL: string read FURL write FURL;
    { inform the Http request method type }
    property Method: THTTPRequestMethod read FMeth write FMeth;
    { inform the username to use for the request (optional) }
    property UserName: string read FUserName write FUserName;
    { inform the password to use for the request (optional) }
    property Password: string read FPassword write FPassword;
    { inform the timeout for the Http request(in ms), whereas 0 means no
timeout }
    property Timeout: Integer read FTimeout write FTimeout;
    { inform extra URL parameters( key=value ) }
    property Params: TStrings read FParams write SetParams;
    { inform extra request headers besides the basic headers }
    property RequestHeaders: TStrings read FReqHeaders write SetReqHeaders;
    { inform extra content to use with the Http request (mPost method) }
    property RequestContent: TStrings read FReqContent write SetReqContent;
    { event fired when the request is completed }
    property OnResponse: THTTPResponseEvent read FOnResponse write
FOnResponse;
    { event fired when the request is aborted }
    property OnAbort: THTTPAbortEvent read FOnAbort write FOnAbort;
  end;

implementation

{ THttpResquest }

constructor THttpRequest.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FParams := TStringList.Create;

  FReqHeaders := TStringList.Create;
  FReqHeaders.NameValueSeparator := ':';

  FReqContent := TStringList.Create;
  FRespHeaders := TStringList.Create;

  FRespHeaders.NameValueSeparator := ':';
  FRespContent := TStringList.Create;
end;

destructor THttpRequest.Destroy;
begin
  FParams.Free;
  FParams := nil;

  FReqHeaders.Free;
  FReqHeaders := nil;

  FReqContent.Free;
  FReqContent := nil;

  FRespHeaders.Free;
  FRespHeaders := nil;

  FRespContent.Free;
  FRespContent := nil;

  FReq := nil;
  inherited Destroy;
end;

procedure THttpRequest.SetParams(const AValue: TStrings);
begin
  FParams.Assign(AValue);
end;

procedure THttpRequest.SetReqHeaders(const AValue: TStrings);
begin
  FReqHeaders.Assign(AValue);
end;

procedure THttpRequest.SetReqContent(const AValue: TStrings);
begin
  FReqContent.Assign(AValue);
end;

function THttpRequest.DoHandleResponse(Event: TJSEvent): boolean;
begin
  FRespContent.Text := FReq.responseText;
  FStatusCode := FReq.status;

  if (assigned(FOnResponse)) then
    FOnResponse(Self, FRespContent.Text);
  Result := true;
end;

function THttpRequest.DoHandleAbort(Event: TJSEvent): boolean;
begin
  if (assigned(FOnAbort)) then
    FOnAbort(Self);
  Result := true;
end;

procedure THttpRequest.Execute;
  function Meth: string;
  begin
    case FMeth of
      mGet    : Result := 'get';
      mPost   : Result := 'post';
      mHead  : Result := 'head';
      mPut    : Result := 'put';
      mDelete: Result := 'delete';
    else
      Result := '';
    end;
  end;

  function URI: string;
  var
    j: Integer;
  begin
    Result := FURL;
    if (FParams.Count > 0) then
    begin
      Result := Result + '?' + FParams.Names[0] + '=' +
        encodeURIComponent(FParams.ValueFromIndex[0]);
      for j := 1 to FParams.Count - 1 do
        Result := Result + '&' + FParams.Names[j] + '=' +
          encodeURIComponent(FParams.ValueFromIndex[j]);
    end;
  end;

begin
  FReq := TJSXMLHttpRequest.new;
  FReq.addEventListener('load', @DoHandleResponse);
  FReq.addEventListener('abort', @DoHandleAbort);
  FReq.open(Meth, URI, True, FUserName, FPassword);
    //FReq.setRequestHeader('Cache-Control', 'no-cache');
  FReq.send();
end;

function JSONObjectToString(v: JSValue): string;
begin
  result := string(v) + '';
end;

{ TJSONArray }

function TJSONArray.GetItem(index: JSValue): TJSONObject;
  function str(Index: JSValue): string; external name ' ';
begin
  Result := TJSONObject.Create;
  Result.fjo := TJSObject(fja.Properties[str(index)]);
end;

function TJSONArray.GetCount: Integer;
begin
  Result := TJSArray(fja).Length;
end;

{ TJSONObject }
function TJSONObject.Get(Name: string): string;
var
  jv: JSValue;
begin
  jv := fjo.Properties[Name];
  Result := JSONObjectToString(jv);
end;

{ TJSON }
function TJSON.Parse(s: string): TJSONArray;
var
  O: TJSObject;
begin
  O := TJSObject(TJSJSON.parse(s));
  if isArray(O) then
  begin
    Result := TJSONArray.Create;
    (Result as TJSONArray).fja := O;
  end
  else
  begin
    Result := TJSONArray(TJSONObject.Create);
    Result.fjo := O;
  end;
end;

end.
=========>> END  CODE<<=============



--
Sent from: http://pas2js.38893.n8.nabble.com/