unit BCParsers;
interface
uses
SysUtils, Classes, ContNrs,
{BCUtils}, DateUtils, StrUtils;
type
TBcCSVParser =
class;
TBcCSVDataSets =
class;
TBcCSVDataSet =
class;
TBcCSVParser =
class(TComponent)
private
FDataSets: TBcCSVDataSets;
FFieldSeparator:
String;
FFieldDefinition:
String;
FComment: TStrings;
protected
procedure SetComment(Value: TStrings);
procedure SetDataSets(Value: TBcCSVDataSets);
public
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure ParseStrings(Strings: TStrings);
procedure LoadFromStream(Stream: TStream);
procedure LoadFromFile(
const FileName:
String);
procedure BuildStrings(Strings: TStrings);
procedure SaveToStream(Stream: TStream);
procedure SaveToFile(
const FileName:
String);
property DataSets: TBcCSVDataSets
read FDataSets
write SetDataSets;
published
property FieldSeparator:
String read FFieldSeparator
write FFieldSeparator;
property FieldDefinition:
String read FFieldDefinition
write FFieldDefinition;
property Comment: TStrings
read FComment
write SetComment;
end;
TBcCSVDataSets =
class(TObjectList)
protected
procedure SetItem(
Index: Integer; Value: TBcCSVDataSet);
function GetItem(
Index: Integer):TBcCSVDataSet;
public
function Add:Integer;
property Items[
Index:Integer]:TBcCSVDataSet
read GetItem
write SetItem;
default;
end;
TBcCSVDataSet =
class(TStrings);
implementation
{ TBcCSVParser }
constructor TBcCSVParser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDataSets := TBcCSVDataSets.Create;
FComment := TStringList.Create;
FFieldDefinition := '
"';
FFieldSeparator := '
;';
end;
destructor TBcCSVParser.Destroy;
begin
FDataSets.Free;
FComment.Free;
inherited Destroy;
end;
procedure TBcCSVParser.SetComment(Value: TStrings);
begin
FComment.Assign(Value);
end;
procedure TBcCSVParser.SetDataSets(Value: TBcCSVDataSets);
begin
FDataSets := Value;
end;
procedure TBcCSVParser.ParseStrings(Strings: TStrings);
var
iLine, CommentPos, DefinitionPos: Integer;
CurrentDataSet, CurrentValue:
String;
begin
FDataSets.Clear;
FComment.Clear;
for iLine := 0
to Strings.Count - 1
do
begin
CommentPos := pos('
#', Strings[iLine]);
if CommentPos = 1
then
Comment.Add(Copy(Strings[iLine], CommentPos + 1, Length(Strings[iLine]) - CommentPos - 1))
else
begin
with DataSets[DataSets.Add]
do
begin
CurrentDataSet := Strings[iLine];
while CurrentDataSet <> '
'
do
begin
DefinitionPos := pos(FFieldDefinition, Strings[iLine]);
if DefinitionPos = 1
then
begin
//extract value from field definition
CurrentValue := Copy(CurrentDataSet, DefinitionPos + 1,
posEx(FFieldDefinition,
CurrentDataSet,
DefinitionPos + 1) - DefinitionPos - 1);
System.Delete(CurrentDataSet, DefinitionPos,
posEx(FFieldDefinition, CurrentDataSet, DefinitionPos + 1) - DefinitionPos);
//unescape value
if pos(FFieldDefinition + FFieldDefinition, CurrentValue) > 0
then
CurrentValue := StringReplace(CurrentValue,
FFieldDefinition + FFieldDefinition,
FFieldDefinition,
[rfReplaceAll, rfIgnoreCase]);
end
else
begin
//extract value
CurrentValue := Copy(CurrentDataSet, 1, pos(FFieldSeparator, CurrentDataSet) - 1);
System.Delete(CurrentDataSet, 1, pos(FFieldSeparator, CurrentDataSet));
end;
Add(CurrentValue);
end;
end;
end;
end;
end;
procedure TBcCSVParser.LoadFromStream(Stream: TStream);
var
Data: TStrings;
begin
Data := TStringList.Create;
try
Data.LoadFromStream(Stream);
ParseStrings(Data);
finally
Data.Free;
end;
end;
procedure TBcCSVParser.LoadFromFile(
const FileName:
string);
var
Data: TStrings;
begin
Data := TStringList.Create;
try
Data.LoadFromFile(FileName);
ParseStrings(Data);
finally
Data.Free;
end;
end;
procedure TBcCSVParser.BuildStrings(Strings: TStrings);
var
iDataSet, iCommentLine, iValue: Integer;
CurrentValue, CurrentDataSet:
String;
begin
Strings.Clear;
//add comment line by line
for iCommentLine := 0
to Comment.Count - 1
do
Strings.Add('
#' + Comment[iCommentLine]);
//write datasets
for iDataSet := 0
to DataSets.Count - 1
do
begin
CurrentDataSet := '
';
for iValue := 0
to DataSets[iDataSet].Count - 1
do
begin
//prepare current value
CurrentValue := DataSets[iDataSet][iValue];
if pos(FFieldSeparator, CurrentValue) > 0
then
begin
//escape field definition in value if needed
if pos(FFieldDefinition, CurrentValue) > 0
then
CurrentValue := StringReplace(CurrentValue,
FFieldDefinition,
FFieldDefinition + FFieldDefinition,
[rfReplaceAll, rfIgnoreCase]);
//set field definition
CurrentValue := FFieldDefinition + CurrentValue + FFieldDefinition;
end;
//append value to dataset
CurrentDataSet := CurrentDataSet + FFieldSeparator + CurrentValue;
end;
//add dataset
Strings.Add(CurrentDataSet);
end;
end;
procedure TBcCSVParser.SaveToStream(Stream: TStream);
var
Data: TStrings;
begin
Data := TStringList.Create;
try
BuildStrings(Data);
Data.SaveToStream(Stream);
finally
Data.Free;
end;
end;
procedure TBcCSVParser.SaveToFile(
const FileName:
string);
var
Data: TStrings;
begin
Data := TStringList.Create;
try
BuildStrings(Data);
Data.SaveToFile(FileName);
finally
Data.Free;
end;
end;
{ TBcCSVDataSets }
procedure TBcCSVDataSets.SetItem(
Index: Integer; Value: TBcCSVDataSet);
begin
inherited Items[
Index] := Value;
end;
function TBcCSVDataSets.GetItem(
Index: Integer):TBcCSVDataSet;
begin
Result :=
inherited Items[
Index]
as TBcCSVDataSet;
end;
function TBcCSVDataSets.Add:Integer;
var
NewDataSet: TBcCSVDataSet;
begin
NewDataSet := TBcCSVDataSet.Create;
Result :=
inherited Add(NewDataSet);
end;