pas2js/packages/rtl/src/Rtl.BrowserLoadHelper.pas

{
    This file is part of the Pas2JS run time library.
    Copyright (c) 2023 by Michael Van Canneyt
    
    Loader helper for TStringList, usable in the browser.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}
{$IFNDEF FPC_DOTTEDUNITS}
unit Rtl.BrowserLoadHelper;
{$ENDIF}

{$mode objfpc}

interface

uses
{$IFDEF FPC_DOTTEDUNITS}
  System.Classes, System.SysUtils, JSApi.JS, BrowserApi.Web;
{$ELSE}
  Classes, SysUtils, JS, Web;
{$ENDIF}  

Type
  { TBrowserLoadHelper }

  TBrowserLoadHelper = Class (TLoadHelper)
  Public
    Class Procedure LoadText(aURL : String; aSync : Boolean; aOnLoaded : TTextLoadedCallBack; aOnError : TErrorCallBack); override;
    Class Procedure LoadBytes(aURL : String; aSync : Boolean; aOnLoaded : TBytesLoadedCallBack; aOnError : TErrorCallBack); override;
  end;

implementation

{ TBrowserLoadHelper }

class procedure TBrowserLoadHelper.LoadText(aURL: String; aSync: Boolean; aOnLoaded: TTextLoadedCallBack; aOnError: TErrorCallBack);

  function doFetchOK(response : JSValue) : JSValue;

  var
    Res : TJSResponse absolute response;

  begin
    Result:=False;
    If (Res.status<>200) then
      begin
      If Assigned(aOnError) then
        aOnError('Error '+IntToStr(Res.Status)+ ': '+Res.StatusText)
      end
    else
      Res.Text._then(
        function (value : JSValue) : JSValue
          begin
          aOnLoaded(String(value));
          end
      );
  end;

  function doFetchFail(response : JSValue) : JSValue;

  begin
    Result:=False;
    aOnError('Error 999: unknown error: '+TJSJSON.Stringify(response));
  end;

begin
  if ASync then
    Window.Fetch(aURl)._then(@DoFetchOK).catch(@DoFetchFail)
  else
    With TJSXMLHttpRequest.new do
      begin
      open('GET', aURL, False);
      AddEventListener('load',Procedure (oEvent: JSValue)
        begin
        aOnLoaded(responseText);
        end
      );
      AddEventListener('error',Procedure (oEvent: JSValue)
        begin
        if Assigned(aOnError) then
          aOnError(TJSError(oEvent).Message);
        end
      );
      send();
      end;
end;

class procedure TBrowserLoadHelper.LoadBytes(aURL: String; aSync: Boolean; aOnLoaded: TBytesLoadedCallBack; aOnError: TErrorCallBack);

  function doFetchFail(response : JSValue) : JSValue;

  begin
    Result:=False;
    if assigned(aOnError) then
      if isObject(Response) and (TJSObject(Response) is TJSError) then
        aOnError('Error 999: '+TJSError(Response).Message)
      else
        aOnError('Error 999: unknown error');
  end;


  function doFetchOK(response : JSValue) : JSValue;

  var
    Res : TJSResponse absolute response;

  begin
    Result:=False;
    If (Res.status<>200) then
      begin
      If Assigned(aOnError) then
        aOnError('Error '+IntToStr(Res.Status)+ ': '+Res.StatusText)
      end
    else
      Res.Blob._then(
        function (value : JSValue) : JSValue
          begin
          TJSBlob(Value).ArrayBuffer._then(function(arr : JSValue) : JSValue
            begin
            aOnLoaded(TJSArrayBuffer(arr))
            end
          ).Catch(@DoFetchFail);
          end
        );
  end;


  function StringToArrayBuffer(str : string) : TJSArrayBuffer;

  Var
    i,l : Integer;

  begin
    L:=Length(str);
    Result:=TJSArrayBuffer.New(l*2); // 2 bytes for each char
    With TJSUint16Array.New(Result) do
      for i:=1 to L do
        Values[i-1]:=Ord(Str[i]);
  end;

begin
  if ASync then
    Window.Fetch(aURl)._then(@DoFetchOK).catch(@DoFetchFail)
  else
    With TJSXMLHttpRequest.new do
      begin
      open('GET', aURL, False);
      AddEventListener('load',Procedure (oEvent: JSValue)
        begin
        if (Status<>200) then
          begin
          if assigned(aOnError) then
            aOnError('Error '+IntToStr(Status)+ ': '+StatusText)
          end  
        else
          aOnLoaded(StringToArrayBuffer(responseText));
        end
      );
      AddEventListener('error',Procedure (oEvent: JSValue)
        begin
        if Assigned(aOnError) then
          aOnError(TJSError(oEvent).Message);
        end
      );
      send();
      end;
end;

initialization
  SetLoadHelperClass(TBrowserLoadHelper);
end.