[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