mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-08 07:37:02 +02:00
* Instructions for compilation with 2.6.4
git-svn-id: trunk@48979 -
This commit is contained in:
parent
347c5403b9
commit
7a2e9badfb
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -1633,6 +1633,7 @@ components/fpweb/lazwebextra.lpk svneol=native#text/plain
|
||||
components/fpweb/weblaz.lpk svneol=native#text/plain
|
||||
components/fpweb/weblaz.pas svneol=native#text/plain
|
||||
components/fpweb/weblazideintf.pp svneol=native#text/plain
|
||||
components/googleapis/2_6_4/synapsewebclient.pp svneol=native#text/plain
|
||||
components/googleapis/README.txt svneol=native#text/plain
|
||||
components/googleapis/demo/calendar/calendardemo.lpi svneol=native#text/plain
|
||||
components/googleapis/demo/calendar/calendardemo.lpr svneol=native#text/plain
|
||||
|
174
components/googleapis/2_6_4/synapsewebclient.pp
Normal file
174
components/googleapis/2_6_4/synapsewebclient.pp
Normal file
@ -0,0 +1,174 @@
|
||||
unit synapsewebclient;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpwebclient, httpsend;
|
||||
|
||||
Type
|
||||
|
||||
{ TSynapseRequest }
|
||||
|
||||
TSynapseRequest = Class(TWebClientRequest)
|
||||
Private
|
||||
FHTTP : THTTPSend;
|
||||
Protected
|
||||
function GetHeaders: TStrings;override;
|
||||
function GetStream: TStream;override;
|
||||
Public
|
||||
Constructor Create(AHTTP : THTTPSend);
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TSynapseResponse }
|
||||
|
||||
TSynapseResponse = Class(TWebClientResponse)
|
||||
Private
|
||||
FHTTP : THTTPSend;
|
||||
Protected
|
||||
function GetHeaders: TStrings;override;
|
||||
function GetStream: TStream;override;
|
||||
Function GetStatusCode : Integer; override;
|
||||
Function GetStatusText : String; override;
|
||||
Public
|
||||
Constructor Create(ARequest : TWebClientRequest); override;
|
||||
Destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TSynapseWebClient }
|
||||
|
||||
TSynapseWebClient = Class(TAbstractWebClient)
|
||||
Protected
|
||||
Function DoCreateRequest: TWebClientRequest; override;
|
||||
Function DoHTTPMethod(Const AMethod,AURL : String; ARequest : TWebClientRequest) : TWebClientResponse; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TSynapseRequest }
|
||||
|
||||
function TSynapseRequest.GetHeaders: TStrings;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.Headers
|
||||
else
|
||||
Result:=Inherited GetHeaders;
|
||||
end;
|
||||
|
||||
function TSynapseRequest.GetStream: TStream;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.Document
|
||||
else
|
||||
Result:=Inherited GetStream;
|
||||
end;
|
||||
|
||||
Constructor TSynapseRequest.Create(AHTTP: THTTPSend);
|
||||
begin
|
||||
FHTTP:=AHTTP;
|
||||
end;
|
||||
|
||||
Destructor TSynapseRequest.Destroy;
|
||||
begin
|
||||
FreeAndNil(FHTTP);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TSynapseResponse }
|
||||
|
||||
function TSynapseResponse.GetHeaders: TStrings;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.Headers
|
||||
else
|
||||
Result:=Inherited GetHeaders;
|
||||
end;
|
||||
|
||||
function TSynapseResponse.GetStream: TStream;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.Document
|
||||
else
|
||||
Result:=Inherited GetStream;
|
||||
end;
|
||||
|
||||
Function TSynapseResponse.GetStatusCode: Integer;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.ResultCode
|
||||
else
|
||||
Result:=0;
|
||||
end;
|
||||
|
||||
Function TSynapseResponse.GetStatusText: String;
|
||||
begin
|
||||
if Assigned(FHTTP) then
|
||||
Result:=FHTTP.ResultString
|
||||
else
|
||||
Result:='';
|
||||
end;
|
||||
|
||||
Constructor TSynapseResponse.Create(ARequest : TWebClientRequest);
|
||||
begin
|
||||
Inherited Create(ARequest);
|
||||
FHTTP:=(ARequest as TSynapseRequest).FHTTP;
|
||||
end;
|
||||
|
||||
Destructor TSynapseResponse.Destroy;
|
||||
begin
|
||||
FreeAndNil(FHTTP);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TSynapseWebClient }
|
||||
|
||||
Function TSynapseWebClient.DoCreateRequest: TWebClientRequest;
|
||||
begin
|
||||
Result:=TSynapseRequest.Create(THTTPSend.Create);
|
||||
end;
|
||||
|
||||
Function TSynapseWebClient.DoHTTPMethod(Const AMethod, AURL: String;
|
||||
ARequest: TWebClientRequest): TWebClientResponse;
|
||||
|
||||
Var
|
||||
U,S : String;
|
||||
I : Integer;
|
||||
h : THTTPSend;
|
||||
|
||||
begin
|
||||
U:=AURL;
|
||||
H:=TSynapseRequest(ARequest).FHTTP;
|
||||
S:=ARequest.ParamsAsQuery;
|
||||
if (S<>'') then
|
||||
begin
|
||||
if Pos('?',U)=0 then
|
||||
U:=U+'?';
|
||||
U:=U+S;
|
||||
end;
|
||||
I:=H.Headers.IndexOfName('Content-type');
|
||||
if I<>-1 then
|
||||
begin
|
||||
H.MimeType:=H.Headers.Values['Content-type'];
|
||||
H.Headers.Delete(I);
|
||||
end;
|
||||
if Not H.HTTPMethod(AMethod,U) then
|
||||
begin
|
||||
H.Document.Clear;
|
||||
H.Headers.Clear;
|
||||
H.Cookies.Clear;
|
||||
With H.Sock do
|
||||
Raise EFPWebClient.CreateFmt('HTTP Request failed (%d : %s)',[LastError,LastErrorDesc]);
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=TSynapseResponse.Create(ARequest);
|
||||
if Assigned(ARequest.ResponseContent) then
|
||||
ARequest.ResponseContent.CopyFrom(ARequest.Content,0);
|
||||
TSynapseRequest(ARequest).FHTTP:=Nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -3,6 +3,8 @@ component palette.
|
||||
|
||||
Each Google Service API is a REST API that offers multiple resources.
|
||||
|
||||
See the end of this file for instructions for compiling with FPC 2.6.x
|
||||
|
||||
==================
|
||||
Component overview
|
||||
==================
|
||||
@ -97,3 +99,36 @@ correct scope)
|
||||
|
||||
You can re-use the same Client ID and secret for all examples, or you
|
||||
can create different client IDs and keys, or even create different projects.
|
||||
|
||||
========================
|
||||
Compiling with FPC 2.6.4
|
||||
========================
|
||||
|
||||
The code works with FPC 2.6.4. To work with FPC 2.6.4, you need the
|
||||
following files from the FPC SVN repository (trunk):
|
||||
|
||||
From packages/fcl-web/src/base:
|
||||
|
||||
fpoauth2.pp
|
||||
fphttpwebclient.pp
|
||||
fpwebclient.pp
|
||||
restcodegen.pp
|
||||
restbase.pp
|
||||
fpoauth2ini.pp
|
||||
fpjwt.pp
|
||||
|
||||
From packages/googleapi/src
|
||||
All *.pp files
|
||||
|
||||
There is a directory 2_6_4 to which the files can be copied.
|
||||
|
||||
Additionally, in the directory 2_6_4 there is a unit synapsewebclient.
|
||||
This unit implements a TFPWebclient descendent that works with Synapse.
|
||||
It works with version 2.6.4, and with version 3.x of Free Pascal.
|
||||
|
||||
You need to have compiled the laz_synapse package (distributed with synapse)
|
||||
for this to work.
|
||||
|
||||
To compile the package and the demos, copy the needed files to directory 2_6_4 and
|
||||
add this directory to the source path of the lazgoogleapi package and all
|
||||
demo programs.
|
||||
|
Loading…
Reference in New Issue
Block a user