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

* OData and Office365 REST API support

Browse Source 
git-svn-id: trunk@34097 -
This commit is contained in:
michael 2016-07-11 14:39:59 +00:00
parent 1606976cfa
commit 9115dc2521
35 changed files with 175952 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
.gitattributes vendored
View File

@ -6222,6 +6222,38 @@ packages/objcrtl/src/objcrtl20.pas svneol=native#text/plain
packages/objcrtl/src/objcrtliphoneos.pas svneol=native#text/plain
packages/objcrtl/src/objcrtlmacosx.pas svneol=native#text/plain
packages/objcrtl/src/objcrtlutils.pas svneol=native#text/plain
packages/odata/Makefile svneol=native#text/plain
packages/odata/Makefile.fpc svneol=native#text/plain
packages/odata/examples/README.txt svneol=native#text/plain
packages/odata/examples/groups/demousersgroups.lpi svneol=native#text/plain
packages/odata/examples/groups/demousersgroups.pp svneol=native#text/plain
packages/odata/examples/groups/msgraph.ini svneol=native#text/plain
packages/odata/examples/onedrive/demoonedrive.lpi svneol=native#text/plain
packages/odata/examples/onedrive/demoonedrive.pp svneol=native#text/plain
packages/odata/examples/onedrive/msgraph.ini svneol=native#text/plain
packages/odata/examples/v4/testv4.lpi svneol=native#text/plain
packages/odata/examples/v4/testv4.pp svneol=native#text/plain
packages/odata/examples/v4/v4sample.pas svneol=native#text/plain
packages/odata/examples/v4/v4sample.xml svneol=native#text/plain
packages/odata/fpmake.pp svneol=native#text/plain
packages/odata/regen.sh svneol=native#text/plain
packages/odata/src/msgraph.pp svneol=native#text/plain
packages/odata/src/odatabase.pp svneol=native#text/plain
packages/odata/src/odataservice.pp svneol=native#text/plain
packages/odata/src/office365client.pp svneol=native#text/plain
packages/odata/src/sharepoint.pp svneol=native#text/plain
packages/odata/utils/README.txt svneol=native#text/plain
packages/odata/utils/cgs.pas svneol=native#text/plain
packages/odata/utils/convertedmx.lpi svneol=native#text/plain
packages/odata/utils/convertedmx.pp svneol=native#text/plain
packages/odata/utils/csdl.pp svneol=native#text/plain
packages/odata/utils/csdl2pas.pp svneol=native#text/plain
packages/odata/utils/edm.pas svneol=native#text/plain
packages/odata/utils/edmx2pas.pp svneol=native#text/plain
packages/odata/utils/odatacodegen.pp svneol=native#text/plain
packages/odata/utils/ras.pas svneol=native#text/plain
packages/odata/xml/msgraph.xml svneol=native#text/plain
packages/odata/xml/sharepoint.xml svneol=native#text/plain
packages/odbc/Makefile svneol=native#text/plain
packages/odbc/Makefile.fpc svneol=native#text/plain
packages/odbc/Makefile.fpc.fpcmake svneol=native#text/plain

4
packages/fpmake_add.inc
View File

@ -127,4 +127,6 @@
add_libenet(ADirectory+IncludeTrailingPathDelimiter('libenet'));
add_zorba(ADirectory+IncludeTrailingPathDelimiter('zorba'));
add_Google(ADirectory+IncludeTrailingPathDelimiter('googleapi'));
add_fcl_pdf(ADirectory+IncludeTrailingPathDelimiter('fcl-pdf'));
add_fcl_pdf(ADirectory+IncludeTrailingPathDelimiter('fcl-pdf'));
add_odata(ADirectory+IncludeTrailingPathDelimiter('odata'));

2
packages/fpmake_proc.inc
View File

@ -736,3 +736,5 @@ begin
with Installer do
{$include fcl-pdf/fpmake.pp}
end;
{$include odata/fpmake.pp}

2713
packages/odata/Makefile Normal file
View File

File diff suppressed because it is too large Load Diff

102
packages/odata/Makefile.fpc Normal file
View File

