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

* Small command-line client that shows how to load data from SQLDB Rest Bridge into TBufDataset

Browse Source 
git-svn-id: trunk@41657 -
This commit is contained in:
michael 2019-03-09 17:36:30 +00:00
parent aee381c14b
commit e32d18977c
3 changed files with 225 additions and 0 deletions
.gitattributes
packages/fcl-web/examples/restbridge/cmdclient
cmdclient.lpicmdclient.pas

2
.gitattributes vendored
View File

@ -3320,6 +3320,8 @@ packages/fcl-web/examples/jsonrpc/extdirect/extdirect.in svneol=native#text/plai
packages/fcl-web/examples/jsonrpc/extdirect/wmext.lfm svneol=native#text/plain
packages/fcl-web/examples/jsonrpc/extdirect/wmext.pp svneol=native#text/plain
packages/fcl-web/examples/restbridge/README.txt svneol=native#text/plain
packages/fcl-web/examples/restbridge/cmdclient/cmdclient.lpi svneol=native#text/plain
packages/fcl-web/examples/restbridge/cmdclient/cmdclient.pas svneol=native#text/plain
packages/fcl-web/examples/restbridge/delphiclient/frmmain.dfm svneol=native#text/plain
packages/fcl-web/examples/restbridge/delphiclient/frmmain.pas svneol=native#text/plain
packages/fcl-web/examples/restbridge/delphiclient/sqldbrestclient.dpr svneol=native#text/plain

57
packages/fcl-web/examples/restbridge/cmdclient/cmdclient.lpi Normal file
View File

@ -0,0 +1,57 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="SQLDB Rest Bridge client application"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<Units Count="1">
<Unit0>
<Filename Value="cmdclient.pas"/>
<IsPartOfProject Value="True"/>
</Unit0>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="cmdclient"/>
</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>

166
packages/fcl-web/examples/restbridge/cmdclient/cmdclient.pas Normal file
View File

@ -0,0 +1,166 @@
program cmdclient;
{$mode objfpc}{$H+}
uses
cwstring,Classes, SysUtils, CustApp, fphttpclient, db, bufdataset, XMLDatapacketReader;
type
{ TSQLDBRestClientApplication }
TSQLDBRestClientApplication = class(TCustomApplication)
Private
FURL: String;
FUserName: string;
FPassword: string;
FShowRaw : Boolean;
protected
procedure RunQuery(aDataset: TBufDataset);
Procedure ShowData(aDataset: TDataset);
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
end;
{ TSQLDBRestClientApplication }
procedure TSQLDBRestClientApplication.RunQuery(aDataset : TBufDataset);
Var
C : TFPHTTPClient;
S : TStringStream;
U : String;
begin
U:=FURL;
S:=Nil;
C:=TFPHTTPClient.Create(Self);
try
C.UserName:=FUserName;
C.Password:=FPassword;
S:=TStringStream.Create;
if Pos('?',U)=0 then
U:=U+'?'
else
U:=U+'&';
U:=U+'fmt=buf';
C.Get(U,S);
if FShowRaw then
begin
Writeln('Raw request data:');
Writeln('---');
Writeln(S.Datastring);
Writeln('---');
end;
S.Position:=0;
aDataset.LoadFromStream(S,dfXML);
finally
S.Free;
C.Free;
end;
end;
procedure TSQLDBRestClientApplication.ShowData(aDataset: TDataset);
Var
I : Integer;
F : TField;
FL : Integer;
begin
FL:=0;
With aDataset do
begin
For I:=0 to FieldDefs.Count-1 do
if Length(FieldDefs[I].Name)>FL then
FL:=Length(FieldDefs[I].Name);
While not EOF do
begin
Writeln(StringOfChar('-',FL));
Writeln('Record: ',RecNo:4);
Writeln(StringOfChar('-',FL));
For F in Fields do
With F do
begin
Write(FieldName:FL,': ');
if F.IsNull then
Writeln('<NULL>')
else
Writeln(F.AsString);
end;
Next;
end;
end;
end;
procedure TSQLDBRestClientApplication.DoRun;
var
ErrorMsg: String;
D : TBufDataset;
begin
// quick check parameters
ErrorMsg:=CheckOptions('hU:u:p:r', ['help','url:','username:','password:','raw']);
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h', 'help') then begin
WriteHelp;
Terminate;
Exit;
end;
FURL:=GetOptionValue('U','url');
FUserName:=GetOptionValue('u','username');
FPassword:=GetOptionValue('p','password');
FShowRaw:=HasOption('r','raw');
D:=TBufDataset.Create(Self);
try
RunQuery(D);
ShowData(D);
Finally
D.Free;
end;
// stop program loop
Terminate;
end;
constructor TSQLDBRestClientApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TSQLDBRestClientApplication.Destroy;
begin
inherited Destroy;
end;
procedure TSQLDBRestClientApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ', ExeName, ' [options]');
Writeln('Where options is one or more of:');
Writeln('-h --help this message');
Writeln('-p --password=PWD HTTP Basic authentication password.');
Writeln('-r --raw Show raw request data');
Writeln('-U --url=URL URL to get data from. Do not add format (fmt) parameter');
Writeln('-u --username=User HTTP Basic authentication username');
end;
var
Application: TSQLDBRestClientApplication;
begin
Application:=TSQLDBRestClientApplication.Create(nil);
Application.Title:='SQLDB Rest Bridge client application';
Application.Run;
Application.Free;
end.