Rtl.BrowserLoadHelper.pas 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155
  1. unit Rtl.BrowserLoadHelper;
  2. {$mode objfpc}
  3. interface
  4. uses
  5. Classes, SysUtils, JS, Web;
  6. Type
  7. { TBrowserLoadHelper }
  8. TBrowserLoadHelper = Class (TLoadHelper)
  9. Public
  10. Class Procedure LoadText(aURL : String; aSync : Boolean; OnLoaded : TTextLoadedCallBack; OnError : TErrorCallBack); override;
  11. Class Procedure LoadBytes(aURL : String; aSync : Boolean; OnLoaded : TBytesLoadedCallBack; OnError : TErrorCallBack); override;
  12. end;
  13. implementation
  14. { TBrowserLoadHelper }
  15. class procedure TBrowserLoadHelper.LoadText(aURL: String; aSync: Boolean; OnLoaded: TTextLoadedCallBack; OnError: TErrorCallBack);
  16. function doFetchOK(response : JSValue) : JSValue;
  17. var
  18. Res : TJSResponse absolute response;
  19. begin
  20. Result:=False;
  21. If (Res.status<>200) then
  22. begin
  23. If Assigned(OnError) then
  24. OnError('Error '+IntToStr(Res.Status)+ ': '+Res.StatusText)
  25. end
  26. else
  27. Res.Text._then(
  28. function (value : JSValue) : JSValue
  29. begin
  30. OnLoaded(String(value));
  31. end
  32. );
  33. end;
  34. function doFetchFail(response : JSValue) : JSValue;
  35. begin
  36. Result:=False;
  37. OnError('Error 999: unknown error');
  38. end;
  39. begin
  40. if ASync then
  41. Window.Fetch(aURl)._then(@DoFetchOK).catch(@DoFetchFail)
  42. else
  43. With TJSXMLHttpRequest.new do
  44. begin
  45. open('GET', aURL, False);
  46. AddEventListener('load',Procedure (oEvent: JSValue)
  47. begin
  48. OnLoaded(responseText);
  49. end
  50. );
  51. AddEventListener('error',Procedure (oEvent: JSValue)
  52. begin
  53. if Assigned(OnError) then
  54. OnError(TJSError(oEvent).Message);
  55. end
  56. );
  57. send();
  58. end;
  59. end;
  60. class procedure TBrowserLoadHelper.LoadBytes(aURL: String; aSync: Boolean; OnLoaded: TBytesLoadedCallBack; OnError: TErrorCallBack);
  61. function doFetchFail(response : JSValue) : JSValue;
  62. begin
  63. Result:=False;
  64. if isObject(Response) and (TJSObject(Response) is TJSError) then
  65. OnError('Error 999: '+TJSError(Response).Message)
  66. else
  67. OnError('Error 999: unknown error');
  68. end;
  69. function doFetchOK(response : JSValue) : JSValue;
  70. var
  71. Res : TJSResponse absolute response;
  72. begin
  73. Result:=False;
  74. If (Res.status<>200) then
  75. begin
  76. If Assigned(OnError) then
  77. OnError('Error '+IntToStr(Res.Status)+ ': '+Res.StatusText)
  78. end
  79. else
  80. Res.Blob._then(
  81. function (value : JSValue) : JSValue
  82. begin
  83. TJSBlob(Value).ArrayBuffer._then(function(arr : JSValue) : JSValue
  84. begin
  85. OnLoaded(TJSArrayBuffer(arr))
  86. end
  87. ).Catch(@DoFetchFail);
  88. end
  89. );
  90. end;
  91. function StringToArrayBuffer(str : string) : TJSArrayBuffer;
  92. Var
  93. i,l : Integer;
  94. begin
  95. L:=Length(str);
  96. Result:=TJSArrayBuffer.New(l*2); // 2 bytes for each char
  97. With TJSUint16Array.New(Result) do
  98. for i:=1 to L do
  99. Values[i-1]:=Ord(Str[i]);
  100. end;
  101. begin
  102. if ASync then
  103. Window.Fetch(aURl)._then(@DoFetchOK).catch(@DoFetchFail)
  104. else
  105. With TJSXMLHttpRequest.new do
  106. begin
  107. open('GET', aURL, False);
  108. AddEventListener('load',Procedure (oEvent: JSValue)
  109. begin
  110. if Status<>200 then
  111. OnError('Error '+IntToStr(Status)+ ': '+StatusText)
  112. else
  113. OnLoaded(StringToArrayBuffer(responseText));
  114. end
  115. );
  116. AddEventListener('error',Procedure (oEvent: JSValue)
  117. begin
  118. if Assigned(OnError) then
  119. OnError(TJSError(oEvent).Message);
  120. end
  121. );
  122. send();
  123. end;
  124. end;
  125. initialization
  126. SetLoadHelperClass(TBrowserLoadHelper);
  127. end.