@ -0,0 +1,102 @@
#
# Makefile.fpc for running fpmake
#
[package]
name=odata
version=3.1.1
[require]
packages=rtl fpmkunit fcl-base fcl-web
[install]
fpcpackage=y
[default]
fpcdir=../..
[prerules]
FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
ifdef OS_TARGET
FPC_TARGETOPT+=--os=$(OS_TARGET)
endif
ifdef CPU_TARGET
FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
endif
LOCALFPMAKE=./fpmake$(SRCEXEEXT)
[rules]
# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
# Compose general fpmake-parameters
ifdef FPMAKEOPT
FPMAKE_OPT+=$(FPMAKEOPT)
endif
FPMAKE_OPT+=--localunitdir=../..
FPMAKE_OPT+=--globalunitdir=..
FPMAKE_OPT+=$(FPC_TARGETOPT)
FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
FPMAKE_OPT+=--compiler=$(FPC)
FPMAKE_OPT+=-bu
.NOTPARALLEL:
fpmake$(SRCEXEEXT): fpmake.pp
$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
all: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) compile $(FPMAKE_OPT)
smart: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
release: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
debug: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
# most often fail because the dependencies are cleared.
# In case of a clean, simply do nothing
ifeq ($(FPMAKE_BIN_CLEAN),)
clean:
else
clean:
$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
endif
# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
# when the package is compiled using fpcmake prior to running this clean using fpmake
ifeq ($(FPMAKE_BIN_CLEAN),)
distclean: $(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
else
distclean:
ifdef inUnix
{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi; }
else
$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
endif
-$(DEL) $(LOCALFPMAKE)
endif
cleanall: distclean
install: fpmake$(SRCEXEEXT)
ifdef UNIXHier
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
else
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
endif
# distinstall also installs the example-sources and omits the location of the source-
# files from the fpunits.cfg files.
distinstall: fpmake$(SRCEXEEXT)
ifdef UNIXHier
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
else
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
endif
zipinstall: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
zipdistinstall: fpmake$(SRCEXEEXT)
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
zipsourceinstall: fpmake$(SRCEXEEXT)
ifdef UNIXHier
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
else
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
endif

21
packages/odata/examples/README.txt Normal file
View File

@ -0,0 +1,21 @@
group and onedrive demo
-----------------------
These demos demonstrate the new unified Office365 REST API.
For the group and onedrive demos to work, you need
- a Client ID
- a Secret key
- a hosted domain
All on Microsoft Office365 (Azure AD).
The ID and key can be obtained by registering your application in the Azure
AD of your hosted domain.
V4sample
--------
The V4Sample is a demonstration of the sample V4 service on www.odata.org
Not all calls are demonstrated, but enough to get an idea of how it works.

61
packages/odata/examples/groups/demousersgroups.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="OneDrive Demo Command-line Application"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-s 'robby@wisad.be'"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="demousersgroups.pp"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="demousersgroups"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../units/$(TargetCPU)-$(TargetOS)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

206
packages/odata/examples/groups/demousersgroups.pp Normal file
View File

@ -0,0 +1,206 @@
program demousersgroups;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, CustApp, jsonparser, fphttpwebclient, fpoauth2ini,
restbase, odatabase, msgraph, office365client;
type
{ TGroupsDemoApplication }
TGroupsDemoApplication = class(TCustomApplication)
private
FSession,
FLogFile,
FConfig : String;
FCLient : TOffice365Client;
FGS : TService;
FGraph : TGraphService;
FMaxLevel : Integer;
procedure EnsureService;
procedure GetUserGroups(AUser: String);
procedure GetGroupMembers(AGroup : String);
procedure ShowUsers;
procedure ShowGroups;
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp(Msg : String); virtual;
end;
procedure TGroupsDemoApplication.EnsureService;
Var
FIS : TFPOAuth2IniStore;
begin
// Auth client
FCLient:=TOffice365Client.Create(Self);
FClient.WebClient:=TFPHTTPWebClient.Create(Self);
FClient.WebClient.LogFile:=FLogFile;
FClient.AuthHandler:=TAzureADOAuth2Handler.Create(Self);
FIS:=TFPOAuth2IniStore.Create(Self);
FIS.ConfigFileName:=FConfig;
FIS.SessionFileName:=FConfig;
FClient.AuthHandler.Store:=FIS;
FClient.AuthHandler.LoadConfig();
FClient.AuthHandler.LoadSession(FSession);
FClient.AuthHandler.Config.AuthScope:='https://graph.microsoft.com/';
FClient.WebClient.RequestSigner:=FClient.AuthHandler;
FClient.AuthHandler.WebClient:=FClient.WebClient;
// Service
FGS:=TService.Create(Self);
FGS.ServiceURL:='https://graph.microsoft.com/v1.0/';
FGS.APINeedsAuth:=True;
FGS.WebClient:=FClient.WebClient;
// Default container
FGraph:=FGS.GraphService;
end;
procedure TGroupsDemoApplication.GetUserGroups(AUser: String);
Var
DOES : TdirectoryObjectsEntitySet;
L : TdirectoryObjectArray;
D : TdirectoryObject;
U : TUser;
begin
if AUser='' then
U:=FGraph.me
else
begin
U:=FGraph.users.Get(AUser);
U.BasePath:='/users/'+AUser;
end;
DOES:=U.memberOf(FGS);
L:=Does.ListAll('');
For D in L do
begin
Writeln('ID ',D.id,': ',D.additionalProperties.AsJSON);
end;
end;
procedure TGroupsDemoApplication.GetGroupMembers(AGroup: String);
Var
G : TGroup;
DA : TDirectoryObjectArray;
D : TDirectoryObject;
begin
G:=FGraph.groups.get(agroup);
G.BasePath:='/groups/'+G.Id;
DA:=G.members(FGS).ListAll('');
for D in DA do
begin
Writeln('Member ',D.Id,': ',D.additionalProperties.AsJSON);
end;
end;
{ TGroupsDemoApplication }
procedure TGroupsDemoApplication.DoRun;
var
FUser,ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('hl:r:c:s:u:UGg',['help','recurse:','logfile:','config:','session:','user:','users','groups','group']);
if (ErrorMsg<>'') or HasOption('h', 'help') then
WriteHelp(ErrorMsg);
FLogFile:=GetOptionValue('l','logfile');
if FLogFile='' then
FLogFile:=ExtractFilePath(ParamStr(0))+'requests.log';
FConfig:=GetOptionValue('c','config');
if FConfig='' then
FConfig:=ExtractFilePath(ParamStr(0))+'msgraph.ini';
FMaxLevel:=StrToIntDef(GetOptionValue('r','recurse'),3);
FSession:=GetOptionValue('s','session');
FUser:=getOptionValue('u','user');
if (FSession='') then
WriteHelp('Need session');
If FMaxLevel<2 then
FMaxLevel:=2;
EnsureService;
if HasOption('G','groups') then
ShowGroups
else if HasOption('U','users') then
ShowUsers
else if HasOption('g','group') then
GetGroupMembers(GetOptionValue('g','group'))
else
GetUserGroups(FUser);
Terminate;
end;
procedure TGroupsDemoApplication.ShowUsers;
Var
L : TUserArray;
U : TUser;
begin
L:=FGraph.users.ListAll('');
for U in L do
begin
Writeln('User ',U.Id,' : ',U.DisplayName,', givenName:',U.givenName,', email: ',U.mail);
end;
end;
procedure TGroupsDemoApplication.ShowGroups;
Var
L : TGroupArray;
G : TGroup;
begin
L:=FGraph.groups.ListAll('');
for G in L do
begin
Writeln('Group ',G.Id,' : ',G.DisplayName,', Mail:',G.mail);
end;
end;
constructor TGroupsDemoApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TGroupsDemoApplication.Destroy;
begin
inherited Destroy;
end;
procedure TGroupsDemoApplication.WriteHelp(Msg: String);
begin
If Msg<>'' then
Writeln('Error : ',Msg);
Writeln('Usage: ', ExeName, ' -s session [options]');
Writeln('Where options : ');
Writeln('-h --help this help');
Writeln('-c --config config file with session and client data (default msgraph.ini)');
Writeln('-l --logfile config file with session and client data (default requests.log)');
Writeln('-s --session=name session to load from config file');
Writeln('-r --recurse=level maximum recursion level (defult 2)');
Halt(Ord(Msg<>''));
end;
var
Application: TGroupsDemoApplication;
begin
Application:=TGroupsDemoApplication.Create(nil);
Application.Title:='OneDrive Demo Command-line Application';
Application.Run;
Application.Free;
end.

23
packages/odata/examples/groups/msgraph.ini Normal file
View File

@ -0,0 +1,23 @@
[Application]
; Enter your client_id here. You must get it from the AZure AD page where you registered the application
;client_id=
; Enter your client secret (secret key) here. You must get it from the AZure AD page where you registered the application
;client_secret=
redirect_uri=http://localhost:8080/Redirect
DeveloperKey=
OpenIDRealm=
access_type=atOnline
[Provider]
; Enter your HOSTED DOMAIN here, this is the domain registered in Microsoft Azure AD.
HostedDomain=
TokenURL=https://login.windows.net/%HostedDomain%/oauth2/token
AuthURL=https://login.windows.net/%HostedDomain%/oauth2/authorize
AuthScope=https://graph.microsoft.com/
[session_anonymous]
login_hint=
; You can enter an access token or refresh token here.
access_token=
refresh_token=
token_type=Bearer

61
packages/odata/examples/onedrive/demoonedrive.lpi Normal file
View File

@ -0,0 +1,61 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="OneDrive Demo Command-line Application"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-s 'robby@wisad.be'"/>
</local>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="demoonedrive.pp"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="demoonedrive"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../units/$(TargetCPU)-$(TargetOS)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

212
packages/odata/examples/onedrive/demoonedrive.pp Normal file
View File

@ -0,0 +1,212 @@
program demoonedrive;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, CustApp, jsonparser, fphttpwebclient, fpoauth2ini,
restbase, odatabase, msgraph, office365client;
type
{ TOneDriveDemoApplication }
TOneDriveDemoApplication = class(TCustomApplication)
private
FSession,
FLogFile,
FConfig : String;
FGS : TService;
FGraph : TGraphService;
FDrive : TDrive;
FMaxLevel : Integer;
FClient : TOffice365Client;
Procedure DriveItemToTree(ALevel: Integer; AItem: TDriveItem);
procedure EnsureService;
procedure GetItemChildren(ALevel: Integer; R: TDriveItem);
procedure GetDriveItems;
procedure GetShareableLink(D: TDriveItem);
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp(Msg : String); virtual;
end;
procedure TOneDriveDemoApplication.EnsureService;
Var
FIS : TFPOAuth2IniStore;
begin
// Auth client
FClient:=TOffice365Client.Create(Self);
FClient.WebClient:=TFPHTTPWebClient.Create(Self);
FClient.WebClient.LogFile:=FLogFile;
FClient.AuthHandler:=TAzureADOAuth2Handler.Create(Self);
FIS:=TFPOAuth2IniStore.Create(Self);
FIS.ConfigFileName:=FConfig;
FIS.SessionFileName:=FConfig;
FClient.AuthHandler.Store:=FIS;
FClient.AuthHandler.LoadConfig();
FClient.AuthHandler.LoadSession(FSession);
FClient.AuthHandler.Config.AuthScope:='https://graph.microsoft.com/';
FClient.WebClient.RequestSigner:=FClient.AuthHandler;
FClient.AuthHandler.WebClient:=FClient.WebClient;
// Service
FGS:=TService.Create(Self);
FGS.ServiceURL:='https://graph.microsoft.com/v1.0/';
FGS.APINeedsAuth:=True;
FGS.WebClient:=FClient.WebClient;
// Default container
FGraph:=FGS.GraphService;
end;
Procedure TOneDriveDemoApplication.DriveItemToTree(ALevel : Integer; AItem : TDriveItem) ;
Var
S : String;
I : integer;
begin
S:='';
For I:=1 to Alevel do
S:=S+' ';
if Assigned(AItem.folder) then
S:=S+'*- '
else
S:=S+'+- ';
Writeln(S,AItem.Name+' (URL: '+AItem.webUrl+')');
end;
procedure TOneDriveDemoApplication.GetItemChildren(ALevel: Integer;
R: TDriveItem);
Var
AR : TDriveItemArray;
I : Integer;
begin
if Assigned(R.folder) and (R.folder.childCount>0) then
begin
AR:=FDrive.items(FGS).Get(R.id).children(FGS).ListAll('');
For I:=0 to Length(AR)-1 do
begin
DriveItemToTree(ALevel,AR[I]);
if (ALevel<FMaxLevel) then
GetItemChildren(ALevel+1,AR[I]);
end;
end;
end;
procedure TOneDriveDemoApplication.GetDriveItems;
Var
Me : TUser;
R : TDriveItem;
AR : TDriveItemArray;
I,L : Integer;
begin
Me:=FGraph.me;
FDrive:=Me.drive(FGS);
R:=FDrive.root(FGS);
DriveItemToTree(0,R);
// AR:=TDriveItemArray(FGS.ArrayServiceCall(FGS.ServiceURL+'me/drive/root/children',TdriveItem).Data);
AR:=R.children(FGS).ListAll('');
L:=Length(AR);
For I:=0 to L-1 do
begin
DriveItemToTree(1,AR[I]);
if Assigned(AR[I].folder) and (AR[I].folder.childCount>0) then
GetItemChildren(2,AR[I]);
end;
if L>0 then
GetShareableLink(AR[L-1]);
end;
procedure TOneDriveDemoApplication.GetShareableLink(D : TDriveItem);
Var
P : Tpermission;
begin
Writeln('Getting shareable link for item(',D.id, ') : ',D.name);
// By default, the Office365 API doesn't return @odata.id,
// and drive items are contained (i.e. not directly accessible through a entityset)
// so we set the base path manually.
D.BasePath:='/me/drive/items/'+D.ID;
P:=D.createLink(FGS,'view','organization');
try
if not Assigned(P.link) then
Writeln('No permissions link created')
else
Writeln('Shareable URL: ',P.link.webUrl);
finally
P.Free;
end;
end;
{ TOneDriveDemoApplication }
procedure TOneDriveDemoApplication.DoRun;
var
ErrorMsg: String;
begin
// quick check parameters
ErrorMsg:=CheckOptions('hl:r:c:s:',['help','recurse:','logfile:','config:','session:']);
if (ErrorMsg<>'') or HasOption('h', 'help') then
WriteHelp(ErrorMsg);
FLogFile:=GetOptionValue('l','logfile');
if FLogFile='' then
FLogFile:=ExtractFilePath(ParamStr(0))+'requests.log';
FConfig:=GetOptionValue('c','config');
if FConfig='' then
FConfig:=ExtractFilePath(ParamStr(0))+'msgraph.ini';
FMaxLevel:=StrToIntDef(GetOptionValue('r','recurse'),3);
FSession:=GetOptionValue('s','session');
if (FSession='') then
WriteHelp('Need session');
If FMaxLevel<2 then
FMaxLevel:=2;
EnsureService;
GetDriveItems;
Terminate;
end;
constructor TOneDriveDemoApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TOneDriveDemoApplication.Destroy;
begin
inherited Destroy;
end;
procedure TOneDriveDemoApplication.WriteHelp(Msg: String);
begin
If Msg<>'' then
Writeln('Error : ',Msg);
Writeln('Usage: ', ExeName, ' -s session [options]');
Writeln('Where options : ');
Writeln('-h --help this help');
Writeln('-c --config config file with session and client data (default msgraph.ini)');
Writeln('-l --logfile config file with session and client data (default requests.log)');
Writeln('-s --session=name session to load from config file');
Writeln('-r --recurse=level maximum recursion level (defult 2)');
Halt(Ord(Msg<>''));
end;
var
Application: TOneDriveDemoApplication;
begin
Application:=TOneDriveDemoApplication.Create(nil);
Application.Title:='OneDrive Demo Command-line Application';
Application.Run;
Application.Free;
end.

23
packages/odata/examples/onedrive/msgraph.ini Normal file
View File

@ -0,0 +1,23 @@
[Application]
; Enter your client_id here. You must get it from the AZure AD page where you registered the application
;client_id=
; Enter your client secret (secret key) here. You must get it from the AZure AD page where you registered the application
;client_secret=
redirect_uri=http://localhost:8080/Redirect
DeveloperKey=
OpenIDRealm=
access_type=atOnline
[Provider]
; Enter your HOSTED DOMAIN here, this is the domain registered in Microsoft Azure AD.
HostedDomain=
TokenURL=https://login.windows.net/%HostedDomain%/oauth2/token
AuthURL=https://login.windows.net/%HostedDomain%/oauth2/authorize
AuthScope=https://graph.microsoft.com/
[session_anonymous]
login_hint=
; You can enter an access token or refresh token here.
access_token=
refresh_token=
token_type=Bearer

70
packages/odata/examples/v4/testv4.lpi Normal file
View File

@ -0,0 +1,70 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="testv4"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<Units Count="2">
<Unit0>
<Filename Value="testv4.pp"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="v4sample.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="testv4"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../../units/$(TargetCPU)-$(TargetOS)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

337
packages/odata/examples/v4/testv4.pp Normal file
View File

@ -0,0 +1,337 @@
program testv4;
uses classes, sysutils, jsonparser, odatabase, fpjson, fphttpwebclient, custapp, v4sample;
Type
{ TODataV4SampleServiceClientApp }
TODataV4SampleServiceClientApp = Class(TCustomApplication)
Private
FShowExtra : Boolean;
FDoDelete : Boolean;
FSavePhoto : Boolean;
FService:TService;
Protected
Procedure RunDemo;
// Unbound action
Procedure DoResetDataSource;
// Entityset
Procedure DoDumpAirLines;
// Contained entity, GetStream
Procedure DoPhoto(APerson: TPerson; DoSave: Boolean);
// Contained entityset
Procedure DoListFriends(P: TPerson; DeleteLast: Boolean);
// Delete
Procedure DoDeletePerson(P: TPerson);
// Bound Function
Procedure ShowFavoriteAirline(P: TPerson);
// Bound Function
Procedure ShowFriendsTrips(P: TPerson);
// Unbound Function
Procedure ShowNearestAirPort(ALat, ALon: Integer);
Public
Constructor Create(AOwner :TComponent); override;
Destructor Destroy; override;
procedure DoServiceLog(Sender: TObject; const Msg: String);
Procedure DumpExtra(A : TODataObject);
Procedure DoRun; override;
Procedure Usage(Const Msg : String);
end;
Constructor TODataV4SampleServiceClientApp.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FService:=TService.Create(Self);
FService.WebClient:=TFPHTTPWebClient.Create(Self);
StopOnException:=True;
end;
Destructor TODataV4SampleServiceClientApp.Destroy;
begin
FreeAndNil(FService);
inherited Destroy;
end;
procedure TODataV4SampleServiceClientApp.DoServiceLog(Sender: TObject;
const Msg: String);
begin
Writeln(StdErr,'Service log: ',Msg);
end;
Procedure TODataV4SampleServiceClientApp.DumpExtra(A : TODataObject);
Var
I : Integer;
Function PJ(J : TJSONData) : String;
begin
if J.JSONType in [jtArray,jtObject] then
Result:=J.FormatJSON
else
Result:=J.AsString;
end;
begin
if not FShowExtra then
exit;
if Assigned(A.additionalProperties) and (A.additionalProperties.Count>0) then
begin
Writeln(' Additional properties : ');
Writeln(' '+PJ(A.additionalProperties));
end;
if (A.ODataAnnotationCount>0) then
begin
Writeln(' Annotations:');
For I:=0 to A.ODataAnnotationCount-1 do
Writeln(' '+A.ODataAnnotations[i].Key,' : ',PJ(A.ODataAnnotations[i].Value));
end;
end;
Procedure TODataV4SampleServiceClientApp.DoResetDataSource;
begin
Writeln('Resetting data source');
FService.DefaultContainer.ResetDataSource;
end;
Procedure TODataV4SampleServiceClientApp.DoDumpAirLines;
Var
A : TAirline;
AA : TAirlineArray;
I : Integer;
begin
AA:=FService.DefaultContainer.Airlines.ListAll('');
try
Writeln('Number of arlines: ',Length(AA));
For I:=0 to Length(AA)-1 do
begin
A:=AA[i];
// Writeln('Base URL : ',A.BaseURL(FService));
Writeln('Airline ',I+1,' code : ',A.AirlineCode);
Writeln('Airline ',I+1,' name : ',A.Name);
DumpExtra(A);
end;
finally
For I:=0 to Length(AA)-1 do
FreeAndNil(AA[i]);
end;
end;
Procedure TODataV4SampleServiceClientApp.DoDeletePerson(P : TPerson);
begin
Writeln('Attempting to delete person:');
try
Writeln(P.Delete(FService));
except
On EO : EOData do
begin
Writeln('OData error : ',EO.Message);
Writeln('Status code : ',EO.StatusCode,', text : ',EO.StatusText);
If Assigned(EO.Error) then
begin
Writeln('OData error code : ',EO.Error.Code,', message : ',EO.Error.Message);
end;
end;
On E : Exception do
begin
Writeln('General Error : ',E.Message)
end;
end;
end;
Procedure TODataV4SampleServiceClientApp.DoListFriends(P : TPerson; DeleteLast : Boolean);
Var
FES : TPeopleEntitySet;
PA : TPersonArray;
FL : TPerson;
I : integer;
F : TPerson;
begin
FES:=P.Friends(FService);
try
PA:=FES.ListAll('');
I:=0;
for F in PA do
begin
Inc(i);
Writeln('Friend ',I,': FirstName: ',F.FirstName,', LastName: ',F.LastName);
DumpExtra(F);
FL:=F;
end;
If DeleteLast and (FL<>Nil) then
DoDeletePerson(FL);
finally
For I:=0 to Length(PA)-1 do
FreeAndNil(PA[i]);
end;
end;
Procedure TODataV4SampleServiceClientApp.DoPhoto(APerson : TPerson; DoSave: Boolean);
Var
P : TPHoto;
PF : TFileStream;
begin
PF:=Nil;
P:=APerson.Photo(FService);
try
Writeln('Photo ID : ',P.Id,', name : ', P.Name);
DumpExtra(p);
if DoSave then
begin
PF:=TFileStream.Create('photo.jpg',fmCreate);
P.GetStream(FService,'image/jpeg',PF);
Writeln('Saved profile photo to photo.jpg');
end;
finally
P.Free;
PF.Free;
end;
end;
Procedure TODataV4SampleServiceClientApp.ShowFavoriteAirline(P : TPerson);
Var
A : TAirLine;
begin
A:=P.GetFavoriteAirline(FService);
try
Writeln('Favorite Airline:');
Writeln('Code: ',A.AirlineCode);
Writeln('Name: ',A.Name);
DumpExtra(A);
finally
A.Free;
end;
end;
Procedure TODataV4SampleServiceClientApp.ShowFriendsTrips(P : TPerson);
Var
TA : TTripArray;
I : Integer;
begin
TA:=P.GetFriendsTrips(FService,'russellwhyte');
try
For I:=0 to Length(TA)-1 do
Writeln('Trip [',i,'] : ',TA[i].Name);
finally
For I:=0 to Length(TA)-1 do
FreeAndNil(TA[i]);
end;
end;
Procedure TODataV4SampleServiceClientApp.ShowNearestAirPort(ALat,ALon : Integer);
Var
AP : TAirPort;
begin
Writeln('Nearest airport for (',alat,',',alon,') : ');
AP:=FService.DefaultContainer.GetNearestAirPort(Alat,ALon);
try
Writeln('Name : ',AP.Name);
Writeln('IATA code : ',AP.IataCode);
Writeln('ICAO code : ',AP.IcaoCode);
if Assigned(AP.Location) then
begin
Writeln('Address : ',AP.Location.Address);
Writeln('City : ',AP.Location.City.Name,' (Country: ',AP.Location.City.CountryRegion,', Region: ',AP.Location.City.Region,')');
if Assigned(AP.Location.Loc) then
With AP.Location.Loc do
Writeln('Location : ',Coordinates[0],',',Coordinates[1]);
end;
finally
AP.Free;
end;
end;
Procedure TODataV4SampleServiceClientApp.DoRun;
Var
S : string;
begin
S:=CheckOptions('hdepl::u:D',['help','log::','delete','extra','photo','url:','debug']);
if (S<>'') or HasOption('h','help') then
Usage(S);
FShowExtra:=HasOption('e','extra');
FDoDelete:=HasOption('d','delete');
FSavePhoto:=HasOption('p','photo');
if HasOption('l','log') then
begin
S:=GetOptionValue('l','log');
if S='' then
S:='requests.log';
FService.WebClient.LogFile:=S;
end;
S:=GetOptionValue('u','url');
if S='' then
S:='http://services.odata.org/V4/TripPinServiceRW/';
FService.ServiceURL:=S;
if HasOption('D','debug') then
FService.OnLog:=@DoServiceLog;
RunDemo;
Terminate;
end;
Procedure TODataV4SampleServiceClientApp.RunDemo;
Var
Me : TPerson;
begin
Me:=Nil;
try
DoResetDataSource;
DoDumpAirLines;
Me:=FService.DefaultContainer.Me;
Writeln('Me.FirstName: ',Me.FirstName);
Writeln('Me.LastName: ',Me.LastName);
DumpExtra(Me);
DoListFriends(Me,FDoDelete);
DoPhoto(Me,FSavePhoto);
ShowFavoriteAirLine(Me);
ShowFriendsTrips(Me);
ShowNearestAirPort(40,45);
finally
FreeAndNil(Me);
end;
end;
Procedure TODataV4SampleServiceClientApp.Usage(Const Msg: String);
begin
Writeln('Error : ',Msg);
Writeln('Usage : ',ExeName,' [options]');
Writeln('Where options is one or more of:');
Writeln('-h --help This help');
Writeln('-d --delete Execute delete call on friend');
Writeln('-e --extra Show extra OData information');
Writeln('-l --log[=file] Dump requests and return to file (default is requests.log)');
Writeln('-p --photo Save pictore to photo.jpg');
Writeln('-u --url=URL Set Service url.');
Writeln('-D --debug Debug output');
Halt(Ord(Msg<>''));
end;
begin
With TODataV4SampleServiceClientApp.Create(Nil) do
try
Initialize;
Run;
finally
Free;
end;
end.

1808
packages/odata/examples/v4/v4sample.pas Normal file
View File

File diff suppressed because it is too large Load Diff

335
packages/odata/examples/v4/v4sample.xml Normal file
View File

@ -0,0 +1,335 @@
<?xml version="1.0" encoding="utf-8"?>
<edmx:Edmx xmlns:edmx="http://docs.oasis-open.org/odata/ns/edmx" Version="4.0">
<edmx:DataServices>
<Schema xmlns="http://docs.oasis-open.org/odata/ns/edm" Namespace="Microsoft.OData.SampleService.Models.TripPin">
<EnumType Name="PersonGender">
<Member Name="Male" Value="0"/>
<Member Name="Female" Value="1"/>
<Member Name="Unknown" Value="2"/>
</EnumType>
<ComplexType Name="City">
<Property Name="CountryRegion" Type="Edm.String" Nullable="false"/>
<Property Name="Name" Type="Edm.String" Nullable="false"/>
<Property Name="Region" Type="Edm.String" Nullable="false"/>
</ComplexType>
<ComplexType Name="Location" OpenType="true">
<Property Name="Address" Type="Edm.String" Nullable="false"/>
<Property Name="City" Type="Microsoft.OData.SampleService.Models.TripPin.City" Nullable="false"/>
</ComplexType>
<ComplexType Name="EventLocation" BaseType="Microsoft.OData.SampleService.Models.TripPin.Location" OpenType="true">
<Property Name="BuildingInfo" Type="Edm.String"/>
</ComplexType>
<ComplexType Name="AirportLocation" BaseType="Microsoft.OData.SampleService.Models.TripPin.Location" OpenType="true">
<Property Name="Loc" Type="Edm.GeographyPoint" Nullable="false" SRID="4326"/>
</ComplexType>
<EntityType Name="Photo" HasStream="true">
<Key>
<PropertyRef Name="Id"/>
</Key>
<Property Name="Id" Type="Edm.Int64" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="Name" Type="Edm.String"/>
<Annotation Term="Org.OData.Core.V1.AcceptableMediaTypes">
<Collection>
<String>image/jpeg</String>
</Collection>
</Annotation>
</EntityType>
<EntityType Name="Person" OpenType="true">
<Key>
<PropertyRef Name="UserName"/>
</Key>
<Property Name="UserName" Type="Edm.String" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="FirstName" Type="Edm.String" Nullable="false"/>
<Property Name="LastName" Type="Edm.String" Nullable="false"/>
<Property Name="Emails" Type="Collection(Edm.String)"/>
<Property Name="AddressInfo" Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Location)"/>
<Property Name="Gender" Type="Microsoft.OData.SampleService.Models.TripPin.PersonGender"/>
<Property Name="Concurrency" Type="Edm.Int64" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Computed" Bool="true"/>
</Property>
<NavigationProperty Name="Friends" Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Person)"/>
<NavigationProperty Name="Trips" Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Trip)" ContainsTarget="true"/>
<NavigationProperty Name="Photo" Type="Microsoft.OData.SampleService.Models.TripPin.Photo"/>
</EntityType>
<EntityType Name="Airline">
<Key>
<PropertyRef Name="AirlineCode"/>
</Key>
<Property Name="AirlineCode" Type="Edm.String" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="Name" Type="Edm.String" Nullable="false"/>
</EntityType>
<EntityType Name="Airport">
<Key>
<PropertyRef Name="IcaoCode"/>
</Key>
<Property Name="IcaoCode" Type="Edm.String" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="Name" Type="Edm.String" Nullable="false"/>
<Property Name="IataCode" Type="Edm.String" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Immutable" Bool="true"/>
</Property>
<Property Name="Location" Type="Microsoft.OData.SampleService.Models.TripPin.AirportLocation" Nullable="false"/>
</EntityType>
<EntityType Name="PlanItem">
<Key>
<PropertyRef Name="PlanItemId"/>
</Key>
<Property Name="PlanItemId" Type="Edm.Int32" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="ConfirmationCode" Type="Edm.String"/>
<Property Name="StartsAt" Type="Edm.DateTimeOffset"/>
<Property Name="EndsAt" Type="Edm.DateTimeOffset"/>
<Property Name="Duration" Type="Edm.Duration"/>
</EntityType>
<EntityType Name="PublicTransportation" BaseType="Microsoft.OData.SampleService.Models.TripPin.PlanItem">
<Property Name="SeatNumber" Type="Edm.String"/>
</EntityType>
<EntityType Name="Flight" BaseType="Microsoft.OData.SampleService.Models.TripPin.PublicTransportation">
<Property Name="FlightNumber" Type="Edm.String" Nullable="false"/>
<NavigationProperty Name="From" Type="Microsoft.OData.SampleService.Models.TripPin.Airport" Nullable="false"/>
<NavigationProperty Name="To" Type="Microsoft.OData.SampleService.Models.TripPin.Airport" Nullable="false"/>
<NavigationProperty Name="Airline" Type="Microsoft.OData.SampleService.Models.TripPin.Airline" Nullable="false"/>
</EntityType>
<EntityType Name="Event" BaseType="Microsoft.OData.SampleService.Models.TripPin.PlanItem" OpenType="true">
<Property Name="Description" Type="Edm.String"/>
<Property Name="OccursAt" Type="Microsoft.OData.SampleService.Models.TripPin.EventLocation" Nullable="false"/>
</EntityType>
<EntityType Name="Trip">
<Key>
<PropertyRef Name="TripId"/>
</Key>
<Property Name="TripId" Type="Edm.Int32" Nullable="false">
<Annotation Term="Org.OData.Core.V1.Permissions">
<EnumMember>Org.OData.Core.V1.Permission/Read</EnumMember>
</Annotation>
</Property>
<Property Name="ShareId" Type="Edm.Guid"/>
<Property Name="Description" Type="Edm.String"/>
<Property Name="Name" Type="Edm.String" Nullable="false"/>
<Property Name="Budget" Type="Edm.Single" Nullable="false">
<Annotation Term="Org.OData.Measures.V1.ISOCurrency" String="USD"/>
<Annotation Term="Org.OData.Measures.V1.Scale" Int="2"/>
</Property>
<Property Name="StartsAt" Type="Edm.DateTimeOffset" Nullable="false"/>
<Property Name="EndsAt" Type="Edm.DateTimeOffset" Nullable="false"/>
<Property Name="Tags" Type="Collection(Edm.String)" Nullable="false"/>
<NavigationProperty Name="Photos" Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Photo)"/>
<NavigationProperty Name="PlanItems" Type="Collection(Microsoft.OData.SampleService.Models.TripPin.PlanItem)" ContainsTarget="true"/>
</EntityType>
<Function Name="GetFavoriteAirline" IsBound="true" EntitySetPath="person/Trips/PlanItems/Microsoft.OData.SampleService.Models.TripPin.Flight/Airline" IsComposable="true">
<Parameter Name="person" Type="Microsoft.OData.SampleService.Models.TripPin.Person" Nullable="false"/>
<ReturnType Type="Microsoft.OData.SampleService.Models.TripPin.Airline" Nullable="false"/>
</Function>
<Function Name="GetInvolvedPeople" IsBound="true" IsComposable="true">
<Parameter Name="trip" Type="Microsoft.OData.SampleService.Models.TripPin.Trip" Nullable="false"/>
<ReturnType Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Person)" Nullable="false"/>
</Function>
<Function Name="GetFriendsTrips" IsBound="true" EntitySetPath="person/Friends/Trips" IsComposable="true">
<Parameter Name="person" Type="Microsoft.OData.SampleService.Models.TripPin.Person" Nullable="false"/>
<Parameter Name="userName" Type="Edm.String" Nullable="false"/>
<ReturnType Type="Collection(Microsoft.OData.SampleService.Models.TripPin.Trip)" Nullable="false"/>
</Function>
<Function Name="GetNearestAirport" IsComposable="true">
<Parameter Name="lat" Type="Edm.Double" Nullable="false"/>
<Parameter Name="lon" Type="Edm.Double" Nullable="false"/>
<ReturnType Type="Microsoft.OData.SampleService.Models.TripPin.Airport" Nullable="false"/>
</Function>
<Action Name="ResetDataSource"/>
<Action Name="ShareTrip" IsBound="true">
<Parameter Name="person" Type="Microsoft.OData.SampleService.Models.TripPin.Person" Nullable="false"/>
<Parameter Name="userName" Type="Edm.String" Nullable="false"/>
<Parameter Name="tripId" Type="Edm.Int32" Nullable="false"/>
</Action>
<EntityContainer Name="DefaultContainer">
<EntitySet Name="Photos" EntityType="Microsoft.OData.SampleService.Models.TripPin.Photo">
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="Photos"/>
<Annotation Term="Org.OData.Capabilities.V1.SearchRestrictions">
<Record>
<PropertyValue Property="Searchable" Bool="true"/>
<PropertyValue Property="UnsupportedExpressions">
<EnumMember>Org.OData.Capabilities.V1.SearchExpressions/none</EnumMember>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.InsertRestrictions">
<Record>
<PropertyValue Property="Insertable" Bool="true"/>
<PropertyValue Property="NonInsertableNavigationProperties">
<Collection/>
</PropertyValue>
</Record>
</Annotation>
</EntitySet>
<EntitySet Name="People" EntityType="Microsoft.OData.SampleService.Models.TripPin.Person">
<NavigationPropertyBinding Path="Friends" Target="People"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/Airline" Target="Airlines"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/From" Target="Airports"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/To" Target="Airports"/>
<NavigationPropertyBinding Path="Photo" Target="Photos"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Trip/Photos" Target="Photos"/>
<Annotation Term="Org.OData.Core.V1.OptimisticConcurrency">
<Collection>
<PropertyPath>Concurrency</PropertyPath>
</Collection>
</Annotation>
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="People"/>
<Annotation Term="Org.OData.Capabilities.V1.NavigationRestrictions">
<Record>
<PropertyValue Property="Navigability">
<EnumMember>Org.OData.Capabilities.V1.NavigationType/None</EnumMember>
</PropertyValue>
<PropertyValue Property="RestrictedProperties">
<Collection>
<Record>
<PropertyValue Property="NavigationProperty" NavigationPropertyPath="Friends"/>
<PropertyValue Property="Navigability">
<EnumMember>Org.OData.Capabilities.V1.NavigationType/Recursive</EnumMember>
</PropertyValue>
</Record>
</Collection>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.SearchRestrictions">
<Record>
<PropertyValue Property="Searchable" Bool="true"/>
<PropertyValue Property="UnsupportedExpressions">
<EnumMember>Org.OData.Capabilities.V1.SearchExpressions/none</EnumMember>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.InsertRestrictions">
<Record>
<PropertyValue Property="Insertable" Bool="true"/>
<PropertyValue Property="NonInsertableNavigationProperties">
<Collection>
<NavigationPropertyPath>Trips</NavigationPropertyPath>
<NavigationPropertyPath>Friends</NavigationPropertyPath>
</Collection>
</PropertyValue>
</Record>
</Annotation>
</EntitySet>
<EntitySet Name="Airlines" EntityType="Microsoft.OData.SampleService.Models.TripPin.Airline">
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="Airlines"/>
<Annotation Term="Org.OData.Capabilities.V1.SearchRestrictions">
<Record>
<PropertyValue Property="Searchable" Bool="true"/>
<PropertyValue Property="UnsupportedExpressions">
<EnumMember>Org.OData.Capabilities.V1.SearchExpressions/none</EnumMember>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.InsertRestrictions">
<Record>
<PropertyValue Property="Insertable" Bool="true"/>
<PropertyValue Property="NonInsertableNavigationProperties">
<Collection/>
</PropertyValue>
</Record>
</Annotation>
</EntitySet>
<EntitySet Name="Airports" EntityType="Microsoft.OData.SampleService.Models.TripPin.Airport">
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="Airports"/>
<Annotation Term="Org.OData.Capabilities.V1.SearchRestrictions">
<Record>
<PropertyValue Property="Searchable" Bool="true"/>
<PropertyValue Property="UnsupportedExpressions">
<EnumMember>Org.OData.Capabilities.V1.SearchExpressions/none</EnumMember>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.InsertRestrictions">
<Record>
<PropertyValue Property="Insertable" Bool="false"/>
<PropertyValue Property="NonInsertableNavigationProperties">
<Collection/>
</PropertyValue>
</Record>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.DeleteRestrictions">
<Record>
<PropertyValue Property="Deletable" Bool="false"/>
<PropertyValue Property="NonDeletableNavigationProperties">
<Collection/>
</PropertyValue>
</Record>
</Annotation>
</EntitySet>
<Singleton Name="Me" Type="Microsoft.OData.SampleService.Models.TripPin.Person">
<NavigationPropertyBinding Path="Friends" Target="People"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/Airline" Target="Airlines"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/From" Target="Airports"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Flight/To" Target="Airports"/>
<NavigationPropertyBinding Path="Photo" Target="Photos"/>
<NavigationPropertyBinding Path="Microsoft.OData.SampleService.Models.TripPin.Trip/Photos" Target="Photos"/>
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="Me"/>
</Singleton>
<FunctionImport Name="GetNearestAirport" Function="Microsoft.OData.SampleService.Models.TripPin.GetNearestAirport" EntitySet="Airports" IncludeInServiceDocument="true">
<Annotation Term="Org.OData.Core.V1.ResourcePath" String="Microsoft.OData.SampleService.Models.TripPin.GetNearestAirport"/>
</FunctionImport>
<ActionImport Name="ResetDataSource" Action="Microsoft.OData.SampleService.Models.TripPin.ResetDataSource"/>
<Annotation Term="Org.OData.Core.V1.Description" String="TripPin service is a sample service for OData V4."/>
</EntityContainer>
<Annotations Target="Microsoft.OData.SampleService.Models.TripPin.DefaultContainer">
<Annotation Term="Org.OData.Core.V1.DereferenceableIDs" Bool="true"/>
<Annotation Term="Org.OData.Core.V1.ConventionalIDs" Bool="true"/>
<Annotation Term="Org.OData.Capabilities.V1.ConformanceLevel">
<EnumMember>Org.OData.Capabilities.V1.ConformanceLevelType/Advanced</EnumMember>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.SupportedFormats">
<Collection>
<String>application/json;odata.metadata=full;IEEE754Compatible=false;odata.streaming=true</String>
<String>application/json;odata.metadata=minimal;IEEE754Compatible=false;odata.streaming=true</String>
<String>application/json;odata.metadata=none;IEEE754Compatible=false;odata.streaming=true</String>
</Collection>
</Annotation>
<Annotation Term="Org.OData.Capabilities.V1.AsynchronousRequestsSupported" Bool="true"/>
<Annotation Term="Org.OData.Capabilities.V1.BatchContinueOnErrorSupported" Bool="false"/>
<Annotation Term="Org.OData.Capabilities.V1.FilterFunctions">
<Collection>
<String>contains</String>
<String>endswith</String>
<String>startswith</String>
<String>length</String>
<String>indexof</String>
<String>substring</String>
<String>tolower</String>
<String>toupper</String>
<String>trim</String>
<String>concat</String>
<String>year</String>
<String>month</String>
<String>day</String>
<String>hour</String>
<String>minute</String>
<String>second</String>
<String>round</String>
<String>floor</String>
<String>ceiling</String>
<String>cast</String>
<String>isof</String>
</Collection>
</Annotation>
</Annotations>
</Schema>
</edmx:DataServices>
</edmx:Edmx>

