Skip to content
Permalink
Browse files

Merge pull request #183 from maciej-izak/warleyalex_sms

Warleyalex sms fixes
  • Loading branch information...
synopse committed Sep 4, 2019
2 parents 6b2a389 + 0ffa957 commit 4716ddc7d231fdfdf6517e250d61e21792361a0d
Showing with 84 additions and 16 deletions.
  1. +27 −5 CrossPlatform/SynCrossPlatformREST.pas
  2. +39 −10 CrossPlatform/SynCrossPlatformSpecific.pas
  3. +18 −1 SQLite3/mORMotWrappers.pas
@@ -106,6 +106,20 @@ TSQLRecordClass = class of TSQLRecord;

{$ifdef ISDWS}

// UTILS functions
function window: variant; external 'window' property;
function document: variant; external 'document' property;

// URI functions
function EncodeURIComponent(str: String): String; external 'encodeURIComponent';
function DecodeURIComponent(str: String): String; external 'decodeURIComponent';
function EncodeURI(str: String): String; external 'encodeURI';
function DecodeURI(str: String): String; external 'decodeURI';

// Variant management
function VarIsValidRef(const aRef: Variant): Boolean;

type
// circumvent limited DWS / SMS syntax
TPersistent = TObject;
TObjectList = array of TObject;
@@ -566,7 +580,7 @@ TSQLRestClientURI = class;
// so e.g. for a sicShared instance, you can safely write:
// ! aIntegerResult := TServiceCalculator.Create(aClient).Add(10,20);
// - as you already noted, server-side interface-based services are in fact
// consumed without any interface in this cross-platform unit!
// consummed without any interface in this cross-platform unit!
TServiceClientAbstract = class{$ifndef ISDWS}(TInterfacedObject){$endif}
protected
fClient: TSQLRestClientURI;
@@ -801,7 +815,7 @@ TSQLRest = class
// specify a CSV list of field values to be transmitted - including blobs,
// which will be sent as base-64 encoded JSON
function Add(Value: TSQLRecord; SendData: boolean; ForceID: boolean=false;
const FieldNames: string=''): TID; virtual;
FieldNames: string=''): TID; virtual;
/// delete a member
function Delete(Table: TSQLRecordClass; ID: TID): boolean; virtual; abstract;
/// update a member
@@ -1320,6 +1334,14 @@ function GetOutHeader(const Call: TSQLRestURIParams; const Name: string): string

implementation

