Thread ClientDataSet

Delphi

25/11/2013

Estou fazendo uma consulta usando Thread, nesta Thread eu crio toda a conexão com o banco. Após fazer a consulta passo o retorno no ClientDataSet da Thread para o ClientDataSet da aplicação.
Até ai está funcionando perfeitamente o único problema que para passar o retorno de um ClientDataSet para outro uso o comando ClientDataSet.CloneCursor(ThdClientDataSet, True) e com isso o ClientDataSet do sistema perde a configuração dos Fields como DisplayLabel, visible, etc e passa a usar a do ClientDataSet da Thread.
Alguém sabe uma maneira de manter a configuração dos Fields?
Obrigado pela ajuda.
Tiago Soares

Tiago Soares

Curtidas 0

Respostas

Tiago Soares

Tiago Soares

25/11/2013

Consegui fazer funcionar.
Ficou assim:
unit uThdConsulta;

interface

uses
  Classes {$IFDEF MSWINDOWS} , Windows {$ENDIF}, IdUDPClient, IdSocketHandle, Messages, Dialogs, SysUtils, DB, Variants,
    dbClient, Graphics, StrUtils, Forms, uLed, DBFre, uFiltroRelatorioPai, ExtCtrls, SqlExpr, ActiveX, Contnrs;

type
  TthdConsulta = class(TThread)
   private
     vgTabelas,
     vgCampos,
     vgRelacionamento,
     vgWhere,
     vgOrderBy,
     vgPrimaryKey   : WideString;
     vgPagina,
     vgQtdDados     : Integer;
     vgFields       : TObjectList;
     vgDivideDados  : Boolean;
     vgData         : TClientDataSetFre;
     vgDst          : TSQLDataSetFre;
     FForm          : TfrmFiltroRelatoriPai;
     FProviderName : string;
     procedure SetName;
    procedure SincronizaConsulta;
    procedure SetDataSet(pDts : TSQLDataSetFre);
    procedure CloneCds(pDst : TSQLDataSetFre);
    procedure GetDataSetConfig;
    procedure SetDataCds;
    procedure Inicia;
    procedure Finaliza;
    function GetProvider(pCds : TClientDataSetFre): TSQLDataSetFre;
  protected
     procedure Execute; override;
  public
    constructor Create; overload;
  published
    property FRM : TfrmFiltroRelatoriPai  read FForm write FForm;
    property ProviderName : string read FProviderName write FProviderName;
  end;        

implementation

uses uRotinasBase;

{$IFDEF MSWINDOWS}
type
  TThreadNameInfo = record
    FType: LongWord;
    FName: PChar;
    FThreadID: LongWord;
    FFlags: LongWord;
  end;
{$ENDIF}

{ TthdConsulta }

procedure TthdConsulta.CloneCds(pDst : TSQLDataSetFre);
var
 I : Integer;
 Field:TField;
begin
 Try
    pDst.FieldDefs.Clear;
    pDst.Fields.Clear;
    for i:=0 to vgFields.Count-1 do
    begin
      case TField(vgFields.Items[i]).DataType of
        ftString:  Field:=TStringField.Create(pDst);
        ftInteger: Field:=TIntegerField.Create(pDst);
        ftFloat:   Field:=TFloatField.Create(pDst);
        ftDate:    Field:=TDateField.Create(pDst);
        ftTime:    Field:=TTimeField.Create(pDst);
        ftDateTime:Field:=TDateTimeField.Create(pDst);
        ftBlob:    Field:=TBlobField.Create(pDst);
        ftMemo:    Field:=TMemoField.Create(pDst);
        ftAutoInc: Field:=TAutoIncField.Create(pDst);
        ftFMTBcd:  Field:=TFMTBCDField.Create(pDst);
        ftTimeStamp: Field:=TSQLTimeStampField.Create(pDst);
        else
          Field:=TField.Create(pDst);
      end;
      with Field do
        begin
          FieldName         := TField(vgFields.Items[i]).FieldName         ;
          Alignment         := TField(vgFields.Items[i]).Alignment         ;
          Calculated        := TField(vgFields.Items[i]).Calculated        ;
          DefaultExpression := TField(vgFields.Items[i]).DefaultExpression ;
          DisplayLabel      := TField(vgFields.Items[i]).DisplayLabel      ;
          DisplayWidth      := TField(vgFields.Items[i]).DisplayWidth      ;
          EditMask          := TField(vgFields.Items[i]).EditMask          ;
          FieldKind         := TField(vgFields.Items[i]).FieldKind         ;
          Index             := TField(vgFields.Items[i]).Index             ;
          KeyFields         := TField(vgFields.Items[i]).KeyFields         ;
          Lookup            := TField(vgFields.Items[i]).Lookup            ;
          LookupCache       := TField(vgFields.Items[i]).LookupCache       ;
          LookupDataSet     := TField(vgFields.Items[i]).LookupDataSet     ;
          LookupKeyFields   := TField(vgFields.Items[i]).LookupKeyFields   ;
          LookupResultField := TField(vgFields.Items[i]).LookupResultField ;
          Origin            := TField(vgFields.Items[i]).Origin            ;
          ParentField       := TField(vgFields.Items[i]).ParentField       ;
          ProviderFlags     := TField(vgFields.Items[i]).ProviderFlags     ;
          ReadOnly          := TField(vgFields.Items[i]).ReadOnly          ;
          Required          := TField(vgFields.Items[i]).Required          ;
          Visible           := TField(vgFields.Items[i]).Visible           ;
        end;
      if TField(vgFields.Items[i]).DataType in [ftInteger, ftFloat, ftFMTBcd] then
        begin
          with TNumericField(Field) do
          begin
            DisplayFormat  := TNumericField(vgFields.Items[i]).DisplayFormat;
            EditFormat     := TNumericField(vgFields.Items[i]).EditFormat   ;
          end;
        end
      else if TField(vgFields.Items[i]).DataType in [ftDateTime, ftDate, ftTime, ftTimeStamp] then
        begin
          with TDateTimeField(Field) do
          begin
            DisplayFormat  := TDateTimeField(vgFields.Items[i]).DisplayFormat;
          end;
        end;
      Field.DataSet       := pDst;
    end;
  finally
   //
 end;