56
packages/odata/fpmake.pp Normal file
View File

@ -0,0 +1,56 @@
{$ifndef ALLPACKAGES}
program fpmake;
{$mode objfpc}{$h+}
uses fpmkunit;
{$endif}
Procedure Add_OData(ADirectory : string);
function StdDep(T : TTarget) : TTarget;
begin
T.Dependencies.AddUnit('odatabase');
T.Dependencies.AddUnit('odataservice');
Result:=T;
end;
Var
P : TPackage;
T : TTarget;
begin
With Installer do
begin
P:=AddPackage('odata');
P.ShortName:='odata';
P.Author := 'Michael Van Canneyt';
P.License := 'LGPL with modification, ';
P.HomepageURL := 'www.freepascal.org';
P.Email := '';
P.Description := 'OData client base libraries, Microsoft Office365 clients';
P.NeedLibC:= false;
P.OSes := [beos,haiku,freebsd,darwin,iphonesim,solaris,netbsd,openbsd,linux,win32,win64,wince,aix,amiga,aros,morphos,dragonfly];
P.Directory:=ADirectory;
P.Version:='3.1.1';
P.Dependencies.Add('fcl-base');
P.Dependencies.Add('rtl-extra');
P.Dependencies.Add('rtl-objpas');
P.Dependencies.Add('fcl-json');
P.Dependencies.Add('fcl-web');
P.SourcePath.Add('src');
T:=P.Targets.AddUnit('odatabase.pp');
T:=P.Targets.AddUnit('odataservice.pp');
T.Dependencies.AddUnit('odatabase');
T:=StdDep(P.Targets.AddUnit('msgraph.pp'));
T:=StdDep(P.Targets.AddUnit('sharepoint.pp'));
T:=P.Targets.AddUnit('office365client.pp');
end;
end;
{$ifndef ALLPACKAGES}
begin
Add_OData('');
Installer.Run;
end.
{$endif ALLPACKAGES}

