DBF - pegar estrutura sem bde ou componentes

Top  Previous  Next

// Para pegar a estrutura de um DBF sem usar nenhuma unit, ou componente:

 

type

  TDBFColuna = record

    Nome    : string;

    Tipo    : char;

    Tamanho : Byte;

    Decimais: Byte;

  end;

 

  TDBFEstrutura = record

    Colunas         : array[1..200of TDBFColuna;

    NumeroCampos    : Integer;

    RecordCount     : Integer;

    TamanhoRegistros: Integer;

    Data            : TDateTime;

  end;

 

var

  DBFEstrutura: TDBFEstrutura;

 

// Captura a estrutura de um DBF

function GetStru(const ArquivoDBF: string): Boolean;

var

  Header, J: Integer;

  Banco    : file of Char;

  // vars temp

  I : Longint;

  St: string;

  F : string[1];

  // funcoes internas

  // le do arquivo um ou mais NUMEROS

  function LeInt(const N: Integer): Longint;

  var

    C: Char;

    I: Integer;

    L: Longint;

  begin

    Result := 0;

    L      := 1;

    for I:= 1 to N do

    begin

      Read(Banco,C);

      Result:= Result + L * Ord(C);

      L:= L * 256;

    end;

  end;

  // le do arquivo um ou mais CHAR

  function LeChar(const N: Integer): string;

  var

    C: Char;

    I: Integer;

  begin

    Result:='';

    for I:= 1 to N do

    begin

      Read(Banco, C);

      Result:= Result + C;

    end;

  end;

begin

  Result := False;

  {$I-}

  AssignFile(Banco, ArquivoDBF);

  reset(Banco);

  {$I+}

  if IOResult <> 0 then Exit;

  // o primeiro caracter do cabecalho é ignorado.

  F := LeChar(1);

  // pega data que foi criado a estrutura

  I := LeInt(1) - 100;  St := IntToStr(I);

  I := LeInt(1);        St := IntToStr(I) + '/' + St;

  I := LeInt(1);        St := IntToStr(I) + '/' + St;

  DBFEstrutura.Data := StrToDate(St);

  // Pega qtd registro, tamanho dos registros e numero de campos

  DBFEstrutura.RecordCount := LeInt(4);

  Header:= LeInt(2);

  DBFEstrutura.TamanhoRegistros := LeInt(2);

  St := LeChar(20);

  DBFEstrutura.NumeroCampos := (Header - 2) div 32 - 1;

  // pega dados dos campos

  with DBFEstrutura do

    for J:= 1 to DBFEstrutura.NumeroCampos do

    begin

      St := LeChar(11);

      if Pos(#0,St) > 0 then St := Copy(St, 1, Pos(#0,St)-1);

      Colunas[J].Nome := St;

      Read(Banco, DBFEstrutura.Colunas[J].Tipo );

      St := LeChar(4);

      Colunas[J].Tamanho  := LeInt(1);

      Colunas[J].Decimais := LeInt(1);

      St := LeChar(14);

    end;

  CloseFile(Banco);

  Result := True;

end;

 

 

////// EXEMPLO DE USO / /////

procedure TForm1.Button1Click(Sender: TObject);

var

  I: Integer;

  S: string;

begin

  Memo1.Lines.Clear;

  if not GetStru('c:\frente\produtos.dbf') then Memo1.Lines.Add('ERRO!'else

    for I := 1 to DBFEstrutura.NumeroCampos do

    begin

      S := DBFEstrutura.Colunas[I].Nome + #32 + DBFEstrutura.Colunas[I].Tipo + #32 +

           IntToStr(DBFEstrutura.Colunas[I].Tamanho) + ',' + IntToStr(DBFEstrutura.Colunas[I].Decimais);

      Memo1.Lines.Add(S);

    end;

end;