david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
423 lines
14 KiB
ObjectPascal
423 lines
14 KiB
ObjectPascal
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.
|