7
packages/odata/regen.sh Normal file
View File

@ -0,0 +1,7 @@
#!/bin/sh
#
# Command to regenerate the interface files.
# For this to work, the utils/convertedmx.lpi project must haven been compiled.
# That project needs WST (Webservice Toolkit)
utils/convertedmx -a 'microsoft.graph=' -d v4 -i xml/msgraph.xml -o src/msgraph.pp -x ''
utils/convertedmx -d v2 -i xml/sharepoint.xml -o src/sharepoint.pp -x ''

11515
packages/odata/src/msgraph.pp Normal file
View File

File diff suppressed because it is too large Load Diff

458
packages/odata/src/odatabase.pp Normal file
View File

@ -0,0 +1,458 @@
unit odatabase;
{$mode objfpc}{$H+}
interface
uses
TypInfo,Classes, SysUtils, fpjson, restbase;
Type
TInt16 = Type Smallint;
TInt32 = Type Integer;
SByte = Type Shortint;
TTimeOfDay = Type TDateTime;
TDateTimeOffset = Type TDateTime;
TGUIDString = Type string;
TBinary = Array of Byte;
TDuration = type string;
{ TGeography }
TGeography = Class(TBaseObject)
private
FType: String;
Public
Class function AllowAdditionalProperties: Boolean; override;
Published
Property _type : String Read FType Write FType;
end;
{ TGeographyPoint }
TGeographyPoint = Class(TGeography)
private
FCoordinates: TDoubleArray;
Procedure SetCoordinates(AIndex : integer; AValue : TDoubleArray);
Published
Property coordinates : TDoubleArray Index 8 Read FCoordinates Write SetCoordinates;
end;
TDoubleArrayArray = Array of TDoubleArray;
{ TGeographyLineString }
TGeographyLineString = Class(TGeography)
private
FCoordinates: TDoubleArrayArray;
Published
Property coordinates : TDoubleArrayArray Read FCoordinates Write FCoordinates;
end;
TGeographyPolygon = Class(TGeography)
end;
TGeographyMultiPoint = Class(TGeography)
end;
TGeographyMultiLineString = Class(TGeography)
end;
TSByteArray = Array of SByte;
TByteArray = Array of Byte;
TInt32Array = Array of TInt32;
TInt16Array = Array of TInt16;
TDurationArray = Array of TDuration;
TDateArray = Array of TDate;
TTimeArray = Array of TTime;
TTimeOfDayArray = Array of TTimeOfDay;
TDateTimeOffsetArray = Array of TDateTimeOffset;
TGUIDStringArray = Array of TGUIDString;
TBinaryArray = Array of TBinary;
TGeographyArray = Array of TGeography;
TGeographyPointArray = Array of TGeographyPoint;
TGeographyLineStringArray = Array of TGeographyLineString;
TGeographyPolygonArray = Array of TGeographyPolygon;
TGeographyMultiPointArray = Array of TGeographyMultiPoint;
TGeographyMultiLineStringArray = Array of TGeographyMultiLineString;
TAnnotation = TJSONEnum;
{ TODataObject }
TODataObject = Class(TBaseObject)
Private
FAns : TJSONObject;
function GetAnnotation(Index : Integer): TAnnotation;
function GetAnnotationValue(AName : String): TJSONData;
function GetDataAnnotationCount: Integer;
Protected
Procedure AddAnnotation(Const AName : String; AValue : TJSONData);
Class Function DynArrayToJSONArray(A : Pointer; AType : string; AClassType : TBaseObjectClass = Nil) : TJSONArray;
Class Function JSONArrayToDynArray(A : TJSONArray; AType : string; AClassType : TBaseObjectClass = Nil) : Pointer;
Public
Destructor Destroy; override;
Procedure LoadPropertyFromJSON(Const AName : String; JSON : TJSONData); override;
Class Function MakeKeyString(Const AKey : String) : String;
Class Function AllowAdditionalProperties : Boolean; override;
Property ODataAnnotations[Index : Integer] : TAnnotation Read GetAnnotation;
Property ODataAnnotationValues[AName : String] : TJSONData Read GetAnnotationValue;
Property ODataAnnotationCount : Integer Read GetDataAnnotationCount;
end;
TODataObjectClass = Class of TODataObject;
TODataObjectArray = Array of TODataObject;
TODataComplexType = Class(TODataObject);
TODataComplexTypeClass = Class of TODataComplexType;
{ TODataError }
TODataErrorDetail = Record
Code : String;
Message : String;
Target : String;
end;
TODataErrorDetails = Array of TODataErrorDetail;
TODataError = Class(TObject)
private
FCode: String;
FDetails: TODataErrorDetails;
FInnerError: String;
FMessage: String;
FTargetCode: String;
Public
Property Code : String Read FCode Write FCode;
Property Message : String Read FMessage Write FMessage;
Property Target : String Read FTargetCode Write FTargetCode;
Property Details : TODataErrorDetails Read FDetails Write FDetails;
// JSON
Property InnerError : String Read FInnerError Write FInnerError;
end;
{ EOData }
EOData =Class(Exception)
private
FError: TODataError;
FStatusCode: Integer;
FStatusText: String;
Public
Destructor Destroy; override;
Property StatusCode : Integer Read FStatusCode Write FStatusCode;
Property StatusText : String Read FStatusText Write FStatusText;
Property Error : TODataError Read FError Write FError;
end;
Function BinaryToString(B : TBinary) : String;
implementation
Function BinaryToString(B : TBinary) : String;
Var
E : Byte;
begin
Result:='';
For E in B do
Result:=Result+HexStr(E,2);
end;
{ TGeographyPoint }
Procedure TGeographyPoint.SetCoordinates(AIndex: integer; AValue: TDoubleArray);
Var
D : Double;
begin
{ Writeln('Setting coordinates');
For d in AValue do
writeln('Got ',D);}
FCoordinates:=AValue;
end;
{ TGeography }
Class function TGeography.AllowAdditionalProperties: Boolean;
begin
Result:=True;
end;
{ EOData }
Destructor EOData.Destroy;
begin
FreeAndNil(FError);
inherited Destroy;
end;
{ TODataObject }
function TODataObject.GetAnnotation(Index : Integer): TAnnotation;
begin
If Not Assigned(FAns) or (Index<0) or (Index>=FAns.Count) then
begin
Result.Key:='';
Result.KeyNum:=-1;
Result.Value:=Nil;
end
else
begin
Result.Key:=FAns.Names[Index];
Result.KeyNum:=Index;
Result.Value:=FAns.Items[Index];
end;
end;
function TODataObject.GetAnnotationValue(AName : String): TJSONData;
Var
I : Integer;
begin
Result:=Nil;
if Assigned(FAns) then
begin
I:=FAns.IndexOfName(AName);
if I<>-1 then
Result:=FAns.Items[i];
end;
end;
function TODataObject.GetDataAnnotationCount: Integer;
begin
if Assigned(FAns) then
Result:=FAns.Count
else
Result:=0;
end;
Procedure TODataObject.AddAnnotation(Const AName: String; AValue: TJSONData);
begin
If Not Assigned(FAns) then
FAns:=TJSONObject.Create();
FAns.Add(AName,AValue.Clone);
end;
Type
TShortIntArray = Array of ShortInt;
TSmallIntArray = Array of SmallInt;
TWordArray = Array of Word;
TCardinalArray = Array of Cardinal;
TQWordArray= Array of QWord;
TSingleArray = Array of Single;
Class Function TODataObject.DynArrayToJSONArray(A: Pointer; AType: string; AClassType : TBaseObjectClass = Nil): TJSONArray;
Var
I,L : Integer;
begin
Result:=TJSONArray.Create;
L:=Length(TByteArray(A));
Case LowerCase(aType) of
'boolean':
For I:=0 to L-1 do
Result.Add(TBooleanArray(A)[i]);
'byte',
'tsbyte':
For I:=0 to L-1 do
Result.Add(TByteArray(A)[i]);
'shortint':
For I:=0 to L-1 do
Result.Add(TShortIntArray(A)[i]);
'int16',
'tint16',
'smallint':
For I:=0 to L-1 do
Result.Add(TSmallIntArray(A)[i]);
'word':
For I:=0 to L-1 do
Result.Add(TWordArray(A)[i]);
'tint32',
'int32',
'integer':
For I:=0 to L-1 do
Result.Add(TIntegerArray(A)[i]);
'cardinal',
'dword':
For I:=0 to L-1 do
Result.Add(TCardinalArray(A)[i]);
'tint64',
'int64':
For I:=0 to L-1 do
Result.Add(TInt64Array(A)[i]);
'qword':
For I:=0 to L-1 do
{$IFNDEF VER2_6}
Result.Add(TQWordArray(A)[i]);
{$else}
Result.Add(TInt64Array(A)[i]);
{$ENDIF}
'string':
For I:=0 to L-1 do
Result.Add(TStringArray(A)[i]);
'tguidstring':
For I:=0 to L-1 do
Result.Add(TStringArray(A)[i]);
'double':
For I:=0 to L-1 do
Result.Add(TDoubleArray(A)[i]);
'single':
For I:=0 to L-1 do
Result.Add(TSingleArray(A)[i]);
else
if Pos('array',lowerCase(atype))<>0 then
Raise EOData.Create('Cannot convert array of array: '+atype);
if (AClassType=Nil) then
Raise EOData.Create('Cannot convert array of object without class type');
For I:=0 to L-1 do
if (TObjectArray(A)[i].InheritsFrom(AClassType)) then
Result.Add(TObjectArray(A)[i].SaveToJSON);
end;
end;
Class Function TODataObject.JSONArrayToDynArray(A: TJSONArray; AType: string; AClassType : TBaseObjectClass = Nil ): Pointer;
Var
I,L : Integer;
begin
Result:=TJSONArray.Create;
L:=A.Count;
Case LowerCase(aType) of
'boolean':
begin
SetLength(TBooleanArray(Result),L);
For I:=0 to L-1 do
TBooleanArray(Result)[i]:=A.Booleans[i];
end;
'byte',
'tsbyte':
begin
SetLength(TByteArray(Result),L);
For I:=0 to L-1 do
TByteArray(Result)[i]:=A.Integers[i];
end;
'shortint':
begin
SetLength(TShortIntArray(Result),L);
For I:=0 to L-1 do
TShortIntArray(Result)[i]:=A.Integers[i];
end;
'int16',
'tint16',
'smallint':
begin
SetLength(TSmallIntArray(Result),L);
For I:=0 to L-1 do
TSmallIntArray(Result)[i]:=A.Integers[i];
end;
'word':
begin
SetLength(TWordArray(Result),L);
For I:=0 to L-1 do
TWordArray(Result)[i]:=A.Integers[i];
end;
'tint32',
'int32',
'integer':
begin
SetLength(TIntegerArray(Result),L);
For I:=0 to L-1 do
TIntegerArray(Result)[i]:=A.Integers[i];
end;
'cardinal',
'dword':
begin
SetLength(TCardinalArray(Result),L);
For I:=0 to L-1 do
TCardinalArray(Result)[i]:=A.Integers[i];
end;
'tint64',
'int64':
begin
SetLength(TInt64Array(Result),L);
For I:=0 to L-1 do
TInt64Array(Result)[i]:=A.Int64s[i];
end;
'qword':
begin
SetLength(TQWordArray(Result),L);
For I:=0 to L-1 do
{$IFDEF VER2_6}
TInt64Array(Result)[i]:=A.Int64s[i];
{$ELSE}
TQWordArray(Result)[i]:=A.QWords[i];
{$ENDIF}
end;
'tstring',
'string':
begin
SetLength(TStringArray(Result),L);
For I:=0 to L-1 do
TStringArray(Result)[i]:=A.Strings[i];
end;
'guidstring',
'tguidstring':
begin
SetLength(TStringArray(Result),L);
For I:=0 to L-1 do
TStringArray(Result)[i]:=A.Strings[i];
end;
'double':
begin
SetLength(TDoubleArray(Result),L);
For I:=0 to L-1 do
TDoubleArray(Result)[i]:=A.Floats[i];
end;
'single':
begin
SetLength(TSingleArray(Result),L);
For I:=0 to L-1 do
TSingleArray(Result)[i]:=A.Floats[i];
end;
else
if (Pos('array',lowercase(atype))<>0) then
Raise EOData.Create('Cannot convert array of array: '+atype);
if (AClassType=Nil) then
Raise EOData.Create('Cannot convert array of object without class type');
SetLength(TObjectArray(Result),L);
For I:=0 to L-1 do
begin
if A.Types[i]<>jtObject then
Raise EOData.CreateFmt('Element %d of array is not an object: %s',[I,A.Items[i].AsJSON]);
TObjectArray(Result)[i]:=AClassType.Create;
TObjectArray(Result)[i].LoadFromJSON(A.Objects[i]);
end;
end;
end;
Destructor TODataObject.Destroy;
begin
FreeAndNil(FAns);
Inherited;
end;
Procedure TODataObject.LoadPropertyFromJSON(Const AName: String; JSON: TJSONData
);
begin
if (AName<>'') and (AName[1]='@') then
AddAnnotation(AName,JSON)
else
inherited LoadPropertyFromJSON(AName, JSON);
end;
Class Function TODataObject.MakeKeyString(Const AKey: String): String;
begin
Result:=''''+AKey+'''';
end;
Class Function TODataObject.AllowAdditionalProperties: Boolean;
begin
Result:=True; // So we catch annnotations
end;
end.

