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

[Francisco Thiago]

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.