{----------------------------------------------------------------------------- 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; { ĦĦ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.