unit uRODataSnapConnection;

interface

uses DBClient, Classes, Midas,
     {$IFDEF MSWINDOWS}
     ActiveX, ComObj,{ for ISupportErrorInfo }
     {$ENDIF MSWINDOWS}
     uROClient, 
     uRODataSnap_Intf;

type TROCustomDataSnapConnection = class;
     
     TRODataSnapConnectionAssignProxyEvent = procedure(Sender : TROCustomDataSnapConnection; var aProxy: IAppServer) of object;
     
     TROCustomDataSnapConnection = class(TCustomRemoteServer, Midas.IAppServer{$IFDEF MSWINDOWS}, ISupportErrorInfo{$ENDIF MSWINDOWS})
     private
       fMessage: TROMessage;
       fChannel: TRoTransportChannel;
       fStoreConnected: boolean;
       fProxy:uRODataSnap_Intf.IAppServer;
       fServerName: string;

       fOnAssignProxy: TRODataSnapConnectionAssignProxyEvent;
       procedure SetMessage(const Value: TROMessage);
       procedure SetChannel(const Value: TRoTransportChannel);
       procedure SetServerName(const Value: string);

       procedure TriggerAfterConnect;

     private

       { IAppServer }
       function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer; out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant; safecall;
       function AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant; safecall;
       procedure AS_Execute(const ProviderName, CommandText: WideString; var Params, OwnerData: OleVariant); safecall;
       function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; safecall;
       function AS_GetProviderNames: OleVariant; safecall;
       function AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params, OwnerData: OleVariant): OleVariant; safecall;
       function AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;

       { ISupportErrorInfo }
       {$IFDEF MSWINDOWS}
       function InterfaceSupportsErrorInfo(const iid: TIID): HResult; stdcall;
       {$ENDIF MSWINDOWS}

     protected
       function GetConnected: boolean; override;
       procedure SetConnected(Value: boolean); override;
       procedure Notification(AComponent: TComponent; Operation: TOperation); override;
       procedure DoAssignProxy; virtual;
     public
       constructor Create(iOwner:TComponent); override;
       function GetServer: Midas.IAppServer; override;

       procedure GetProviderNames(Proc: TGetStrProc); override;

       property StoreConnected:boolean read fStoreConnected write fStoreConnected default false;

       { ToDo: Connected property is not always properly set to "false"? }
       property Connected:boolean read GetConnected write SetConnected stored fStoreConnected default false;
       property Message:TROMessage read fMessage write SetMessage;
       property Channel:TRoTransportChannel read fChannel write SetChannel;

       { ToDo: create a proper property editor for this }
       property ServerName:string read fServerName write SetServerName;


       {$IFDEF MSWINDOWS}
       function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult; override;
       {$ENDIF}
       property OnAssignProxy: TRODataSnapConnectionAssignProxyEvent read fOnAssignProxy write fOnAssignProxy;
     end;

     TRODataSnapConnection = class(TROCustomDataSnapConnection)
     published
       property Message;
       property Channel;
       property StoreConnected;
       property Connected;
       property ServerName;

       property OnAssignProxy;
     end;

implementation

uses DB, SysUtils, Variants,
     {$IFDEF REMOBJECTS_DESIGNTIME}Forms, Controls, {$ENDIF}
     {$IFDEF DEBUG_REMOBJECTS_DATASNAP}eDebugServer,{$ENDIF}
     uROTypes, uROBinaryHelpers;

{ TROCustomDataSnapConnection }

constructor TROCustomDataSnapConnection.Create(iOwner: TComponent);
begin
  inherited;
  ServerName := 'IAppServer';
end;

function TROCustomDataSnapConnection.AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant; MaxErrors: Integer;  out ErrorCount: Integer; var OwnerData: OleVariant): OleVariant;
var lDelta,lResult:Binary;
    lOwnerData:string;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_ApplyUpdates(ProviderName=%s,MaxErrors=%d)',[ProviderName,MaxErrors]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lOwnerData := OwnerData;
  lDelta := BinaryFromVariant(Delta);
  try
    lResult := fProxy.AS_ApplyUpdates(ProviderName,lDelta,MaxErrors,ErrorCount,lOwnerData);
    try
      result := VariantFromBinary(lResult);
    finally
      FreeAndNil(lResult);
    end;
  finally
    FreeAndNil(lDelta);
  end;
  OwnerData := lOwnerData;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_ApplyUpdates(ErrorCount=%d)',[ErrorCount]); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.AS_DataRequest(const ProviderName: WideString; Data: OleVariant): OleVariant;