{$ifdef ISDWS}
function VarIsValidRef(const aRef: Variant): Boolean;
begin
asm
@Result = !((@aRef == null) || (@aRef == undefined));
end;
end;
{$endif}
function IsRowID(const PropName: string): boolean;
begin
result := IdemPropName(PropName,'ID') or
@@ -1392,7 +1414,7 @@ function TTimeLogToDateTime(Value: TTimeLog): TDateTime;
Y := (Value shr (6+6+5+5+4)) and 4095;
{$endif}
if (Y=0) or not TryEncodeDate(Y,1+(Value shr (6+6+5+5)) and 15,
1+(Value shr (6+6+5)) and 31,result) then
1+(Value shr (6+6+5)) and 31,DateTimeZone.UTC,result) then
result := 0;
if (Value and (1 shl (6+6+5)-1)<>0) and
TryEncodeTime((Value shr (6+6)) and 31,
@@ -2296,7 +2318,7 @@ function TSQLRest.RetrieveList<T>(const FieldNames, SQLWhere: string;
{$endif}

function TSQLRest.Add(Value: TSQLRecord; SendData, ForceID: boolean;
const FieldNames: string): TID;
FieldNames: string): TID;
var tableIndex: Integer;
json: string;
begin
@@ -3318,7 +3340,7 @@ procedure TSQLRestClientHTTP.SetHttpBasicAuthHeaders(const aUserName, aPasswordC
begin
base64 := aUsername+':'+aPasswordClear;
{$ifdef ISSMS}
base64 := w3_base64encode(base64);
base64 := window.btoa(base64);
{$else}
base64 := BytesToBase64JSONString(TByteDynArray(TextToHttpBody(base64)),false);
{$endif}
@@ -97,7 +97,6 @@ interface
SmartCL.System,
System.Types,
ECMA.Date,
System.Date,
ECMA.Json;
{$else}
uses
@@ -111,7 +110,16 @@ interface

type
{$ifdef ISDWS}

JDateHelper = helper for JDate
private
function GetAsDateTime : TDateTime;
function GetAsLocalDateTime : TDateTime;
procedure SetAsDateTime(dt : TDateTime);
procedure SetAsLocalDateTime(dt : TDateTime);
public
property AsDateTime : TDateTime read GetAsDateTime write SetAsDateTime;
property AsLocalDateTime : TDateTime read GetAsLocalDateTime write SetAsLocalDateTime;
end;
// HTTP body may not match the string type, and could be binary
THttpBody = string;

@@ -346,7 +354,7 @@ function StartWithPropName(const PropName1,PropName2: string): boolean;
function VarRecToValue(const VarRec: variant; var tmpIsString: boolean): string;
procedure DecodeTime(Value: TDateTime; var HH,MM,SS,MS: word);
procedure DecodeDate(Value: TDateTime; var Y,M,D: word);
function TryEncodeDate(Y,M,D: integer; var Value: TDateTime): boolean;
function TryEncodeDate(Y,M,D: integer; UTC: DateTimeZone; var Value: TDateTime): boolean;
function TryEncodeTime(HH,MM,SS,MS: integer; var Value: TDateTIme): boolean;
function NowToIso8601: string;
function DateTimeToIso8601(Value: TDateTime): string;
@@ -426,6 +434,27 @@ implementation
System.Net.HttpClient;
{$endif}

{$ifdef ISDWS}
function JDateHelper.GetAsDateTime : TDateTime;
begin
Result := Self.getTime / 864e5 + 25569;
end;

procedure JDateHelper.SetAsDateTime(dt : TDateTime);
begin
Self.setTime(round((dt - 25569) * 864e5));
end;

function JDateHelper.GetAsLocalDateTime: TDateTime;
begin
Result := (Self.getTime - 60000 * Self.getTimezoneOffset) / 864e5 + 25569;
end;

procedure JDateHelper.SetAsLocalDateTime(dt: TDateTime);
begin
Self.setTime(round((dt - 25569) * 864e5) + 60000 * Self.getTimezoneOffset);
end;
{$endif}

function TextToHttpBody(const Text: string): THttpBody;
{$ifdef ISSMS}
@@ -906,10 +935,10 @@ procedure DecodeDate(Value: TDateTime; var Y,M,D: word);
D := date.getUTCDate;
end;

function TryEncodeDate(Y,M,D: integer; var Value: TDateTime): boolean;
function TryEncodeDate(Y,M,D: integer; UTC: DateTimeZone; var Value: TDateTime): boolean;
begin
try
Value := EncodeDate(Y,M,D);
Value := EncodeDate(Y,M,D, DateTimeZone.UTC);
result := true
except
result := false;
@@ -963,10 +992,10 @@ function DateTimeToIso8601(Value: TDateTime): string;
if Value<=0 then
result := '' else
if frac(Value)=0 then
result := FormatDateTime('yyyy-mm-dd',Value) else
result := FormatDateTime('yyyy-mm-dd',Value,DateTimeZone.UTC) else
if trunc(Value)=0 then
result := FormatDateTime('Thh:nn:ss',Value) else
result := FormatDateTime('yyyy-mm-ddThh:nn:ss',Value);
result := FormatDateTime('Thh:nn:ss',Value,DateTimeZone.UTC) else
result := FormatDateTime('yyyy-mm-ddThh:nn:ss',Value,DateTimeZone.UTC);
end;

function Iso8601ToDateTime(const Value: string): TDateTime;
@@ -986,7 +1015,7 @@ function Iso8601ToDateTime(const Value: string): TDateTime;
ord(Value[3])*10+ord(Value[4])-(48+480+4800+48000);
M := ord(Value[6])*10+ord(Value[7])-(48+480);
D := ord(Value[9])*10+ord(Value[10])-(48+480);
TryEncodeDate(Y,M,D,result);
TryEncodeDate(Y,M,D,DateTimeZone.UTC,result);
end;
19: if (Value[5]=Value[8]) and (ord(Value[8]) in [ord('-'),ord('/')]) and
(ord(Value[11]) in [ord(' '),ord('T')]) and (Value[14]=':') and (Value[17]=':') then begin
@@ -999,7 +1028,7 @@ function Iso8601ToDateTime(const Value: string): TDateTime;
SS := ord(Value[18])*10+ord(Value[19])-(48+480);
if (Y<=9999) and ((M-1)<12) and ((D-1)<31) and
(HH<24) and (MI<60) and (SS<60) then
result := EncodeDate(Y,M,D)+EncodeTime(HH,MI,SS,0);
result := EncodeDate(Y,M,D,DateTimeZone.UTC)+EncodeTime(HH,MI,SS,0);
end;
end;
end;
@@ -61,6 +61,7 @@ interface

uses
{$ifdef ISDELPHIXE2}System.SysUtils,{$else}SysUtils,{$endif}
StrUtils,
Classes,
Contnrs,
Variants,
@@ -607,6 +608,7 @@ function TWrapperContext.ContextArgsFromMethod(const meth: TServiceMethod): vari
with meth.Args[a] do begin
arg := ContextFromInfo(TYPES_SOA[ValueType],'',ArgTypeInfo);
arg.argName := ParamName^;
arg.argType := ArgTypeName^;
arg.dir := ord(ValueDirection);
arg.dirName := DIRTODELPHI[ValueDirection];
arg.dirNoOut := DIRTOSMS[ValueDirection]; // no OUT in DWS/SMS -> VAR instead
@@ -842,6 +844,17 @@ function TWrapperContext.ContextNestedProperties(rtti: TJSONCustomParserRTTI): v
end;
end;

function Get2ndPart(const WholeText: string; const Delimiter: string): string;
var
A: integer;
begin
A := Pos(Delimiter, WholeText);
if A > 0 then
Result := TrimLeft(AnsiRightStr(WholeText, Length(WholeText) - A))
else
Result := '';
end;

function TWrapperContext.ContextFromInfo(typ: TWrapperType; typName: RawUTF8;
typInfo: PTypeInfo): variant;
var typeWrapper: PShortString;
@@ -925,7 +938,11 @@ procedure RegisterType(var list: TDocVariantData);
end;
if typName='' then begin
if typInfo<>nil then
TypeInfoToQualifiedName(typInfo,typName) else
begin
TypeInfoToQualifiedName(typInfo,typName);
if AnsiContainsStr(typName, '.') then
typName := Get2ndPart(typName, '.')
end else
typName := TYPES_LANG[lngDelphi,typ];
end;
if (typ=wRecord) and IdemPropNameU(typName,'TGUID') then

0 comments on commit 4716ddc

Please sign in to comment.
You can’t perform that action at this time.