Browse Source

* Fixes for missing types and changed callback types

michael 5 years ago
parent
commit
d2943a01de
1 changed files with 48 additions and 8 deletions
  1. 48 8
      packages/dataabstract/dadataset.pas

+ 48 - 8
packages/dataabstract/dadataset.pas

@@ -37,6 +37,8 @@ Type
     class function NewUnaryExpression(anExpression: TDAExpression; anOp: TDAUnaryOperator): TDAExpression;
     class function NewUnaryExpression(anExpression: TDAExpression; anOp: TDAUnaryOperator): TDAExpression;
     class function NewConstant(const aValue: jsValue): TDAExpression; overload;
     class function NewConstant(const aValue: jsValue): TDAExpression; overload;
     class function NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression; overload;
     class function NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression; overload;
+    class function NewDateTimeConstant(const aValue: TJSDate): TDAExpression; overload;
+    class function NewDateTimeConstant(const aValue: TDateTime): TDAExpression; overload;
     class function NewList(const aValues: array of TDAExpression): TDAExpression;
     class function NewList(const aValues: array of TDAExpression): TDAExpression;
     class function NewParameter(const aParameterName: string; aParameterType: TDADataType = datUnknown): TDAExpression;
     class function NewParameter(const aParameterName: string; aParameterType: TDADataType = datUnknown): TDAExpression;
     class function NewField(const aTableName,aFieldName: string): TDAExpression;
     class function NewField(const aTableName,aFieldName: string): TDAExpression;
@@ -88,7 +90,7 @@ Type
   TDADataRequest = Class(TDataRequest)
   TDADataRequest = Class(TDataRequest)
   Public
   Public
     Procedure doSuccess(res : JSValue) ;
     Procedure doSuccess(res : JSValue) ;
-    Procedure DoFail(response : TJSOBject; fail : String) ;
+    Procedure DoFail(response: TROMessage; fail: TjsError) ;
   End;
   End;
 
 
   { TDADataProxy }
   { TDADataProxy }
@@ -111,7 +113,7 @@ Type
   TDAStreamerType = (stJSON,stBin);
   TDAStreamerType = (stJSON,stBin);
 
 
   { TDAConnection }
   { TDAConnection }
-
+  TLoginFailedEvent = Reference to procedure (Msg : TROMessage; Err : String);
   TDAConnection = class(TComponent)
   TDAConnection = class(TComponent)
   private
   private
     FDataService: TDADataAbstractService;
     FDataService: TDADataAbstractService;
@@ -121,7 +123,7 @@ Type
     FMessageType: TDAMessageType;
     FMessageType: TDAMessageType;
     FMessage : TROmessage;
     FMessage : TROmessage;
     FChannel : TROHTTPClientChannel;
     FChannel : TROHTTPClientChannel;
-    FOnLoginFailed: TDAFailedEvent;
+    FOnLoginFailed: TLoginFailedEvent;
     FOnLogin: TDALoginSuccessEvent;
     FOnLogin: TDALoginSuccessEvent;
     FOnLogout: TDASuccessEvent;
     FOnLogout: TDASuccessEvent;
     FOnLogoutailed: TDAFailedEvent;
     FOnLogoutailed: TDAFailedEvent;
@@ -138,6 +140,7 @@ Type
     procedure SetLoginServiceName(AValue: String);
     procedure SetLoginServiceName(AValue: String);
     procedure SetMessageType(AValue: TDAMessageType);
     procedure SetMessageType(AValue: TDAMessageType);
     procedure SetURL(AValue: String);
     procedure SetURL(AValue: String);
+    procedure DoLoginFailed(Msg: TROMessage; aErr: TJSError);
   Protected
   Protected
     Procedure CreateChannelAndMessage; virtual;
     Procedure CreateChannelAndMessage; virtual;
     function DetectMessageType(Const aURL: String): TDAMessageType; virtual;
     function DetectMessageType(Const aURL: String): TDAMessageType; virtual;
@@ -177,7 +180,7 @@ Type
     // Called when login call is executed.
     // Called when login call is executed.
     Property OnLogin : TDALoginSuccessEvent Read FOnLogin Write FOnLogin;
     Property OnLogin : TDALoginSuccessEvent Read FOnLogin Write FOnLogin;
     // Called when login call failed. When call was executed but user is wrong OnLogin is called !
     // Called when login call failed. When call was executed but user is wrong OnLogin is called !
-    Property OnLoginCallFailed : TDAFailedEvent Read FOnLoginFailed Write FOnLoginFailed;
+    Property OnLoginCallFailed : TLoginFailedEvent Read FOnLoginFailed Write FOnLoginFailed;
     // Called when logout call is executed.
     // Called when logout call is executed.
     Property OnLogout : TDASuccessEvent Read FOnLogout Write FOnLogout;
     Property OnLogout : TDASuccessEvent Read FOnLogout Write FOnLogout;
     // Called when logout call failed.
     // Called when logout call failed.