end;

constructor TthdConsulta.Create;
begin
 inherited Create(True); { Chama o contrutor herdado. Ele irá temporariamente colocar o thread em estado de espera para depois executá-lo. }
       FreeOnTerminate := True; // Libera o objeto após terminar.
       Priority := tpHighest; { Configura sua prioridade na lista de processos do Sistema operacional. }
      // Resume; // Inicia o Thread.
end;

procedure TthdConsulta.Execute;
var
 vlSQLCon       : TSQLConnection;
 vlDSP          : TDataSetProviderFre;
begin
 Try
  Try
  //inherited;
    SetName;
    CoInitialize(nil) ; //CoInitialize was not called
    Synchronize(Inicia);
    vlSQLCon                    := TSQLConnection.Create(Application);
    vlSQLCon.LoginPrompt        := False;
    if conecta_banco_ini(vlSQLCon) then
     begin
      vgDst                     := TSQLDataSetFre.Create(Application);
      vgDst.SQLConnection       := vlSQLCon;
      Synchronize(GetDataSetConfig);
      SetDataSet(vgDst);
      vlDSP                     := TDataSetProviderFre.Create(Application);
      vlDSP.DataSet             := vgDst;
      vlDSP.Name                := 'dspThd'+IntToStr(self.ThreadID);
      vgData                    := TClientDataSetFre.Create(Application);
      with vgData do
       begin
        SQLConnection           := vlSQLCon;
        ProviderName            := 'dspThd'+IntToStr(self.ThreadID);
        Active                  := False;
        Active                  := True;
        Synchronize(SetDataCds);
        Active                  := False;
       end;
     end
    else
     raise Exception.Create('Falha ao se conectar ao banco.');
   // Self.Synchronize(TfrmFiltroRelatoriPai(FRM).Cronometro);
   // Self.Synchronize(SincronizaConsulta);
   except
    on e: Exception do
     begin
      ShowMessage('Erro ao Consultar: '+e.Message);
     end;
  End;
 Finally
  if ((Assigned(vgData)) and (vgData <> nil)) then
   FreeAndNil(vgData);
  if Assigned(vlDSP) then
   FreeAndNil(vlDSP);
  if Assigned(vgDst) then
   FreeAndNil(vgDst);
  if Assigned(vlSQLCon) then
   FreeAndNil(vlSQLCon); 
  if Assigned(vgFields) then
   begin
    vgFields.Clear;
    FreeAndNil(vgFields);
   end;
  Self.Terminate;
  Self.Synchronize(Finaliza);
  //Self.Synchronize(TfrmFiltroRelatoriPai(FRM).Cronometro);
  CoUninitialize() ;
 End;
end;

procedure TthdConsulta.Finaliza;
begin
 if Assigned(FRM) then
  begin
   with TfrmFiltroRelatoriPai(FRM) do
    begin
     Aguarde(False);
     Cronometro;
     tmrConsulta.Enabled    := True;
     actImprimir.Enabled    := True;
    end;
  end;
end;

procedure TthdConsulta.GetDataSetConfig;
var
 vlI    : Integer;
 vlDst  : TSQLDataSetFre;
begin
   TClientDataSetFre(FRM.dsAtivo.DataSet).ProviderName    := Self.FProviderName;
   vlDst                    := GetProvider(TClientDataSetFre(FRM.dsAtivo.DataSet));
   vgTabelas                := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.Tabelas;
   vgCampos                 := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.Campos;
   vgRelacionamento         := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.Relacionamento;
   vgPagina                 := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.Pagina;
   vgQtdDados               := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.QtdDados;
   vgDivideDados            := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.DivideDados;
   vgWhere                  := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.Where;
   vgOrderBy                := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.OrderBy;
   vgPrimaryKey             := TClientDataSetFre(FRM.dsAtivo.DataSet).Consulta.PrimaryKey;

   vgFields                 := TObjectList.Create;
   for vlI := 0 to vlDst.FieldCount - 1 do
    begin
      vgFields.Add(vlDst.Fields[vlI]);
    end;
   for vlI := 0 to vgFields.Count - 1 do
    begin
      Tfield(vgFields.Items[vlI]).DataSet := nil;
    end;
