Mega Code Archive
Component to read text files delimited or fixed
<![CDATA[
Title: Component to read text files delimited or fixed
Question: How to read text files, delimited by any character or fixed ?
Answer:
unit ArqTexto;
interface
uses
Windows, Messages, SysUtils, Classes, Dialogs;
type
TTipos = (ftFixed, ftDelimited);
TArqTexto = class(TComponent)
private
{ Private declarations }
FAct: Boolean;
FAut: String;
FEml: String;
FArq: TextFile;
FTxt: String;
FDel: String;
FRes: TStrings;
FLay: TStrings;
FLin: Integer;
FMax: Integer;
FVer: String;
FTip: TTipos;
TmpInt: Integer;
TmpStr: TStrings;
TmpChr: String;
function VldChr(Value: String): String;
procedure SetActive(Value: Boolean);
procedure SetLine(Value: Integer);
procedure SetFileName(Value: String);
procedure SetDelimiter(Value: String);
procedure SetFileType(Value: TTipos);
procedure SetLayout(Value: TStrings);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Connect;
procedure Disconnect;
published
{ Published declarations }
property Active: Boolean read FAct write SetActive;
property Author: String read FAut write TmpChr;
property EMail: String read FEml write TmpChr;
property FileName: String read FTxt write SetFileName;
property FileType: TTipos read FTip write SetFileType;
property Delimiter: String read FDel write SetDelimiter;
property Line: Integer read FLin write SetLine;
property Layout: TStrings read FLay write SetLayout;
property MaxLines: Integer read FMax write TmpInt;
property Result: TStrings read FRes write TmpStr;
property Version: String read FVer write TmpChr;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Standard', [TArqTexto]);
end;
constructor TArqTexto.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FRes := TStringList.Create;
FRes.Clear;
FLay := TStringList.Create;
FLay.Clear;
FAut := 'Marcelo Torres';
FEml := 'marcelo.torres@task.com.br';
FVer := '2.00';
FAct := False;
FDel := ';';
FTip := ftDelimited;
FTxt := '';
FLin := 0;
FMax := 0;
end;
destructor TArqTexto.Destroy;
begin
FRes.Free;
FLay.Free;
try
CloseFile(FArq);
except
end;
inherited Destroy;
end;
procedure TArqTexto.SetLayout(Value: TStrings);
begin
FLay.Assign(Value);
if FAct and (FTip = ftFixed) then begin
FRes.Clear;
FLin := 1;
SetLine(1);
end;
end;
procedure TArqTexto.SetFileType(Value: TTipos);
var
Mudou: Boolean;
begin
Mudou := FTip Value;
FTip := Value;
if Mudou and FAct then
if FTip = ftFixed then begin
FRes.Clear;
if FLay.Count 0 then begin
FLin := 1;
SetLine(1);
end;
end else begin
FRes.Clear;
FLin := 1;
SetLine(1);
end;
end;
procedure TArqTexto.SetFileName(Value: String);
begin
if Value '' then
if UpperCase(FTxt) UpperCase(Value) then begin
try
CloseFile(FArq);
except
end;
FAct := False;
FTxt := Value;
FMax := 0;
FLin := 0;
FRes.Clear;
end;
end;
procedure TArqTexto.SetDelimiter(Value: String);
begin
if Value '' then
if UpperCase(FDel) UpperCase(Value) then
if FTip = ftDelimited then begin
try
CloseFile(FArq);
except
end;
FAct := False;
FDel := Copy(Value,1,1);
end;
end;
procedure TArqTexto.SetActive(Value: Boolean);
var
Ind: Integer;
Lin: String;
begin
if Value then begin
if FTxt = '' then begin
ShowMessage('Filename is missing');
FAct := False;
Exit;
end;
if FileExists(FTxt) then begin
AssignFile(FArq, FTxt);
Ind := 0;
Reset(FArq);
while not Eof(FArq) do begin
Inc(Ind);
ReadLn(FArq, Lin);
end;
FMax := Ind;
Reset(FArq);
SetLine(1);
FAct := True;
end else begin
ShowMessage('File "'+FTxt+'" not found');
FAct := False;
end;
end else begin
try
CloseFile(FArq);
except
end;
FAct := False;
FLin := 0;
FMax := 0;
FRes.Clear;
end;
end;
procedure TArqTexto.SetLine(Value: Integer);
var
Ind: Integer;
Cmp: String;
Lin: String;
Ini: String;
Fim: String;
IndCmp: String;
begin
if FAct and (Value 0) then begin
if Value FMax then
Value := FMax;
Ind := 1;
Reset(FArq);
while Ind ReadLn(FArq, Lin);
Inc(Ind);
end;
Cmp := '';
FRes.Clear;
if FTip = ftDelimited then begin
for Ind := 1 to Length(Lin) do begin
if Copy(Lin, Ind, 1) = FDel then begin
FRes.Add(Cmp);
Cmp := '';
end else
if Copy(Lin, Ind, 1) = ' ' then
Cmp := Cmp + Copy(Lin, Ind, 1);
end;
if Length(Cmp) 0 then
FRes.Add(Cmp);
end;
if FTip = ftFixed then
for Ind := 0 to FLay.Count-1 do begin
IndCmp := VldChr(FLay[Ind]);
if Pos('-', IndCmp) 0 then begin
Ini := Copy(IndCmp, 1, Pos('-', IndCmp)-1);
Fim := Copy(IndCmp, Pos('-', IndCmp)+1, Length(IndCmp)-Pos('-', IndCmp));
if (Ini '') and (Fim '') then begin
Cmp := Copy(Lin, StrToInt(Ini), StrToInt(Fim)-StrToInt(Ini)+1);
FRes.Add(Cmp);
end;
end;
end;
FLin := Value;
end else
FLin := 0;
end;
function TArqTexto.VldChr(Value: String): String;
var
Ind: Integer;
Txt: String;
begin
Txt := '';
for Ind := 1 to Length(Value) do
if Pos(Copy(Value, Ind, 1), '1234567890-') 0 then
Txt := Txt + Copy(Value, Ind, 1);
Result := Txt;
end;
procedure TArqTexto.Connect;
begin
SetActive(True);
end;
procedure TArqTexto.Disconnect;
begin
SetActive(False);
end;
end.
-------------------
Instalation:
Install this code as a component. Menu Component, Install Component.
Into new package. Enter the name of package and click in button "Install".
Use:
To use this component, just set the properties:
FileName: Name of file to read
FileType: Type of file (fixed or delimited)
Delimiter: Character to delimiter the fields (in case of delimited type)
Layout: Positions of the fields (in case of fixed type)
Active: True=Open file, False=Close file.
Line: Number of line to read.
How to set "Layout" property ?
Very simple. Put the positions of fields. One field definition by line.
For example:
1-8
20-40
10-15
In this example, we have:
Field 1: Initial position is 1 and final position is 8
Field 2: Initial position is 20 and final position is 40
Field 3: Initial position is 10 and final position is 15
All results of read will be write in "Result" property.
]]>