git-svn-id: https://192.168.0.254/svn/Proyectos.Tecsitel_FactuGES2/trunk@919 0c75b7a4-871f-7646-8a2f-f78d34cc349f
262 lines
6.8 KiB
ObjectPascal
262 lines
6.8 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
||
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.
|
||
|