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..200] of 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; |