home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Delphi Anthology
/
aDELPHI.iso
/
Runimage
/
Delphi50
/
Source
/
Vcl
/
mtsrdm.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1999-08-11
|
7KB
|
216 lines
{*******************************************************}
{ }
{ Borland Delphi Visual Component Library }
{ MTS Remote Data Module }
{ }
{ Copyright (c) 1999 Inprise Corporation }
{ }
{*******************************************************}
unit MtsRdm;
{$H+,X+}
interface
uses Windows, Classes, Forms, DataBkr, Mtx, MIDAS;
type
{ TMtsDataModule }
TMtsDataModule = class(TRemoteDataModule, IAppServer, IObjectControl)
private
FAutoComplete: Boolean;
FOnActivate: TNotifyEvent;
FOnDeActivate: TNotifyEvent;
FObjectContext: IObjectContext;
protected
{ IObjectControl }
procedure Activate; safecall;
procedure Deactivate; stdcall;
function CanBePooled: Bool; stdcall;
{ IAppServer }
function AS_GetProviderNames: OleVariant; safecall;
function AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant;
MaxErrors: Integer; out ErrorCount: Integer;
var OwnerData: OleVariant): 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_DataRequest(const ProviderName: WideString;
Data: OleVariant): OleVariant; safecall;
function AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant; safecall;
function AS_RowRequest(const ProviderName: WideString; Row: OleVariant;
RequestType: Integer; var OwnerData: OleVariant): OleVariant; safecall;
procedure AS_Execute(const ProviderName: WideString;
const CommandText: WideString; var Params, OwnerData: OleVariant); safecall;
procedure CallComplete(Complete: Boolean); virtual;
property ObjectContext: IObjectContext read FObjectContext;
public
constructor Create(AOwner: TComponent); override;
procedure SetComplete;
procedure SetAbort;
procedure EnableCommit;
procedure DisableCommit;
function IsInTransaction: Bool;
function IsSecurityEnabled: Bool;
function IsCallerInRole(const Role: WideString): Bool;
published
property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
end;
{$EXTERNALSYM TMtsDataModule}
implementation
uses ComObj;
constructor TMtsDataModule.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAutoComplete := True;
end;
procedure TMtsDataModule.Activate;
begin
FObjectContext := GetObjectContext;
if Assigned(FOnActivate) then FOnActivate(Self);
end;
procedure TMtsDataModule.Deactivate;
begin
if Assigned(FOnDeactivate) then FOnDeactivate(Self);
FObjectContext := nil;
end;
function TMtsDataModule.CanBePooled: Bool;
begin
Result := False;
end;
procedure TMtsDataModule.SetComplete;
begin
if Assigned(FObjectContext) then FObjectContext.SetComplete;
end;
procedure TMtsDataModule.SetAbort;
begin
if Assigned(FObjectContext) then FObjectContext.SetAbort;
end;
procedure TMtsDataModule.EnableCommit;
begin
if Assigned(FObjectContext) then FObjectContext.EnableCommit;
end;
procedure TMtsDataModule.DisableCommit;
begin
if Assigned(FObjectContext) then FObjectContext.DisableCommit;
end;
function TMtsDataModule.IsInTransaction: Bool;
begin
if Assigned(FObjectContext) then Result := FObjectContext.IsInTransaction
else Result := False;
end;
function TMtsDataModule.IsSecurityEnabled: Bool;
begin
if Assigned(FObjectContext) then Result := FObjectContext.IsSecurityEnabled
else Result := False;
end;
function TMtsDataModule.IsCallerInRole(const Role: WideString): Bool;
begin
if Assigned(FObjectContext) then Result := FObjectContext.IsCallerInRole(Role)
else Result := False;
end;
{ IAppServer support }
procedure TMtsDataModule.CallComplete(Complete: Boolean);
begin
if AutoComplete then
if Complete then
SetComplete else
SetAbort;
end;
function TMtsDataModule.AS_GetProviderNames: OleVariant;
begin
try
Result := inherited AS_GetProviderNames;
finally
CallComplete(True);
end;
end;
function TMtsDataModule.AS_ApplyUpdates(const ProviderName: WideString; Delta: OleVariant;
MaxErrors: Integer; out ErrorCount: Integer;
var OwnerData: OleVariant): OleVariant;
begin
try
Result := inherited AS_ApplyUpdates(ProviderName, Delta, MaxErrors, ErrorCount, OwnerData);
if ErrorCount > MaxErrors then
CallComplete(False) else
CallComplete(True);
except
CallComplete(False);
raise;
end;
end;
function TMtsDataModule.AS_GetRecords(const ProviderName: WideString; Count: Integer;
out RecsOut: Integer; Options: Integer; const CommandText: WideString;
var Params, OwnerData: OleVariant): OleVariant;
begin
try
Result := inherited AS_GetRecords(ProviderName, Count, RecsOut, Options,
CommandText, Params, OwnerData);
finally
CallComplete(True);
end;
end;
function TMtsDataModule.AS_DataRequest(const ProviderName: WideString;
Data: OleVariant): OleVariant;
begin
{ No SetComplete call because I don't know what the developer is doing here.
Developer needs to call SetComplete in the OnDataRequest event. }
Result := inherited AS_DataRequest(ProviderName, Data);
end;
function TMtsDataModule.AS_GetParams(const ProviderName: WideString; var OwnerData: OleVariant): OleVariant;
begin
try
Result := inherited AS_GetParams(ProviderName, OwnerData);
finally
CallComplete(True);
end;
end;
function TMtsDataModule.AS_RowRequest(const ProviderName: WideString; Row: OleVariant;
RequestType: Integer; var OwnerData: OleVariant): OleVariant;
begin
try
Result := inherited AS_RowRequest(ProviderName, Row, RequestType, OwnerData);
finally
CallComplete(True);
end;
end;
procedure TMtsDataModule.AS_Execute(const ProviderName: WideString;
const CommandText: WideString; var Params, OwnerData: OleVariant);
begin
try
inherited AS_Execute(ProviderName, CommandText, Params, OwnerData);
finally
CallComplete(True);
end;
end;
end.