Ir para conteúdo
Fórum Script Brasil
  • 0

(Resolvido) Exportar dados para txt com colunas


Duduh_Capixaba

Pergunta

Olá pessoal! Como já deu pra perceber no título, eu consigo exportar os dados da minha base de dados para um arquivo texto, isso é fácil. Exportar os dados separados com ";" (ponto e vírgula) ou qualquer outro caracter eu já consegui. Mas meu caso é diferente, e não encontrei nada relacionado com isso aqui no fórum. Vamos lá:

Tenho que criar um arquivo txt, com os dados dos clientes do meu sistema, no seguinte layout:

Campo ----- Início ----- Tamanho ----- Tipo de Dado

----------------------------------------------------------------------

Código ----- 001 ----- 15 ----- Alfanumérico

Nome ----- 016 ----- 40 ----- Alfanumérico

CPFCGC ----- 107 ----- 20 ----- Numérico

Endereço ----- 127 ----- 40 ----- Alfanumérico

Bairro ----- 167 ----- 15 ----- Alfanumérico

Cidade ----- 182 ----- 15 ----- Alfanumérico

UF ----- 197 ----- 02 ----- Alfanumérico

CEP ----- 199 ----- 08 ----- Numérico

Fone ----- 207 ----- 20 ----- Alfanumérico

Ou seja, o arquivo texto deve ser montado por colunas. Cada uma começa em um determinado ponto do arquivo e tem um determinado tamanho. Mas não sei como contar espaços dentro de um txt. Alguém tem alguma idéia de algum comando que eu possa mover o cursor dentro do arquivo?

Esse é o código que eu uso para exportar com ponto e vírgula:

procedure TForm1.Button2Click(Sender: TObject);
var
  F: TextFile;

begin
  AssignFile(F, NomeArq);
  Rewrite(F);

  Table1.Open;
  Table1.First;

  while not Table1.Eof do begin
    Writeln(F,
    Table1.Fields[0].AsString + ';' +
    Table1.Fields[1].AsString + ';' +
    Table1.Fields[2].AsString + ';' +
    Table1.Fields[3].AsString + ';' +
    Table1.Fields[4].AsString + ';' +
    Table1.Fields[5].AsString + ';' +
    Table1.Fields[6].AsString + ';' +
    Table1.Fields[7].AsString + ';' +
    Table1.Fields[8].AsString);
    Table1.Next;
  end;

  CloseFile(F);
end;

Editado por Duduh_Capixaba
Link para o comentário
Compartilhar em outros sites

6 respostass a esta questão

Posts Recomendados

  • 0
(...) Mas meu caso é diferente, e não encontrei nada relacionado com isso aqui no fórum.
Tem certeza?!

Olhe este tópico: Enviar direto para impressora, Tabulado

A única diferença é que a variável Texto, não será a LPT1, mas sim seu arquivo (no seu exemplo: F) - não tem que mudar uma vírgula do conceito. ;)

Abraços

Link para o comentário
Compartilhar em outros sites

  • 0

Outra forma, é criando funções, como as abaixo.

PADL - Texto na esquerda

PADC - Texto centralizado

PADR - Texto na direita

Os espaços em branco podem ser preenchidos por qualquer caracter, inclusive o espaço. ( ' ' )

Function TProc.PADL ( mTEXTO, mCARAC : string; mTAM : Integer ): String;
var
mRET      : String ;
mPREENCHE : string ;
i         : Integer;
mFALTA    : Integer;
begin

  mRET := '';
  if length ( mTEXTO ) > 0 then begin

      mTEXTO := Copy ( mTEXTO, 1, mTAM );

      mFALTA    := mTAM - Length ( mTEXTO );
      mPREENCHE := '';
      for i := 1 to mFALTA  do begin
        mPREENCHE := mPREENCHE + mCARAC;
      end;
      mRET := mTEXTO + mPREENCHE ;

  end;
  result := mRET;

end;

// ***********************************************************************

Function TProc.PADC ( mTEXTO, mCARAC : string; mTAM : Integer ): String;
var
mRET      : String ;
mPREENCHE : string ;
i         : Integer;
mFALTA    : Integer;
begin

  mRET := '';
  if length ( mTEXTO ) > 0 then begin
    mTEXTO := Copy ( mTEXTO, 1, mTAM );

    mFALTA    := mTAM - Length ( mTEXTO ) ;
    mPREENCHE := '';
    for i := 1 to mFALTA  do begin
      if i MOD 2 = 0 then mPREENCHE := mPREENCHE + mCARAC;
    end;
    mRET := mPREENCHE + mTEXTO + mPREENCHE ;

  end;
  result := mRET;