1392
packages/odata/src/odataservice.pp Normal file
View File

File diff suppressed because it is too large Load Diff

288
packages/odata/src/office365client.pp Normal file
View File

@ -0,0 +1,288 @@
unit office365client;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpwebclient, fpoauth2, fpjwt;
Type
TAuthMethod = (amOAuth2);
{ TAzureADClaims }
// Claims returned by Azure AD.
TAzureADClaims = Class(TClaims)
private
FFamilyName: String;
FGivenName: String;
FOID: String;
Fpwd_exp: string;
Fpwd_url: string;
FTid: String;
FUniqueName: string;
Fupn: String;
Fver: String;
Published
Property unique_name : string read FUniqueName Write FUniqueName;
Property family_name : String read FFamilyName Write FFamilyName;
Property given_name : String read FGivenName Write FGivenName;
Property pwd_exp : string Read Fpwd_exp Write Fpwd_exp;
Property pwd_url : string Read Fpwd_url Write Fpwd_url;
Property tid : String Read FTid Write FTID; // GUID
Property upn : String Read Fupn Write Fupn;
Property ver : String Read Fver Write Fver;
Property oid : String Read FOID Write FOID; // GUID
end;
{ TAzureIDToken }
TAzureIDToken = Class(TJWTIDtoken)
private
function GetAzureClaims: TAzureADClaims;
Protected
Function CreateClaims : TClaims; override;
Public
Constructor Create;
Function GetUniqueUserID : String; override;
Function GetUniqueUserName : String; override;
Function GetUserDisplayName : String; override;
Property AzureClaims : TAzureADClaims Read GetAzureClaims;
end;
{ TAzureADOAuth2Handler }
TAzureADOAuth2Handler = Class(TOAuth2Handler)
Protected
function CreateIDToken: TJWTIDToken;override;
Public
Constructor Create(AOwner : TComponent); override;
Class Function AuthScopeVariableName : String; override;
Class Function DefaultHostedDomain : String; override;
end;
// Authentication V2...
{ TAzureAD2OAuth2Handler }
TAzureAD2OAuth2Handler = Class(TAzureADOAuth2Handler)
Public
Constructor Create(AOwner : TComponent); override;
Class Function AuthScopeVariableName : String; override;
Class Function DefaultHostedDomain : String; override;
end;
TOffice365Client = CLass(TComponent)
Private
FWebClient: TAbstractWebClient;
FAuthHandler : TOAuth2Handler;
function GetOnUserConsent: TUserConsentHandler;
procedure SetAuthHandler(AValue: TOAuth2Handler);
procedure SetClient(AValue: TAbstractWebClient);
procedure SetOnUserConsent(AValue: TUserConsentHandler);
Protected
Procedure CheckDefaults; virtual;
Public
Constructor Create(AOwner : TComponent); override;
Function GetAuthHandler : TOAuth2Handler;
Published
Property AuthHandler : TOAuth2Handler Read GetAuthHandler Write SetAuthHandler;
Property WebClient : TAbstractWebClient Read FWebClient Write SetClient;
Property OnUserConsent : TUserConsentHandler Read GetOnUserConsent Write SetOnUserConsent;
end;
EOffice365 = Class(Exception);
Const
DefAUTHURL = 'https://login.windows.net/%HostedDomain%/oauth2/authorize';
DefTOKENURL = 'https://login.windows.net/%HostedDomain%/oauth2/token';
DefAUTHURLV2 = 'https://login.microsoftonline.com/%HostedDomain%/oauth2/v2.0/authorize';
DefTOKENURLV2 = 'https://login.microsoftonline.com/%HostedDomain%/oauth2/v2.0/token';
implementation
Function StringToAuthMethod (Const S : String) : TAuthMethod;
begin
Case Lowercase(S) of
'oauth2' : Result:=amOAuth2;
end;
end;
Function StringToAccessType(const S : String) : TAccessType;
begin
Case lowercase(S) of
'online' : Result:=atonline;
'offline' : Result:=atoffline;
end;
end;
{ TAzureAD2OAuth2Handler }
constructor TAzureAD2OAuth2Handler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Config.TokenURL:=DefTOKENURLV2;
Config.AuthURL:=DefAuthURLV2;
end;
class function TAzureAD2OAuth2Handler.AuthScopeVariableName: String;
begin
Result:='scope';
end;
class function TAzureAD2OAuth2Handler.DefaultHostedDomain: String;
begin
Result:='common';
end;
{ TAzureIDToken }
function TAzureIDToken.GetAzureClaims: TAzureADClaims;
begin
if Claims is TAzureADClaims then
Result:=TAzureADClaims(Claims)
else
Result:=Nil;
end;
function TAzureIDToken.CreateClaims: TClaims;
begin
If ClaimsClass=Nil then
Result:=TAzureADClaims.Create
else
Result:=inherited CreateClaims;
end;
constructor TAzureIDToken.Create;
begin
Inherited CreateWithClasses(TAzureADClaims,Nil)
end;
function TAzureIDToken.GetUniqueUserID: String;
begin
if Assigned(AZureClaims) then
Result:=AZureClaims.upn
else
Result:=inherited GetUniqueUserID;
end;
function TAzureIDToken.GetUniqueUserName: String;
begin
if Assigned(AZureClaims) then
Result:=AZureClaims.unique_name
else
Result:=inherited GetUniqueUserName;
end;
function TAzureIDToken.GetUserDisplayName: String;
begin
if Assigned(AZureClaims) then
Result:=AZureClaims.Given_Name+' '+AZureClaims.Family_Name
else
Result:=inherited GetUserDisplayName;
end;
{ TAzureOAuth2Handler }
function TAzureADOAuth2Handler.CreateIDToken: TJWTIDToken;
begin
Result:=TAzureIDToken.CreateWithClasses(TAzureADClaims,Nil);
end;
Constructor TAzureADOAuth2Handler.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Config.TokenURL:=DefTOKENURL;
Config.AuthURL:=DefAuthURL;
end;
Class Function TAzureADOAuth2Handler.AuthScopeVariableName: String;
begin
Result:='resource';
end;
Class Function TAzureADOAuth2Handler.DefaultHostedDomain: String;
begin
Result:='common';
end;
{ TOffice365Client }
procedure TOffice365Client.SetClient(AValue: TAbstractWebClient);
Var
AH : TOAuth2Handler;
begin
if FWebClient=AValue then Exit;
if Assigned(FWebClient) then
FWebClient.RemoveFreeNotification(Self);
FWebClient:=AValue;
if Assigned(FWebClient) then
begin
FWebClient.FreeNotification(Self);
AH:=GetAuthHandler;
FWebClient.RequestSigner:=AH;
AH.WebClient:=FWebClient;
end;
end;
function TOffice365Client.GetOnUserConsent: TUserConsentHandler;
begin
Result:=GetAuthHandler.OnUserConsent;
end;
procedure TOffice365Client.SetAuthHandler(AValue: TOAuth2Handler);
begin
if FAuthHandler=AValue then Exit;
FAuthHandler:=AValue;
end;
procedure TOffice365Client.SetOnUserConsent(AValue: TUserConsentHandler);
begin
GetAuthHandler.OnUserConsent:=AValue;
end;
Constructor TOffice365Client.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
CheckDefaults;
end;
Procedure TOffice365Client.CheckDefaults;
begin
If (AuthHandler.Config.AuthURL='') then
AuthHandler.Config.AuthURL:=DefAuthURL;
If (AuthHandler.Config.TokenURL='') then
AuthHandler.Config.TokenURL:=DefTokenURL;
end;
Function TOffice365Client.GetAuthHandler: TOAuth2Handler;
begin
if (FAuthHandler=Nil) then
begin
FAuthHandler:=TAzureADOAuth2Handler.Create(Self);
if Assigned(FWebClient) then
begin
FWebClient.RequestSigner:=FAuthHandler;
FAuthHandler.WebClient:=FWebClient;
end;
end;
Result:=FAuthHandler;
end;
end.

