paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 10:48:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fetch example, demo how to reconstruct object response

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-06-24 17:18:33 +02:00
parent d0a5b61b80
commit a49c0f6e0c
3 changed files with 245 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
packages/wasm-job/examples/fetch/loadstrings.lpi Normal file
View File

@ -0,0 +1,70 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="loadstrings"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="loadstrings.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="stringshelper"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="loadstrings.wasm" ApplyConventions="False"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Subtarget Value="browser"/>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="False"/>
</Debugging>
<Options>
<ExecutableType Value="Library"/>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

171
packages/wasm-job/examples/fetch/loadstrings.lpr Normal file
View File

@ -0,0 +1,171 @@
library stringshelper;
{$mode objfpc}
{$h+}
uses nothreads, classes, sysutils, variants, job.js;
Type
// Define the necessary interfaces from the browser APIs.
IJSResponse = interface(IJSObject)
['{0B705D5E-D166-325F-8AD5-004BD5C7161F}']
function text: IJSPromise; // Promise<USVString>
end;
IJSWindow = interface(IJSObject)
function fetch(const aInput: UnicodeString): IJSPromise; // Promise<Response>
end;
{ TJSResponse }
TJSResponse = class(TJSObject,IJSResponse)
Protected
function text: IJSPromise; overload; // Promise<USVString>
class function Cast(aObj : IJSObject): IJSResponse;
end;
{ TJSWindow }
TJSWindow = class(TJSObject,IJSWindow)
function fetch(const aInput: UnicodeString): IJSPromise; // Promise<Response>
end;
TLoadHelper = class(TObject)
FURL: string;
FStrings: TStrings;
constructor Create(aURL: string; AList: TStrings);
procedure LoadFromURL;
function LoadOK(const aRes: Variant): Variant;
function LoadJsonOK(const aRes: Variant): Variant;
end;
TStringsHelper = class helper for TStrings
procedure LoadFromURL(const aURL: string);
end;
TApp = Class(TObject)
private
sl: TStringList;
public
procedure Run;
end;
var
JSWindow : IJSWindow;
{ TJSWindow }
function TJSWindow.fetch(const aInput: UnicodeString): IJSPromise;
begin
Result:=InvokeJSObjectResult('fetch',[aInput],TJSPromise) as IJSPromise;
end;
function TJSResponse.text: IJSPromise;
begin
Result:=InvokeJSObjectResult('text',[],TJSPromise) as IJSPromise;
end;
class function TJSResponse.Cast(aObj: IJSObject): IJSResponse;
begin
Result:=TJSResponse.JOBCast(aObj);
end;
{ TLoadHelper }
constructor TLoadHelper.Create(aURL: string; aList: TStrings);
begin
FURL := aURL;
FStrings := AList;
end;
procedure TLoadHelper.LoadFromURL;
begin
try
JSWindow.fetch(FURL)._then(@LoadOK);
except
Writeln('Aaaarrghhhh, error fetching :( :(');
Free; // Need to free ourselves
end;
end;
function TLoadHelper.LoadOK(const aRes: Variant): Variant;
var
aUnknown : IUnknown;
aObject : IJSObject;
res: IJSResponse;
begin
try
//fetch returns a Response object, need to call text()/json() first
writeln('got response object');
if vartype(aRes)=varUnknown then
Writeln('Got interface valued variant');
aUnknown:=aRes;
Writeln('Got interface from variant');
aObject:=aUnknown as IJSObject;
Writeln('Got IJSObject interface from variant');
res := TJSResponse.Cast(aObject);
Writeln('Got TJSResponse interface from IJSObject');
Writeln('request text');
res.text._then(@LoadJsonOK);
Writeln('Done requesting text');
except
On E : Exception do
begin
Writeln('Exception : ',E.ClassName,' : ',E.Message);
//something went wrong, free
Free;
end;
end;
end;
function TLoadHelper.LoadJsonOK(const aRes: Variant): Variant;
var
S : String;
begin
writeln('got text result. Dumping stringlist');
if vartype(aRes) = varOleStr then
begin
FStrings.Text:=varToStr(aRes);
Writeln('----');
for S in FStrings do
Writeln(S);
Writeln('----');
Writeln('Normally you would have a callback here to indicate the text is loaded');
end;
Free;
end;
{ TStringsHelper }
procedure TStringsHelper.LoadFromURL(const aURL: string);
begin
with TLoadHelper.Create(aURL, Self) do
LoadFromURL;
end;
{ TApp }
procedure TApp.Run;
begin
try
sl := TStringList.Create;
sl.LoadFromURL('lorem.txt');
except
on E: Exception do
Writeln(e.Message);
end;
end;
var
App : TApp;
begin
JSWindow:=TJSWindow.JOBCreateGlobal('window');
App:=TApp.Create;
App.Run;
end.

4
packages/wasm-job/examples/fetch/lorem.txt Normal file
View File

@ -0,0 +1,4 @@
Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.
Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat.
Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur.
Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.