end;

function TthdConsulta.GetProvider(pCds: TClientDataSetFre): TSQLDataSetFre;
var
  vlDm   : TDataModule;
  vlDsp  : TDataSetProviderFre;
begin
 Try
  vlDm       := (pCds.Owner as TDataModule);
  //ShowMessage(vlDm.Name);
  vlDsp      := (vlDm.FindComponent(Self.FProviderName) as TDataSetProviderFre);
  if Assigned(vlDsp) then
   Result    := (vlDsp.DataSet as TSQLDataSetFre)
  else
   Result    := nil;

  except
   Result    := nil;
 End;
end;

procedure TthdConsulta.Inicia;
begin
 if Assigned(FRM) then
  begin
   with TfrmFiltroRelatoriPai(FRM) do
    begin
     Aguarde(True);
     Cronometro;
     actConsulta.Enabled    := False;
     actImprimir.Enabled    := False;
    end;
  End;
end;

procedure TthdConsulta.SincronizaConsulta;
begin
 if Assigned(FRM) then
  begin
   Try
    with TfrmFiltroRelatoriPai(FRM) do
     begin
      Aguarde(True);
      //Cronometro;
      //TfrmFiltroRelatoriPai(FRM).tmrCronometro.enabled  := False;

      actConsulta.Enabled    := False;
      actImprimir.Enabled    := False;
      TClientDataSetFre(FRM.dsAtivo.DataSet).Active        := False;
     // TClientDataSetFre(FRM.dsAtivo.DataSet).Close;
      // TClientDataSetFre(dsAtivo.DataSet).IndexDefs.Clear;
      // TClientDataSetFre(dsAtivo.DataSet).IndexName     := EmptyStr;
      //TClientDataSetFre(FRM.dsAtivo.DataSet).Open;
      TClientDataSetFre(FRM.dsAtivo.DataSet).Active       := True;
      StatusBar.Panels[1].Text     := 'Registros Localizados: '+ IntToStr(dsAtivo.DataSet.RecordCount);
      //TfrmFiltroRelatoriPai(FRM).Cronometro;
      Aguarde(False);
      tmrConsulta.Enabled    := True;
      actImprimir.Enabled    := True;
     end;
    except
     on e: Exception do
      begin
       with FRM do
        begin
        // Cronometro;
         Aguarde(False);
         tmrConsulta.Enabled    := True;
         actImprimir.Enabled    := True;
         ShowMessage('Erro ao Consultar: '+e.Message);
        end;
      end;
   End;
  end;
  Self.Terminate;
end;

procedure TthdConsulta.SetDataCds;
begin
 TClientDataSetFre(TfrmFiltroRelatoriPai(FRM).dsAtivo.DataSet).CloneCursor(vgData, True, True);
 TfrmFiltroRelatoriPai(FRM).StatusBar.Panels[1].Text     := 'Registros Localizados: '+ IntToStr(TfrmFiltroRelatoriPai(FRM).dsAtivo.DataSet.RecordCount);
 CloneCds(GetProvider(TClientDataSetFre(TfrmFiltroRelatoriPai(FRM).dsAtivo.DataSet)));
 //TClientDataSetFre(TfrmFiltroRelatoriPai(FRM).dsAtivo.DataSet).ProviderName   := vgProviderName;
end;

procedure TthdConsulta.SetDataSet(pDts: TSQLDataSetFre);
begin
  CloneCds(pDts);
  with pDts, Consulta do
    begin
     Active                 := False;
     Tabelas                := vgTabelas;
     Campos                 := vgCampos;
     Relacionamento         := vgRelacionamento;
     Pagina                 := vgPagina;
     QtdDados               := vgQtdDados;
     DivideDados            := vgDivideDados;
     Where                  := vgWhere;
     OrderBy                := vgOrderBy;
     //FieldDefList           := vgFields;
     AtivaConsulta          := True;
    end;
end;

procedure TthdConsulta.SetName;
{$IFDEF MSWINDOWS}
var
  ThreadNameInfo: TThreadNameInfo;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  ThreadNameInfo.FType := $1000;
  ThreadNameInfo.FName := 'thdConsulta';
  ThreadNameInfo.FThreadID := $FFFFFFFF;
  ThreadNameInfo.FFlags := 0;

  try
    RaiseException( $406D1388, 0, sizeof(ThreadNameInfo) div sizeof(LongWord), @ThreadNameInfo );
  except
  end;
{$ENDIF}
end;

end.


Agora vo dar uma acertada no código, se alguem tiver uma sugestão posta ai
GOSTEI 0
POSTAR