Tecsitel_FactuGES2/Source/ApplicationBase/Usuarios/Data/uUCROConn.pas

262 lines
6.8 KiB
ObjectPascal
Raw Blame History

{-----------------------------------------------------------------------------
Unit Name: UCMidasConn
Author : Luiz Benevenuto
Date : 31/07/2005
Purpose : Midas Suporte ( DataSnap )
E-mail : luiz@siffra.com
URL : www.siffra.com
UC : www.usercontrol.com.br
Forum : http://www.usercontrol.com.br/modules.php?name=Forums
registered in UCMidasConnReg.pas
-----------------------------------------------------------------------------}
unit uUCROConn;
interface
//{$I 'UserControl.inc'}
uses
Classes,
DB,
DBClient,
SysUtils,
uRORemoteService, uDADataStreamer, uROBinMessage, uROWinInetHttpChannel,
uDABin2DataStreamer, uDARemoteDataAdapter, UCDataConnector, uROClient;
type
TUCROConn = class(TUCDataConnector)
private
FMessage: TROBinMessage;
FChannel: TROWinInetHTTPChannel;
FRemoteService: TRORemoteService;
FDataAdapter : TDARemoteDataAdapter;
FDataStreamer : TDABin2DataStreamer;
procedure SetServiceName(const Value: String);
function GetServiceName: String;
procedure SetChannel(const Value: TROWinInetHTTPChannel);
procedure SetMessage(const Value: TROBinMessage);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure RefreshROConnection;
public
function GetDBObjectName: String; override;
function GetTransObjectName: String; override;
function UCFindDataConnection: Boolean; override;
function UCFindTable(const Tablename: String): Boolean; override;
function UCGetSQLDataset(FSQL: String): TDataset; override;
procedure UCExecSQL(FSQL: String); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ROServiceName : String read GetServiceName write SetServiceName;
property ROMessage : TROBinMessage read FMessage write SetMessage;
property ROChannel : TROWinInetHTTPChannel read FChannel write SetChannel;
end;
implementation
uses
Forms, Dialogs, FactuGES_Intf, uROTypes, uDAClasses, uDADataTable,
uDACDSDataTable, uROEncryption;
{ TUCROConn }
procedure CopyRecord(Source, Destination: TDataSet);
var Ind:longint;
SField, DField: TField;
begin
for Ind := 0 to Source.FieldCount - 1 do
begin
SField := Source.Fields[ Ind ];
DField := Destination.FindField(SField.FieldName);
if (DField <> nil) and (DField.FieldKind = fkData) and
not DField.ReadOnly then
if (SField.DataType = ftString) or
(SField.DataType <> DField.DataType) then
DField.AsString := SField.AsString
else
DField.Assign( SField )
end;
end;
constructor TUCROConn.Create(AOwner: TComponent);
begin
inherited;
FRemoteService := TRORemoteService.Create(nil);
FDataStreamer := TDABin2DataStreamer.Create(nil);
FDataAdapter := TDARemoteDataAdapter.Create(nil);
FDataAdapter.DataStreamer := FDataStreamer;
FDataAdapter.SetupDefaultRequest;
end;
destructor TUCROConn.Destroy;
begin
FreeAndNil(FRemoteService);
FreeAndNil(FDataAdapter);
FreeAndNil(FDataStreamer);
inherited;
end;
function TUCROConn.GetDBObjectName: String;
begin
if Assigned(FRemoteService) then
begin
if Owner = FRemoteService.Owner then
Result := FRemoteService.Name
else
Result := FRemoteService.Owner.Name + '.' + FRemoteService.Name;
end
else
Result := '';
end;
function TUCROConn.GetServiceName: String;
begin
Result := FRemoteService.ServiceName;
end;
function TUCROConn.GetTransObjectName: String;
begin
Result := '';
end;
procedure TUCROConn.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FRemoteService) then
begin
FreeAndNil(FDataAdapter);
FRemoteService := nil;
end;
inherited Notification(AComponent, Operation);
end;
procedure TUCROConn.RefreshROConnection;
begin
with FRemoteService do
begin
FRemoteService.Message := FMessage;
FRemoteService.Channel := FChannel;
with FDataAdapter do
begin
RemoteService := FRemoteService;
GetSchemaCall.RemoteService := FRemoteService;
GetDataCall.RemoteService := FRemoteService;
UpdateDataCall.RemoteService := FRemoteService;
GetScriptsCall.RemoteService := FRemoteService;
end;
end;
end;
procedure TUCROConn.SetChannel(const Value: TROWinInetHTTPChannel);
begin
FChannel := Value;
RefreshROConnection;
end;
procedure TUCROConn.SetMessage(const Value: TROBinMessage);
begin
FMessage := Value;
RefreshROConnection;
end;
procedure TUCROConn.SetServiceName(const Value: String);
begin
FRemoteService.ServiceName := Value;
end;
procedure TUCROConn.UCExecSQL(FSQL: String);
var
ASQL : String;
begin
ASQL := AnsiToUtf8(FSQL);
(FRemoteService as IsrvUsuarios).SQLExecuteCommand(ASQL);
end;
function TUCROConn.UCFindDataConnection: Boolean;
begin
Result := False;
if Assigned(FRemoteService) then
begin
FRemoteService.CheckCanConnect;
Result := True;
end;
end;
function TUCROConn.UCFindTable(const Tablename: String): Boolean;
var
ASchema : TDASchema;
begin
ASchema := FDataAdapter.ReadSchema;
try
Result := Assigned(ASchema.FindDataset(TableName));
finally
FreeAndNil(ASchema);
end;
end;
function TUCROConn.UCGetSQLDataset(FSQL: String): TDataset;
var
AStream: TMemoryStream;
ADataStreamer: TDABin2DataStreamer;
ADataTable: TDACDSDataTable;
ADataSet : TClientDataset;
procedure _CopiarDataSet;
begin
ADataSet.FieldDefs.Assign(ADataTable.DataSet.FieldDefs);
ADataSet.CreateDataSet;
ADataSet.Open;
while not ADataTable.EOF do
begin
ADataSet.Append;
CopyRecord(ADataTable.DataSet, ADataSet);
ADataSet.Post;
ADataTable.Next;
end;
end;
begin
Result := NIL;
ADataStreamer := TDABin2DataStreamer.Create(NIL);
AStream := (FRemoteService as IsrvUsuarios).SQLGetData(FSQL, True, -1);
if AStream <> nil then
try
ADataTable := TDACDSDataTable.Create(NIL);
// Generar un nombre aleatorio
Randomize;
ADataTable.Name := 'SQLResult' + '_' + IntToStr(Random(MAXINT));
ADataTable.LocalDataStreamer := ADataStreamer;
ADataTable.RemoteFetchEnabled := False;
try
ADataStreamer.ReadDataset(AStream, ADataTable, True);
ADataTable.Open;
{ <20><>OJO!! Trapicheo!!!!!
Forzamos a recuperar en Dataset todas las tuplas
recorriendonos toda la tabla.}
ADataTable.Last;
ADataTable.First;
ADataSet := TClientDataset.Create(NIL);
_CopiarDataSet;
Result := ADataSet;
finally
FreeAndNIL(ADataTable);
end;
finally
FreeAndNIL(AStream);
FreeAndNIL(ADataStreamer);
end;
end;
end.