var lResult, tmp:Binary;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_DataRequest(ProviderName=%s)',[ProviderName]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  tmp:=BinaryFromVariant(Data);
  try
    lResult := fProxy.AS_DataRequest(ProviderName,tmp);
  finally
    FreeAndNil(tmp);
  end;

  try
    result := VariantFromBinary(lResult);
  finally
    FreeAndNil(lResult);
  end;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_DataRequest()'); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

procedure TROCustomDataSnapConnection.AS_Execute(const ProviderName,CommandText: WideString; var Params, OwnerData: OleVariant);
var lParams,lInParams:Binary;
    lOwnerData:string;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_Execute(ProviderName=%s,CommandText=%s)',[ProviderName,CommandText]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lOwnerData := OwnerData;
  lParams := BinaryFromVariant(Params);
  lInParams := lParams;
  try
    fProxy.AS_Execute(ProviderName,CommandText,lParams,lOwnerData);
  finally
    if (lParams <> lInParams) then FreeAndNil(lParams);
    freeAndNil(lInParams);
  end;
  OwnerData := lOwnerData;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_Execute()'); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
var lResult:Binary;
    lOwnerData:string;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_GetParams(ProviderName=%s)',[ProviderName]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lOwnerData := OwnerData;
  lResult := fProxy.AS_GetParams(ProviderName,lOwnerData);
  try
    result := VariantFromBinary(lResult);
  finally
    FreeAndNil(lResult);
  end;
  OwnerData := lOwnerData;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_GetParams()'); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.AS_GetProviderNames: OleVariant;
var lProviderNames:TProviderNames;
    i:integer;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_GetProviderNames()'); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lProviderNames := fProxy.AS_GetProviderNames();
  try
    result := VarArrayCreate([0,lProviderNames.Count-1],varString);
    for i := 0 to lProviderNames.Count-1 do begin
      result[i] := lProviderNames[i];
    end;    { for }
  finally
    lProviderNames.Free();
  end;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_GetProviderNames()'); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.AS_GetRecords(const ProviderName: WideString; Count: Integer; out RecsOut: Integer; Options: Integer; const CommandText: WideString; var Params, OwnerData: OleVariant): OleVariant;
var lParams,lInParams,lResult:Binary;
    lOwnerData:string;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_GetRecords(ProviderName=%s,Count=%d,Options=%d)',[ProviderName,Count,Options]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lOwnerData := OwnerData;
  lParams := BinaryFromVariant(Params);
  lInParams := lParams;
  try
    lResult := fProxy.AS_GetRecords(ProviderName,Count,RecsOut,Options,CommandText,lParams,lOwnerData);
    try
      result := VariantFromBinary(lResult);
    finally
      FreeAndNil(lResult);
    end;
  finally
    if (lParams <> lInParams) then FreeAndNil(lParams);
    FreeAndNil(lInParams);
  end;
  OwnerData := lOwnerData;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_GetRecords(RecsOut=%d)',[RecsOut]); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.AS_RowRequest(const ProviderName: WideString; Row: OleVariant; RequestType: Integer; var OwnerData: OleVariant): OleVariant;
var lRow,lResult:Binary;
    lOwnerData:string;