119212
packages/odata/src/sharepoint.pp Normal file
View File

File diff suppressed because it is too large Load Diff

86
packages/odata/utils/README.txt Normal file
View File

@ -0,0 +1,86 @@
This program converts a ODATA service description to a pascal unit.
This is either CSDL (OData V2) or EDMX (OData V4) document.
It needs the WST (Web Services Toolkit) to compile, you will need to
download this separately from the Lazarus-CCR:
https://svn.code.sf.net/p/lazarus-ccr/svn/wst/trunk
------------------
About the sources:
------------------
The sources use a small trick to treat v4 and v2 OData formats: EDMX and CSDL.
While describing virtually the same thing, the underlying EDMX and CSDL
are nonetheless quite different at times.
To cater for this, a single unit is made (edmx2pas) which uses a define USECSDL
to differentiate between V2 (USECSDL defined) and V4 (USECSDL not defined).
The csdl2pas unit just sets the define and includes edmx2pas.
This trick may confuse your IDE (Lazarus in my case).
-----
Usage
-----
Usage is explained by running the program
a --aliases=aliases Schema aliases as comma-separated name=value pairs.
The form @aliases reads from file "aliases", one alias per line.
an CSDL or EDMX data description uses a schema namespace.
This means a set of dotted names, used in all identifiers.
For example, the Microsoft Graph api uses microsoft.graph.
By default all dots are replaced by underscores, and the type or identifier name is appended to it.
You can instead specify microsoft.graph=X in which case the namespace is
reduced to X. This results in more readable identifiers (Note: X can be empty)
-b --basename=classname Name of class to use as base class.
By default, all classes descend from TODataObject. This can be changed.
-d --odata=version OData version to use: v2 or v4.
This determines what document is being converted. Note that not yet all
possibilities of V2 are supported.
-e --extraunits=extraunits Comma-separated list of unit names to add.
List of unit names to add to the uses clause of the generated unit.
-h --help This message.
Display help.
-i --input=filename Name of the file to use as input. Mandatory
The name of an CSDL or EDMX XML document.
-o --output=filename Name of the file to use as output.
(default: input file with extension changed to .pas)
This is the output filename name. By default the input filename will be
used, with the extension changed to .pas
-p --prefix=fieldprefix Text to use as field prefix (default: F)
All field names for properties start with F, followed by the property name.
You can change this here.
-u --enumerations=mode How to treat enumerations. Possible values: scoped, prefixtypename, plain
How to generate code for enumerations.
-x --servicesuffix=string When constructing type names, add this to schema name. Default is _
By default a type name is constructed by apending the schema name with _ and
then the type name. You can use this option to change the _ character.
-v --verbose Output some diagnostic messages
Enjoy,
Michael.

62
packages/odata/utils/cgs.pas Normal file
View File

@ -0,0 +1,62 @@
{
This unit has been produced by ws_helper.
Input unit name : "System_Data_Resources_CodeGenerationSchema".
This unit name : "cgs".
Date : "12-5-16 15:37:59".
}
unit cgs;
{$IFDEF FPC}
{$mode objfpc} {$H+}
{$ENDIF}
{$DEFINE WST_RECORD_RTTI}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'http://schemas.microsoft.com/ado/2006/04/codegeneration';
sUNIT_NAME = 'System_Data_Resources_CodeGenerationSchema';
type
TAccess = (
TAccess_Public
,Internal
,TAccess_Protected
,TAccess_Private
);
TPublicOrInternalAccess = (
TPublicOrInternalAccess_Public
,TPublicOrInternalAccess_Internal
);
SetterAccess_Type = TAccess;
GetterAccess_Type = TAccess;
TypeAccess_Type = TPublicOrInternalAccess;
MethodAccess_Type = TAccess;
Implementation
uses metadata_repository, record_rtti;
var
typeRegistryInstance : TTypeRegistry = nil;
initialization
typeRegistryInstance := GetTypeRegistry();
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TAccess),'TAccess');
typeRegistryInstance.ItemByTypeInfo[TypeInfo(TAccess)].RegisterExternalPropertyName('TAccess_Public','Public');
typeRegistryInstance.ItemByTypeInfo[TypeInfo(TAccess)].RegisterExternalPropertyName('TAccess_Protected','Protected');
typeRegistryInstance.ItemByTypeInfo[TypeInfo(TAccess)].RegisterExternalPropertyName('TAccess_Private','Private');
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TPublicOrInternalAccess),'TPublicOrInternalAccess');
typeRegistryInstance.ItemByTypeInfo[TypeInfo(TPublicOrInternalAccess)].RegisterExternalPropertyName('TPublicOrInternalAccess_Public','Public');
typeRegistryInstance.ItemByTypeInfo[TypeInfo(TPublicOrInternalAccess)].RegisterExternalPropertyName('TPublicOrInternalAccess_Internal','Internal');
End.

101
packages/odata/utils/convertedmx.lpi Normal file
View File

@ -0,0 +1,101 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<SaveJumpHistory Value="False"/>
<SaveFoldState Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="convertedmx"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="-d v4 -i ../examples/v4/v4sample.xml -a Microsoft.OData.SampleService.Models.TripPin= -x ''"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="wst_core"/>
</Item1>
</RequiredPackages>
<Units Count="8">
<Unit0>
<Filename Value="convertedmx.pp"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="edmx2pas.pp"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="csdl.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CSDL"/>
</Unit2>
<Unit3>
<Filename Value="csdl2pas.pp"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="odatacodegen.pp"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="cgs.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="edm.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
<Unit7>
<Filename Value="ras.pas"/>
<IsPartOfProject Value="True"/>
</Unit7>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="convertedmx"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

124
packages/odata/utils/convertedmx.pp Normal file
View File