end;

// ***********************************************************************

Function TProc.PADR ( mTEXTO, mCARAC : string; mTAM : Integer ): String;
var
mRET      : String ;
mPREENCHE : string ;
i         : Integer;
mFALTA    : Integer;
begin

  mRET := '';
  if length ( mTEXTO ) > 0 then begin
    mTEXTO := Copy ( mTEXTO, 1, mTAM );

    mFALTA    := mTAM - Length ( mTEXTO );
    mPREENCHE := '';
    for i := 1 to mFALTA  do begin
      mPREENCHE := mPREENCHE + mCARAC;
    end;
    mRET := mPREENCHE + mTEXTO;
  end;
  result := mRET;
end;
Desta forma, o teu programa ficaria da seguinte forma : ( alinhando à esquerda )
while not Table1.Eof do begin
    Writeln(F,
    Padl ( Table1.Fields[0].AsString, ' ', 15 ) + ';' +
    Padl ( Table1.Fields[1].AsString, ' ', 40 ) + ';' +
    Padl ( Table1.Fields[2].AsString, ' ', 20 ) + ';' +
    Padl ( Table1.Fields[3].AsString, ' ', 40 ) + ';' +
    Padl ( Table1.Fields[4].AsString, ' ', 15 ) + ';' +
    Padl ( Table1.Fields[5].AsString, ' ', 15 ) + ';' +
    Padl ( Table1.Fields[6].AsString, ' ',   2 ) + ';' +
    Padl ( Table1.Fields[7].AsString, ' ',   8 ) + ';' +
    Padl ( Table1.Fields[8].AsString, ' ', 20 ) );
    Table1.Next;
  end;

Abraços,

José Luiz.

Editado por Micheus
Incluída tag's CODE para melhorar a visualização. Utilize a identação também ;)
Link para o comentário
Compartilhar em outros sites

  • 0

Testei os dois métodos e eles funcionaram!

A função do José Luiz é boa, mas ignora campos nulos e tive que fazer umas modificações no código.

A função do Micheus tb é boa, mas está alinhando o texto à direita, sendo que preciso dele alinhado à esquerda. Tentei trocar o comando "RightStr" para "LeftStr", mas não funcionou. As colunas são criadas, mas sem texto... Com a modificação, só aparecem um monte de espaços vazios.

Vou continuar tentando, mas vocês já me deram um grande empurrão. Obrigado!

----------------------------------------------------------------------------------------------

Edição:

Só pra dizer que a função do José Luiz funcionou como eu queria. Para que ela passe a enxergar os campos nulos, basta mudar a seguinte linha:

if length ( mTEXTO ) > 0 then begin

para:

if length ( mTEXTO ) >= 0 then begin

Pronto, só isso. Estou usando ela, mas gostaria que o Micheus me ajudasse a modificar a função dele tb. Abraço!

Editado por Duduh_Capixaba
Link para o comentário
Compartilhar em outros sites

  • 0
A função do Micheus tb é boa, mas está alinhando o texto à direita, sendo que preciso dele alinhado à esquerda. Tentei trocar o comando "RightStr" para "LeftStr", mas não funcionou. As colunas são criadas, mas sem texto... Com a modificação, só aparecem um monte de espaços vazios.
Sabe que eu lembrei deste inconveniente ontem. Quando se trata de valores, normalmente são alinhados à direita, então os espaços tem que ser incluídos à esquerda, mas quando se trata de textos normalmente o alinhamento é à esquerda e daí os espaços ficam à direita.

Vamos melhorar a função:

// Source = a string passada para ser formatada
// Ch = caracter a ser utilizado para preencher à esquerda
// Size = tamanho da string que deve ser retornada (largura da coluna)
// LeftAlign = indica se o alinhamento será à esquerda (True) ou à direita (False)
function FormatStrSize(Source :string; Ch :char; Size :byte; LeftAlign :Boolean) :string;
begin
  if LeftAlign then
    Result := Copy(Source +StringOfChar(Ch, Size), 1 ,Size)
  else
    Result := RightStr(StringOfChar(Ch, Size) +Source, Size);
end;
E usando ela:
...
  while not Table1.Eof do 
  begin
    Writeln(F,
    FormatStrSize(Table1.Fields[0].AsString, ' ', 10, False) + ';' +    // alinhado à direita
    FormatStrSize(Table1.Fields[1].AsString, ' ', 5, True) + ';' +  // alinhado à direita
    ...
  end;

Abraços

Link para o comentário
Compartilhar em outros sites

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...