begin
  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  DebugServer.EnterMethodEx(self,'TROCustomDataSnapConnection.AS_RowRequest(ProviderName=%s,RequestType=%d)',[ProviderName,RequestType]); try
  try
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}

  Connected := true;
  lOwnerData := OwnerData;
  lRow := BinaryFromVariant(Row);
  try
    lResult := fProxy.AS_RowRequest(ProviderName,lRow,RequestType,lOwnerData);
    try
      result := VariantFromBinary(lResult);
    finally
      FreeAndNil(lResult);
    end;
  finally
    FreeAndNil(lRow);
  end;
  OwnerData := lOwnerData;

  {$IFDEF DEBUG_REMOBJECTS_DATASNAP}
  except DebugServer.WriteException(); raise; end;
  finally DebugServer.ExitMethodEx(self,'TROCustomDataSnapConnection.AS_RowRequest()'); end;
  {$ENDIF DEBUG_REMOBJECTS_DATASNAP}
end;

function TROCustomDataSnapConnection.GetConnected: boolean;
begin
  result := Assigned(fProxy);
end;

function TROCustomDataSnapConnection.GetServer: Midas.IAppServer;
begin
  result := self;
end;

procedure TROCustomDataSnapConnection.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited;
  if Operation = opRemove then begin
    if AComponent = fMessage then begin
      fMessage := nil;
      Connected := False;
    end
    else if AComponent = Channel then begin
      Channel := nil;
      Connected := False;
    end;
  end;
end;

procedure TROCustomDataSnapConnection.SetChannel(const Value:TRoTransportChannel);
begin
  if Value <> fChannel then begin
    fChannel := Value;
    if Assigned(fChannel) then fChannel.FreeNotification(self);
    Connected := False;
  end;
end;

procedure TROCustomDataSnapConnection.SetConnected(Value: boolean);
begin
  if Value = Connected then exit;

  if Value then begin

    if not Assigned(fMessage) then raise Exception.Create('Cannot connect: No Message assigned.');
    if not Assigned(fChannel) then raise Exception.Create('Cannot connect: No TransportChannel assigned.');
    DoAssignProxy;

    TriggerAfterConnect();

  end
  else begin

    fProxy := nil;

  end;
end;

procedure TROCustomDataSnapConnection.SetMessage(const Value:TROMessage);
begin
  if Value <> fMessage then begin
    fMessage := Value;
    if Assigned(fMessage) then fMessage.FreeNotification(self);
    Connected := False;
  end;
end;


procedure TROCustomDataSnapConnection.GetProviderNames(Proc: TGetStrProc);
var lProviderNames:TProviderNames;
    i:integer;
begin
  { This version is a bit optimized over the default one, because we can
    skip converting to a variant array first. }

  {$IFDEF REMOBJECTS_DESIGNTIME}
  Screen.Cursor := crHourGlass;
  try
  {$ENDIF REMOBJECTS_DESIGNTIME}
    Connected := True;
    lProviderNames := fProxy.AS_GetProviderNames();
    try
      for i := 0 to lProviderNames.Count-1 do begin
        Proc(lProviderNames[i]);
      end;    { for }
    finally
      lProviderNames.Free();
    end;
  {$IFDEF REMOBJECTS_DESIGNTIME}
  finally
  	Screen.Cursor := crDefault;
  end;  { try/finally }
  {$ENDIF REMOBJECTS_DESIGNTIME}

end;

{$IFDEF MSWINDOWS}
function TROCustomDataSnapConnection.InterfaceSupportsErrorInfo(const iid: TIID): HResult;
begin
  if GetInterfaceEntry(iid) <> nil then result := S_OK else result := S_FALSE;
end;

function TROCustomDataSnapConnection.SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HResult;
const lErrorGuid : TGUID = '{00000000-0000-0000-0000-000000000000}';
begin
  Result := HandleSafeCallException(ExceptObject, ExceptAddr, lErrorGuid, '', '');
end;
{$ENDIF MSWINDOWS}

procedure TROCustomDataSnapConnection.SetServerName(const Value: string);
begin
  Connected := False;
  fServerName := Value;
end;

procedure TROCustomDataSnapConnection.TriggerAfterConnect;
begin
  if Assigned(AfterConnect) then AfterConnect(self);
end;

procedure TROCustomDataSnapConnection.DoAssignProxy;
begin
  if Assigned(fOnAssignProxy) then OnAssignProxy(Self, fProxy);
  if not Assigned(fProxy) then fProxy := CoAppServer.Create(fServerName, fMessage, fChannel);
end;

end.