@ -0,0 +1,124 @@
program convertedmx;
uses
classes, sysutils, csdl2pas, custapp, restcodegen,
edmx2pas, odatacodegen, cgs;
Type
{ TConvertEDMXApplication }
TConvertEDMXApplication = Class(TCustomApplication)
private
procedure Usage(Msg: String);
Protected
Procedure DoRun; override;
public
Procedure DoMyLog(Sender: TObject; LogType: TCodegenLogType; Const Msg: String);
end;
{ TConvertEDMXApplication }
procedure TConvertEDMXApplication.Usage(Msg : String);
begin
If (Msg<>'') then
Writeln('Error: ',Msg);
Writeln('Usage : ',ExtractFileName(ParamStr(0)),' [options]');
Writeln('Where options is one or more of:');
Writeln('-a --aliases=aliases Schema aliases as comma-separated name=value pairs.');
Writeln(' The form @aliases reads from file "aliases", one alias per line.');
Writeln('-b --basename=classname Name of class to use as base class.');
Writeln('-d --odata=version OData version to use: v2 or v4.');
Writeln('-e --extraunits=extraunits Comma-separated list of unit names to add.');
Writeln('-h --help This message.');
Writeln('-i --input=filename Name of the file to use as input. Mandatory');
Writeln('-o --output=filename Name of the file to use as output.');
Writeln(' (default: input file with extension changed to .pas)');
Writeln('-p --prefix=fieldprefix Text to use as field prefix (default: F)');
Writeln('-u --enumerations=mode How to treat enumerations. Possible values: scoped, prefixtypename, plain');
Writeln('-x --servicesuffix=string When constructing type names, add this to schema name. Default is _');
Writeln('-v --verbose Output some diagnostic messages');
Halt(Ord(Msg<>''));
end;
procedure TConvertEDMXApplication.DoRun;
Var
FConverter : TODataCodeGenerator;
S,FInput,FOutput : String;
begin
StopOnException:=True;
S:=CheckOptions('a:hd:i:o:nb:p:u:vx',['aliases','help','odata:','input:','output:','namespace','basename:','prefix:','verbose','enumerations','servicesuffix'],True);
if (S<>'') then
Usage(S);
if HasOption('h','help') then
Usage('');
FInput:=GetOptionValue('i','input');
FOutput:=GetOptionValue('o','output');
if (FInput='') then
Usage('Need input filename');
if (FOutput='') then
FOutput:=ChangeFileExt(FInput,'.pas');
Case lowercase(GetOptionValue('d','odata')) of
'v2' : FConverter:=csdl2pas.TEDMX2PasConverter.Create(Self);
'v4' : FConverter:=edmx2pas.TEDMX2PasConverter.Create(Self);
else
Usage('Unknown OData version :'+GetOptionValue('d','odata'));
end;
try
if HasOption('x','servicesuffix') then
FConverter.ServiceSuffix:=GetOptionValue('x','servicesuffix');
if HasOption('a','aliases') then
begin
S:=GetOptionValue('a','aliases');
if S<>'' then
if S[1]='@' then
FConverter.Aliases.LoadFromFile(Copy(S,2,Length(S)-1))
else
FConverter.Aliases.CommaText:=S;
end;
if HasOption('b','basename') then
FConverter.BaseClassName:=GetOptionValue('b','basename');
FConverter.ExtraUnits:=GetOptionValue('e','extraunits');
if HasOption('p','prefix') then
FConverter.FieldPrefix:=GetOptionValue('p','prefix');
if HasOption('u','enumerations') then
Case lowercase(GetOptionValue('u','enumerations')) of
'plain' : FConverter.EnumerationMode:=emPlain;
'scoped' : FConverter.EnumerationMode:=emScoped;
'prefixtypename' : FConverter.EnumerationMode:=emPrefixTypeName;
else
Usage('Unknown enumeration mode :'+GetOptionValue('u','enumerations'));
end;
if HasOption('v','verbose') then
FConverter.OnLog:=@DoMyLog;
// Go ahead
FConverter.LoadFromFile(FInput);
FConverter.OutputUnitName:=ChangeFileExt(ExtractFileName(Foutput),'');
FConverter.Execute;
FConverter.SaveToFile(FOutput);
finally
FConverter.Free;
end;
Terminate;
end;
Procedure TConvertEDMXApplication.DoMyLog(Sender: TObject;
LogType: TCodegenLogType; Const Msg: String);
begin
Writeln('[',LogType,'] ',Msg);
end;
begin
With TConvertEDMXApplication.Create(Nil) do
try
Initialize;
Run;
finally
Free;
end;
end.

6597
packages/odata/utils/csdl.pp Normal file
View File

File diff suppressed because it is too large Load Diff

2
packages/odata/utils/csdl2pas.pp Normal file
View File

@ -0,0 +1,2 @@
{$DEFINE USECSDL}
{$i edmx2pas.pp}

9845
packages/odata/utils/edm.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2864
packages/odata/utils/edmx2pas.pp Normal file
View File

File diff suppressed because it is too large Load Diff

545
packages/odata/utils/odatacodegen.pp Normal file
View File

