11
novembre
2008
Persistance des objets : fichier-texte
novembre
2008
Un article de erca57
Pas de commentaires
Dans ce cinquième billet, je vous propose d’adapter le mécanisme décrit dans le précédent article de façon à sauvegarder les objets dans un fichier-texte avec des champs de longueur fixe.
2.1.2 – Fichier-texte sans délimiteur
Le code est dérivé directement du code du chapitre précédent. Je ne ferai donc pas d’autre commentaire.
TFixedTextFile = class(TTextFile)
public
constructor Create(aFileName: TFileName); overload; override;
end;
TFixedTextFileSave = class(TFixedTextFile)
public
procedure VisitBizObj(Visited: TBizObj); override;
end;
implementation
uses
uBOMRep;
{
******************************** TFixedTextFile ********************************
}
constructor TFixedTextFile.Create(aFileName: TFileName);
begin
// aFileName must have .txt extension
if ExtractFileExt(aFileName) <> '.txt' then
ChangeFileExt(aFileName, '.txt');
inherited Create(aFileName);
end;
{
****************************** TFixedTextFileSave ******************************
}
procedure TFixedTextFileSave.VisitBizObj(Visited: TBizObj);
var
i: Integer;
function PadRight(inStr: string; L: Integer): string;
var
s: String;
begin
s := copy(inStr, 1, L);
while length(s) < L do
s := s + ' ';
Result := s;
end;
begin
if not(Visited is TPeople) then
Exit;
for i := 0 to TPeople(Visited).List.Count - 1 do begin
FStringList.Add(
PadRight(TPerson(TPeople(Visited).List.Items[i]).LastName, 20) +
PadRight(TPerson(TPeople(Visited).List.Items[i]).FirstName, 20) +
DateToStr(TPerson(TPeople(Visited).List.Items[i]).BirthDate)
);
end;
end;
public
constructor Create(aFileName: TFileName); overload; override;
end;
TFixedTextFileSave = class(TFixedTextFile)
public
procedure VisitBizObj(Visited: TBizObj); override;
end;
implementation
uses
uBOMRep;
{
******************************** TFixedTextFile ********************************
}
constructor TFixedTextFile.Create(aFileName: TFileName);
begin
// aFileName must have .txt extension
if ExtractFileExt(aFileName) <> '.txt' then
ChangeFileExt(aFileName, '.txt');
inherited Create(aFileName);
end;
{
****************************** TFixedTextFileSave ******************************
}
procedure TFixedTextFileSave.VisitBizObj(Visited: TBizObj);
var
i: Integer;
function PadRight(inStr: string; L: Integer): string;
var
s: String;
begin
s := copy(inStr, 1, L);
while length(s) < L do
s := s + ' ';
Result := s;
end;
begin
if not(Visited is TPeople) then
Exit;
for i := 0 to TPeople(Visited).List.Count - 1 do begin
FStringList.Add(
PadRight(TPerson(TPeople(Visited).List.Items[i]).LastName, 20) +
PadRight(TPerson(TPeople(Visited).List.Items[i]).FirstName, 20) +
DateToStr(TPerson(TPeople(Visited).List.Items[i]).BirthDate)
);
end;
end;
Ensuite nous complétons la méthode TFormRepert.SavePeopleToFile de façon à obtenir l’un ou l’autre format selon l’extension du nom de fichier:
procedure TFormRepert.SavePeopleToFile(FN: TFileName);
var
CsvSave: TCsvTextFileSave;
TxtSave: TFixedTextFileSave;
FileExt: String;
begin
if not(MessageDlg('Sauvegarder ' + FN + ' ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes)
then
Exit;
FileExt := ExtractFileExt(FN) ;
if FileExt = '.csv' then begin
CsvSave := TCsvTextFileSave.Create(FN);
try
People.AcceptBizObjVisitor(CsvSave);
finally
CsvSave.Free;
end;
end else if FileExt = '.txt' then begin
TxtSave := TFixedTextFileSave.Create(FN);
try
People.AcceptBizObjVisitor(TxtSave);
finally
TxtSave.Free;
end;
end else
ShowMessage('Format de fichier incorrect (extension '+FileExt+')');
end;
var
CsvSave: TCsvTextFileSave;
TxtSave: TFixedTextFileSave;
FileExt: String;
begin
if not(MessageDlg('Sauvegarder ' + FN + ' ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes)
then
Exit;
FileExt := ExtractFileExt(FN) ;
if FileExt = '.csv' then begin
CsvSave := TCsvTextFileSave.Create(FN);
try
People.AcceptBizObjVisitor(CsvSave);
finally
CsvSave.Free;
end;
end else if FileExt = '.txt' then begin
TxtSave := TFixedTextFileSave.Create(FN);
try
People.AcceptBizObjVisitor(TxtSave);
finally
TxtSave.Free;
end;
end else
ShowMessage('Format de fichier incorrect (extension '+FileExt+')');
end;