[firebase-br] Amigos, ajuda aqui (off)

Nilton Souza ntn em bbs2.sul.com.br
Seg Out 4 09:12:10 -03 2004


Olá Francisco,

Existem dois problemas nesta UNIT:

1) Falta dar um override nos constructors/destructors Create e Destroy;
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;

2) Falta criar o método de gravação para a propriedade ExportContent

[]'s
Nilton Souza

----- Original Message -----
From: "Francisco Thiago" <jeandeadlucky em yahoo.com.br>
To: "FireBase" <lista em firebase.com.br>
Sent: Saturday, October 02, 2004 4:03 PM
Subject: Re: [firebase-br] Amigos, ajuda aqui (off)


> Olá Nilton!
>
> Eu fiz exatamente como você falou, mas quando eu tento gravar qualquer
coisa
> nesta variável, ele dá erro de acesso de memória.. Já usei o TStringList,
o
> TStrings e nao deu certo. O tipo TList, eu usarei mas tarde, mas creio ser
a
> mesma coisa
>
> Abaixo vai o código:
>
> unit uExport;
>
> interface
>
> uses
>   SysUtils, Classes, DB, DBClient, Provider, QDialogs;
>
> type
>   TTypeExport = (teTXTLineDelimited,teXMLDataPacket,teBinary,teSQL);
>   TCustomExport = class(TComponent)
>   private
>     { Private declarations }
>     FArquivoDestino       :String;
>     FDataSet              :TDataSet;
>     FCampos               :TStrings;
>     FExportContent        :TStrings;
>     FTypeExport           :TTypeExport;
>     FAfterExportData      :TNotifyEvent;
>     procedure setArquivoDestino(const Value: String);
>     procedure setDataExport(const Value: TTypeExport);
>     procedure setDataSet(const Value: TDataSet);
>     function ToTxtLines   :String;
>     function ToSQL        :String;
>     function ToCDSXML     :String;
>     procedure setFCampos(const Value: TStringList);
>   protected
>     { Protected declarations }
>   public
>     { Public declarations }
>     constructor Create(AOwner : TComponent);
>     destructor Destroy;
>     procedure Exportar;
>   published
>     { Published declarations }
>     property ArquivoDestino :String       read FArquivoDestino  write
> setArquivoDestino;
>     property DataSet        :TDataSet     read FDataSet         write
> setDataSet;
>     property Campos         :TStrings     read FCampos          write
> setFCampos;
>     property ExportContent  :TStrings     read FExportContent;
>     property TypeExport     :TTypeExport  read FTypeExport      write
> setDataExport;
>     property AfterExportData:TNotifyEvent read FAfterExportData write
> FAfterExportData;
>   end;
>
> procedure Register;
>
> implementation
>
> procedure Register;
> begin
>   RegisterComponents('Veronica', [TCustomExport]);
> end;
>
> { TCustomExport }
>
> constructor TCustomExport.Create(AOwner: TComponent);
> begin
>   FArquivoDestino :='';
>   FCampos := TStrings.Create;
>   FExportContent := TStrings.Create;
>   inherited Create(AOwner);
> end;
>
> destructor TCustomExport.Destroy;
> begin
>   FreeAndNil(FExportContent);
>   FreeAndNil(FCampos);
>   inherited Destroy;
> end;
>
> procedure TCustomExport.Exportar;
> begin
>   case FTypeExport of
>     teTXTLineDelimited        : FExportContent.Text := ToTxtLines;
>     teXMLDataPacket, teBinary : FExportContent.Text := ToCDSXML;
>     teSQL                     : FExportContent.Text := ToSQL;
>   end;
>   if Assigned(FAfterExportData) then
>     FAfterExportData(Self);
> end;
>
> procedure TCustomExport.setArquivoDestino(const Value: String);
> begin
>   FArquivoDestino := Value;
> end;
>
> procedure TCustomExport.setDataExport(const Value: TTypeExport);
> begin
>   FTypeExport := Value;
> end;
>
> procedure TCustomExport.setDataSet(const Value: TDataSet);
> begin
>   FDataSet := Value;
> end;
>
> procedure TCustomExport.setFCampos(const Value: TStringList);
> begin
>   FCampos := Value;
> end;
>
> function TCustomExport.ToCDSXML :String;
> var
>   ls_Result :String;
>   CDS :TClientDataSet;
>   DSP :TDataSetProvider;
> begin
>   ls_Result := '';
>   DSP := TDataSetProvider.Create(nil);
>   CDS := TClientDataSet.Create(nil);
>   try
>     try
>       DSP.DataSet := FDataSet;
>       DSP.Name := 'DSP';
>       CDS.Data := DSP.Data;
>       CDS.Open;
>       if FTypeExport = teBinary then begin
>         CDS.SaveToFile(FArquivoDestino,dfBinary);
>         ls_Result := '(Arquivo binário)';
>       end else begin
>         CDS.SaveToFile(FArquivoDestino,dfXML);
>         ls_Result := CDS.XMLData;
>       end;
>       CDS.Close;
>     except
>       on E :Exception do begin
>         ls_Result :='Erro ao exportar dados'+ #$D#$A + E.message;
>         Raise Exception.Create(ls_Result);
>       end;
>     end;
>   finally
>     FreeAndNil(CDS);
>     FreeAndNil(DSP);
>     Result := ls_Result;
>   end;
> end;
>
> function TCustomExport.ToSQL :String;
> begin
>
> end;
>
> function TCustomExport.ToTxtLines:String;
> var
>   Text :TStringList;
>   i    :ShortInt;
> begin
>   Text := TStringList.Create;
>   Text.Clear;
>   try
>     if Not FDataSet.Active then
>       FDataSet.Open;
>     FDataSet.First;
>     while not FDataSet.Eof do begin
>       for i := 0 to FCampos.Count - 1 do begin
>         if FDataSet.FieldByName(FCampos.Names[i]).IsNull then
>           Text.Add('')
>         else if FDataSet.FieldByName(FCampos.Names[i]).DataType = ftBlob
> then
>           Text.Add('BlobField')
>         else
>           Text.Add(FDataSet.FieldByName(FCampos.Names[i]).DisplayText);
>       end;
>       FDataSet.Next;
>     end;
>     Text.SaveToFile(FArquivoDestino);
>   finally
>     Result := Text.Text;
>     FreeAndNil(Text);
>   end;
> end;
>
> end.
>
>
> ______________________________________________
> FireBase-BR (www.firebase.com.br)
> Para editar sua configuração na lista, use o endereço
http://mail.firebase.com.br/mailman/listinfo/lista_firebase.com.br
>





Mais detalhes sobre a lista de discussão lista