@ -0,0 +1,545 @@
unit odatacodegen;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, pastree, restcodegen, inifiles;
Type
EEDMX2PasConverter = Class(Exception);
// Extra set of keywords to take into account when cleaning a property name.
TExtraKeyWords = (ekwNone,ekwObject,ekwEntity,ekwEntitySet,ekwEntityContainer,ekwservice);
TODataVersion = (ODataV2,ODataV4);
TEnumerationMode = (emScoped,emPrefixTypeName,emPlain);
{ TPropertySetter }
TPropertyFlag = (pfRequired,pfNavigation, pfIndexed, pfReadOnly, pfNeedSetter, pfNeedGetter, pfInkey);
TPropertyFlags = Set of TPropertyFlag;
TResultType = (rtNone,rtSimple,rtObject,rtArraySimple,rtArrayObject);
// Specialized TPasElement classes.
// Using these tells the code generator what kind of code it must generate for an identifier.
TPropertySetter = Class(TPasProcedure)
private
FProp: TPasElement;
Public
Property TheProperty : TPasElement Read FProp Write FProp;
end;
TPropertyGetter = Class(TPasFunction)
private
FProp: TPasElement;
Public
Property TheProperty : TPasElement Read FProp Write FProp;
end;
TGetRestKind = Class(TPasProcedure);
TObjectRestKind = Class(TPasClassFunction);
TExportPropertyName = class(TPasClassFunction);
TCreateContainer = Class(TPasFunction);
TCreateEntitySet = Class(TPasFunction);
TEntityClassFunction = Class(TPasClassFunction);
TGetNavigationProperty = Class(TPasFunction);
TGetSingleton = Class(TPasFunction);
TGetContainedSingleton = Class(TPasFunction);
TKeyAsURLPart = Class(TPasFunction);
TEntityMethod = Class(TPasFunction);
TSetArrayLength = Class(TPasProcedure);
TGetStream = Class(TPasProcedure);
TSetStream = Class(TPasProcedure);
TBoundFunction = Class(TPasFunction);
TBoundActionProc = Class(TPasProcedure);
TBoundActionFunc = Class(TPasFunction);
TUnBoundFunction = Class(TPasFunction)
private
FPath: STring;
Public
Property ExportPath : STring Read FPath Write FPath;
end;
TUnBoundActionFunc = Class(TPasFunction)
private
FPath: STring;
Public
Property ExportPath : STring Read FPath Write FPath;
end;
TUnBoundActionProc = Class(TPasProcedure)
private
FPath: STring;
Public
Property ExportPath : STring Read FPath Write FPath;
end;
TEntityGet = Class(TEntityMethod);
TEntityList = Class(TEntityMethod);
TEntityListAll = Class(TEntityList);
TEntityPut = Class(TEntityMethod);
TEntityPatch = Class(TEntityMethod);
TEntityPost = Class(TEntityMethod);
TEntityDelete = Class(TEntityMethod);
TServiceClass = Class(TPasClassType);
TComplexClass = Class(TPasClassType);
TEntityClass = Class(TPasClassType);
TEntityContainerClass = Class(TPasClassType);
TEntitySetClass = Class(TPasClassType);
{ TODataCodeGenerator }
TODataCodeGenerator = class(TRestCodeGenerator)
private
FAliases: TStrings;
FBaseComplexType: String;
FBaseEntityContainerType: String;
FBaseEntitySetType: String;
FBaseEntityType: String;
FBaseServiceType: String;
FEnumerationMode: TEnumerationMode;
FFieldPrefix: String;
FSchemaAncestor: String;
FServiceSuffix: String;
FReservedWords : TStringList;
FIdentifierMap : TStrings;
procedure SetAliases(AValue: TStrings);
function GetReservedWords: TStrings;
procedure SetReservedWords(AValue: TStrings);
Protected
procedure EmitOptions; virtual;
function ConvertTypeToStringExpr(const ExprName, ExprType: String): String;
Function GetResultType(Const aType: String; Out AElementType : String): TResultType;
function GetBaseClassName(El: TPasClassType): String;
Procedure RegisterBaseTypes; virtual;
function IsSimpleType(const aType: String): Boolean;
function FlattenName(const AName: String): String;
procedure WriteProcedureDecl(P: TPasProcedure);
function CleanPropertyName(const AName: String; UseExtra: TExtraKeyWords): string;
function CleanPropertyName(const AName: UnicodeString; UseExtra: TExtraKeyWords): string;
Function CountProperties(C: TPasClassType): Integer;
Property IdentifierMap : TStrings Read FIdentifierMap;
Public
Constructor Create(AOwner : TComponent); override;
Destructor destroy; override;
Class Function WTOA(Const S : UnicodeString) : String;
Function is26Only(P: TPasProcedure): Boolean;
Function BaseUnits : String; override;
Class function IndentStrings(S: TStrings; indent: Integer): string;
Class Function ODataVersion : TODataVersion; virtual; abstract;
Published
Property BaseComplexType : String Read FBaseComplexType Write FBaseComplexType;
Property BaseEntityType : String Read FBaseEntityType Write FBaseEntityType;
Property BaseEntityContainerType : String Read FBaseEntityContainerType Write FBaseEntityContainerType;
Property BaseServiceType : String Read FBaseServiceType Write FBaseServiceType;
Property BaseEntitySetType : String Read FBaseEntitySetType Write FBaseEntitySetType;
Property Aliases : TStrings Read FAliases Write SetAliases;
Property SchemaAncestor : String Read FSchemaAncestor Write FSchemaAncestor;
Property FieldPrefix: String Read FFieldPrefix Write FFieldPrefix;
Property ServiceSuffix : String Read FServiceSuffix Write FServiceSuffix;
property EnumerationMode : TEnumerationMode Read FEnumerationMode Write FEnumerationMode;
Property ReservedWords : TStrings Read GetReservedWords Write SetReservedWords;
end;
implementation
{ TODataCodeGenerator }
procedure TODataCodeGenerator.SetAliases(AValue: TStrings);
begin
if FAliases=AValue then Exit;
FAliases.Assign(AValue);
end;
constructor TODataCodeGenerator.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
BaseClassName:='TODataObject';
BaseComplexType:='TODataObject';
BaseEntityType:='TODataEntity';
BaseEntityContainerType:='TODataEntityContainer';
BaseServiceType:='TODataService';
BaseEntitySetType:='TODataEntitySet';
SchemaAncestor:='TObject';
FieldPrefix:='F';
ServiceSuffix:='_';
FAliases:=TStringlist.Create;
FIdentifierMap:=THashedStringList.Create;
end;
destructor TODataCodeGenerator.destroy;
begin
FreeAndNil(FAliases);
FreeAndNil(FReservedWords);
FreeAndNil(FIdentifierMap);
Inherited;
end;
function TODataCodeGenerator.BaseUnits: String;
begin
Result:='fpjson, restbase, odatabase, odataservice';
end;
function TODataCodeGenerator.GetReservedWords: TStrings;
begin
if (FReservedWords=Nil) then
begin
FReservedWords:=TStringList.Create;
FReservedWords.Sorted:=True;
end;
Result:=FReservedWords;
end;
procedure TODataCodeGenerator.SetReservedWords(AValue: TStrings);
begin
if AValue=FReservedwords then exit;
if AValue.Count=0 then
FreeAndNil(FReservedWords)
else
ReservedWords.Assign(AValue);
end;
class function TODataCodeGenerator.WTOA(const S: UnicodeString): String;
begin
Result:=AnsiString(S);
end;
function TODataCodeGenerator.is26Only(P: TPasProcedure): Boolean;
begin
Result:=P is TSetArrayLength;
end;
class function TODataCodeGenerator.IndentStrings(S: TStrings; indent: Integer
): string;
Var
I,CurrLen,CurrPos : Integer;
begin
Result:='';
CurrLen:=0;
CurrPos:=0;
For I:=0 to S.Count-1 do
begin
CurrLen:=Length(S[i]);
If (CurrLen+CurrPos)>72 then
begin
Result:=Result+LineEnding+StringOfChar(' ',Indent);
CurrPos:=Indent;
end;
Result:=Result+S[i];
CurrPos:=CurrPos+CurrLen;
end;
end;
procedure TODataCodeGenerator.WriteProcedureDecl(P : TPasProcedure);
Var
S : TStrings;
R: TPasResultElement;
T : String;
B : Boolean;
begin
S:=TStringList.Create;
try
S.Add(P.TypeName+' '+P.Name);
P.ProcType.GetArguments(S);
if P.ProcType.InheritsFrom(TPasFunctionType) then
If Assigned(TPasFunctionType(P.ProcType).ResultEl) then
begin
R:=TPasFunctionType(P.ProcType).ResultEl;
T:=' : ';
If (R.ResultType.Name<>'') then
T:=T+R.ResultType.Name
else
T:=T+R.ResultType.GetDeclaration(False);
S.Add(T);
end;
P.GetModifiers(S);
B:=Is26Only(P);
if B then
AddLn('{$IFDEF VER2_6}');
AddLn(IndentStrings(S,Length(S[0]))+';');
if B then
AddLn('{$ENDIF VER2_6}');
finally
S.Free;
end;
end;
function TODataCodeGenerator.CleanPropertyName(const AName: String;
UseExtra: TExtraKeyWords): string;
Const
// Pascal keywords
KW=';absolute;and;array;asm;begin;case;const;constructor;destructor;div;do;'+
'downto;else;end;file;for;function;goto;if;implementation;in;inherited;'+
'inline;interface;label;mod;nil;not;object;of;on;operator;or;packed;'+
'procedure;program;record;reintroduce;repeat;self;set;shl;shr;string;then;'+
'to;type;unit;until;uses;var;while;with;xor;dispose;exit;false;new;true;'+
'as;class;dispinterface;except;exports;finalization;finally;initialization;'+
'inline;is;library;on;out;packed;property;raise;resourcestring;threadvar;try;'+
'private;published;length;setlength;result;';
// Reserved words (methods)
RWComponent = ';post;component;name;notification;componentcount;';
RWOdataObject = 'destroy;loadPropertyfromjson;makekeystring;allowadditionalproperties;odataannotations;odataannotationvalues;odataannotationcount;';
RWEntity = 'baseurl;keyasurlpart;delete;basepath;post;put;patch;';
RWEntitySet = RWComponent+'getbaseurl;checkservice;checkcontainer;notification;getsingle;getmulti;containerurl;containedpath;service;objectrestkind;entityclass;getservice;container;';
RWEntityContainer = RWComponent+'checkservice;objectrestkind;entitycontainername;defaultservice;createentityset;service;';
RWService = RWComponent+'dolog;composeurl;service;jsontoodataerror;resptoerror;objectrestkind;servicename;registerservice;registerentitycontainers;addtoquery;'+
'queryparamstostring;servicecall;getstream;setstream;arrayservicecall;getmulti;createentitycontainer;getentityclass;onlog;webclient;serviceurl;apineedsauth;'+
'odatarequestheaders;lastresponseheaders;odatametadata;';
Var
I : Integer;
RW : String;
begin
Result:=Aname;
For I:=Length(Result) downto 1 do
If Not ((Upcase(Result[i]) in ['_','A'..'Z'])
or ((I>1) and (Result[i] in (['0'..'9'])))) then
Delete(Result,i,1);
if Pos(';'+lowercase(Result)+';',KW)<>0 then
Result:='_'+Result;
if UseExtra<>ekwNone then
begin
Case useExtra of
ekwObject : RW:=RWOdataObject;
ekwEntity : RW:=RWEntity;
ekwEntitySet : RW:=RWEntitySet;
ekwEntityContainer : RW:=RWEntityContainer;
ekwservice : RW:=RWService;
end;
if Pos(';'+lowercase(Result)+';',RW)<>0 then
Result:='_'+Result;
if Assigned(FReservedWords) then
if FReservedWords.IndexOf(Result)<>-1 then
Result:='_'+Result;
end;
end;
function TODataCodeGenerator.CleanPropertyName(const AName: UnicodeString;
UseExtra: TExtraKeyWords): string;
begin
Result:=CleanpropertyName(WTOA(AName),UseExtra);
end;
function TODataCodeGenerator.FlattenName(const AName: String): String;
begin
Result:=StringReplace(AName,'.','_',[rfReplaceAll]);
end;
function TODataCodeGenerator.IsSimpleType(const aType: String): Boolean;
begin
Case LowerCase(aType) of
'boolean': Result:=True;
'byte' : Result:=True;
'tsbyte': Result:=True;
'shortint': Result:=True;
'int16': Result:=True;
'smallint': Result:=True;
'word': Result:=True;
'int32': Result:=True;
'integer': Result:=True;
'cardinal': Result:=True;
'dword': Result:=True;
'int64': Result:=True;
'qwordl': Result:=True;
'tint16': Result:=True;
'tint32': Result:=True;
'tint64': Result:=True;
'string': Result:=True;
'guidstring': Result:=True;
'tguidstring': Result:=True;
'double': Result:=True;
'single': Result:=True;
else
Result:=False;
end;
end;
procedure TODataCodeGenerator.RegisterBaseTypes;
Const
TypeCount = 68;
BaseTypes : Array[1..TypeCount,1..2] of String =
(('Edm.Byte','Byte'), ('Collection(Edm.Byte)','TByteArray'),
('Edm.SByte','TSByte'), ('Collection(Edm.SByte)','TShortintArray'),
('Edm.int16','TInt16'), ('Collection(Edm.int16)','TInt16Array'),
('Edm.int32','TInt32'), ('Collection(Edm.int32)','TInt32Array'),
('Edm.int64','int64'), ('Collection(Edm.int64)','TInt64Array'),
('Edm.string','string'), ('Collection(Edm.string)','TStringArray'),
('Edm.Guid','TGUIDString'), ('Collection(Edm.guid)','TGuidStringArray'),
('Edm.Duration','TDuration'), ('Collection(Edm.Duration)','TStringArray'),
('Edm.Boolean','boolean'), ('Collection(Edm.boolean)','TBooleanArray'),
('Edm.Date','TDate'), ('Collection(Edm.Date)','TDateArray'),
('Edm.DateTime','TDateTime'), ('Collection(Edm.DateTime)','TDateTimeArray'),
('Edm.Time','TTime'), ('Collection(Edm.Time)','TTimeArray'),
('Edm.TimeOfDay','TTimeOfDay'), ('Collection(Edm.TimeOfDay)','TTimeOfDayArray'),
('Edm.DateTimeOffset','TDateTime'), ('Collection(Edm.DateTimeOffcset)','TDateTimeArray'),
('Edm.Decimal','double'), ('Collection(Edm.Decimal)','TDoubleArray'),
('Edm.Double','Double'), ('Collection(Edm.Double)','TDoubleArray'),
('Edm.Single','Single'), ('Collection(Edm.Single)','TSingleArray'),
('Edm.Binary','TBinary'), ('Collection(Edm.Binary)','TBinaryArray'),
('Edm.Stream','TStream'), ('Collection(Edm.Stream)','TByteArrayArray'),
('Edm.Geography','TGeography'), ('Collection(Edm.Geography)','TGeographyArray'),
('Edm.GeographyPoint','TGeographyPoint'), ('Collection(Edm.GeographyPoint)','TGeographyPointArray'),
('Edm.GeographyPolygon','TGeographyPolygon'), ('Collection(Edm.GeographyPolygon)','TGeographyPolygonArray'),
('Edm.GeographyLineString','TGeographyLineString'), ('Collection(Edm.GeographyLineString)','TGeographyLineStringArray'),
('Edm.GeographyMultiPoint','TGeographyMultiPoint'), ('Collection(Edm.GeographyMultiPoint)','TGeographyMultiPointArray'),
('Edm.GeographyMultiString','TGeographyMultiLineString'), ('Collection(Edm.GeographyMultiLineString)','TGeographyMultiLineStringArray'),
('Edm.GeographyMultiPolygon','TGeographyMultiPolygon'), ('Collection(Edm.GeographyMultiPolygon)','TGeographyMultiPolygonArray'),
('Edm.Geometry','TGeometry'), ('Collection(Edm.Geometry)','TGeometryArray'),
('Edm.GeometryPoint','TGeometryPoint'), ('Collection(Edm.GeometryPoint)','TGeometryPointArray'),
('Edm.GeometryPolygon','TGeometryPolygon'), ('Collection(Edm.GeometryPolygon)','TGeometryPolygonArray'),
('Edm.GeometryLineString','TGeometryLineString'), ('Collection(Edm.GeometryLineString)','TGeometryLineStringArray'),
('Edm.GeometryMultiPoint','TGeometryMultiPoint'), ('Collection(Edm.GeometryMultiPoint)','TGeometryMultiPointArray'),
('Edm.GeometryMultiString','TGeometryMultiLineString'), ('Collection(Edm.GeometryMultiLineString)','TGeometryMultiLineStringArray'),
('Edm.GeometryMultiPolygon','TGeometryMultiPolygon'), ('Collection(Edm.GeometryMultiPolygon)','TGeometryMultiPolygonArray'),
('Edm.GeographyCollection','TGeographyArray'), ('Edm.GeometryCollection','TGeometryArray')
);
Var
I : integer;
begin
For I:=1 to TypeCount do
FIdentifierMap.Add(LowerCase(BaseTypes[I,1])+'='+BaseTypes[I,2]);
end;
function TODataCodeGenerator.GetBaseClassName(El: TPasClassType): String;
begin
Result:='';
if Assigned(EL.AncestorType) then
Result:=EL.AncestorType.Name;
if (Result='') then
begin
if EL.InheritsFrom(TServiceClass) then
Result:=BaseServiceType
else if EL.InheritsFrom(TEntityContainerClass) then
Result:=BaseEntityContainerType
else if EL.InheritsFrom(TEntitySetClass) then
Result:=BaseEntitySetType
else if EL.InheritsFrom(TEntityClass) then
Result:=BaseEntityType
else if EL.InheritsFrom(TComplexClass) then
Result:=BaseComplexType
else
Result:=BaseClassName;
end;
end;
function TODataCodeGenerator.CountProperties(C: TPasClassType): Integer;
Var
I : Integer;
begin
Result:=0;
While (C<>Nil) do
begin
For I:=0 to C.Members.Count-1 do
If TObject(C.Members[i]) is TPasProperty then
Inc(Result);
if C.AncestorType is TPasClassType then
C:=C.AncestorType as TPasClassType
else
C:=Nil;
end;
end;
function TODataCodeGenerator.GetResultType(const aType: String; out
AElementType: String): TResultType;
Var
P : Integer;
EN : String;
begin
P:=Pos('array',lowercase(aType));
if (aType='') then
Result:=rtNone
else if IsSimpleType(AType) then
Result:=rtSimple
else if P>0 then
begin
AElementType:=Copy(atype,1,P-1);
EN:=AElementType;
if (EN<>'') and (EN[1]='T') then
Delete(EN,1,1);
if IsSimpleType(EN) then
begin
Result:=rtArraySimple;
AElementType:=EN;
end
else
Result:=rtArrayObject;
end
else
Result:=rtObject;
end;
function TODataCodeGenerator.ConvertTypeToStringExpr(const ExprName,
ExprType: String): String;
begin
Case LowerCase(ExprType) of
'boolean' : Result:='BoolToStr('+ExprName+',''true'',''false'')';
'byte' : Result:='IntToStr('+ExprName+')';
'tsbyte': Result:='IntToStr('+ExprName+')';
'int16': Result:='IntToStr('+ExprName+')';
'int32': Result:='IntToStr('+ExprName+')';
'int64': Result:='IntToStr('+ExprName+')';
'tint16': Result:='IntToStr('+ExprName+')';
'tint32': Result:='IntToStr('+ExprName+')';
'tint64': Result:='IntToStr('+ExprName+')';
'string': Result:='TODataObject.MakeKeyString('+ExprName+')';
'tguidstring': Result:='TODataObject.MakeKeyString('+ExprName+')';
'tdatetime': Result:='FormatDateTime(''yyyy-mm-dd"T"hhmmss'','+ExprName+')';
'double': Result:='FloatToStr('+ExprName+')';
'single': Result:='FloatToStr('+ExprName+')';
'tbinary' : Result:='BinaryToString('+ExprName+')';
else
Raise EEDMX2PasConverter.CreateFmt('GET : Unsupported key type "%s" for %s',[ExprType,ExprName]);
end;
end;
procedure TODataCodeGenerator.EmitOptions;
Var
I : Integer;
S : String;
begin
Addln('(*');
IncIndent;
Addln('Options used to generate: ');
Str(ODataVersion,S);
Addln('OData version : '+S);
Addln('BasecomplexType : '+BaseComplexType);
Addln('BaseEntityType : '+BaseEntityType);
Addln('BaseEntityContainerType : '+BaseEntityContainerType);
Addln('BaseServiceType : '+BaseServiceType);
Addln('BaseEntitySetType : '+BaseEntitySetType);
For I:=0 to Aliases.Count-1 do
Addln('Aliases[%d] : %s',[i,Aliases[i]]);
Addln('SchemaAncestor : '+SchemaAncestor);
Addln('FieldPrefix : '+FieldPrefix);
Addln('ServiceSuffix : '+ServiceSuffix);
Str(EnumerationMode,S);
Addln('EnumerationMode : '+S);
decIndent;
Addln('*)');
end;
end.

46
packages/odata/utils/ras.pas Normal file
View File

@ -0,0 +1,46 @@
{
This unit has been produced by ws_helper.
Input unit name : "System_Data_Resources_AnnotationSchema".
This unit name : "ras".
Date : "12-5-16 15:37:59".
}
unit ras;
{$IFDEF FPC}
{$mode objfpc} {$H+}
{$ENDIF}
{$DEFINE WST_RECORD_RTTI}
interface
uses SysUtils, Classes, TypInfo, base_service_intf, service_intf;
const
sNAME_SPACE = 'http://schemas.microsoft.com/ado/2009/02/edm/annotation';
sUNIT_NAME = 'System_Data_Resources_AnnotationSchema';
type
TStoreGeneratedPattern = (
None
,Identity
,Computed
);
StoreGeneratedPattern_Type = TStoreGeneratedPattern;
LazyLoadingEnabled_Type = boolean;
Implementation
uses metadata_repository, record_rtti;
var
typeRegistryInstance : TTypeRegistry = nil;
initialization
typeRegistryInstance := GetTypeRegistry();
typeRegistryInstance.Register(sNAME_SPACE,TypeInfo(TStoreGeneratedPattern),'TStoreGeneratedPattern');
End.

1047
packages/odata/xml/msgraph.xml Normal file
View File

File diff suppressed because it is too large Load Diff

15696
packages/odata/xml/sharepoint.xml Normal file
View File

File diff suppressed because it is too large Load Diff