@@ -260,6 +263,19 @@ begin
   Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
   Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
 end;
 end;
 
 
+class function TDAWhereClauseBuilder.NewDateTimeConstant(const aValue: TJSDate): TDAExpression; overload;
+
+begin
+  Result:=TDAConstantExpression.New(DataTypeNames[datDateTime],Trunc(aValue.Time/1000),0);
+end;
+
+class function TDAWhereClauseBuilder.NewDateTimeConstant(const aValue: TDateTime): TDAExpression; overload;
+
+begin
+  Result:=NewDateTimeConstant(DateTimeToJSDate(aValue));
+//  Result:=TDAConstantExpression.New(DataTypeNames[datDateTime],DateTimeToJSDate(('yyyy"-"mm"-"dd"T"hh":"nn":"ss',aValue),0);
+end;
+
 class function TDAWhereClauseBuilder.NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression;
 class function TDAWhereClauseBuilder.NewConstant(const aValue: jsValue; aType: TDADataType): TDAExpression;
 begin
 begin
   Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
   Result:=TDAConstantExpression.New(JSValueToDataTypeName(aValue),aValue,Ord(IsNull(aValue)));
@@ -499,15 +515,37 @@ begin
     Raise EDADataset.Create('No login service available. ');
     Raise EDADataset.Create('No login service available. ');
 end;
 end;
 
 
+procedure TDAConnection.DoLoginFailed(Msg : TROMessage; aErr : TJSError);
+
+Var
+  ErrMsg : String;
+
+begin
+  if Assigned(FonLoginFailed) then
+    begin
+    if IsObject(aErr) then
+      if TJSObject(aErr).HasOwnProperty('message') then
+        ErrMsg:=aErr.Message
+      else
+        ErrMsg:='Error object: '+TJSJSON.Stringify(aErr)
+    else if IsString(aErr) then
+      ErrMsg:=String(JSValue(aErr))
+    else
+      ErrMsg:='Unknown error';
+    FOnLoginFailed(Msg,errMsg);
+    end;
+end;
+
+
 procedure TDAConnection.Login(aUserName, aPassword: String);
 procedure TDAConnection.Login(aUserName, aPassword: String);
 
 
 begin
 begin
-  EnsureLoginService.Login(aUserName,aPassword,FOnLogin,FOnLoginFailed);
+  EnsureLoginService.Login(aUserName,aPassword,FOnLogin,@DoLoginFailed);
 end;
 end;
 
 
 procedure TDAConnection.LoginEx(aLoginString: String);
 procedure TDAConnection.LoginEx(aLoginString: String);
 begin
 begin
-  EnsureLoginService.LoginEx(aLoginString,FOnLogin,FOnLoginFailed);
+  EnsureLoginService.LoginEx(aLoginString,FOnLogin,@DoLoginFailed);
 end;
 end;
 
 
 procedure TDAConnection.Logout;
 procedure TDAConnection.Logout;
@@ -534,10 +572,12 @@ begin
     Result:=Pred(Result);
     Result:=Pred(Result);
   if Result=ftUnknown then
   if Result=ftUnknown then
     case LowerCase(s) of
     case LowerCase(s) of
+     'widememo',
      'widestring' : result:=ftString;
      'widestring' : result:=ftString;
      'currency' : result:=ftFloat;
      'currency' : result:=ftFloat;
      'decimal' : result:=ftFloat;
      'decimal' : result:=ftFloat;
      'smallint' : result:=ftInteger;
      'smallint' : result:=ftInteger;
+     'largeautoinc' : result:=ftLargeInt;
     else
     else
       writeln('Unknown field type:',S)
       writeln('Unknown field type:',S)
     end;
     end;
@@ -732,7 +772,7 @@ end;
 
 
 { TDADataRequest }
 { TDADataRequest }
 
 
-procedure TDADataRequest.DoFail(response: TJSOBject; fail: String);
+procedure TDADataRequest.DoFail(response: TROMessage; fail: TjsError);
 
 
 Var
 Var
   O : TJSOBject;
   O : TJSOBject;
@@ -752,7 +792,7 @@ begin
       end;
       end;
     end
     end
   else
   else
-    Msg:=Fail;
+    Msg:=TJSJSON.Stringify(Fail);
   Success:=rrFail;
   Success:=rrFail;
   ErrorMsg:=Msg;
   ErrorMsg:=Msg;
   DoAfterRequest;
   DoAfterRequest;