Externer Fehler kurz nach dem öffnen eines OpenDialogs

[Andreas L.]

Hi,

ich wollte mit einer simplen Anwendung meinen CSV-Parser testen. Auf der Form befindet sich lediglich ein Button, eine ListView mit 20 Columns und ein OpenDialog. Nachdem öffnen des OpenDialogs dauert es ein wenig (egal ob ich eine Datei auswähle oder nicht), dann kommt

Zitat:

---------------------------
Fehler
---------------------------
Externe Exception EEFFACE.
---------------------------
OK Details >>
---------------------------

. Nach Bestätigung muss ich die IDE abschießen weil überhaupt nichts mehr reagiert.

So rufe ich den OpenDialog auf:

Delphi-Quellcode:

var
  csv: TBcCSVParser;
  i: Integer;
  x: Integer;
begin
  if OpenDialog1.Execute then
  begin
    csv := TBcCSVParser.Create(nil);
    try
      csv.LoadFromFile(OpenDialog1.FileName);
      for i := 0 to csv.DataSets.Count - 1 do
      begin
        with listview1.Items.Add do
        begin
          Caption := '';
          for x := 0 to csv.DataSets[i].Count - 1 do
            SubItems.Add(csv.DataSets[i][x]);
        end;
      end;
    finally
      csv.Free;
    end;
  end;

Der Code meines Parsers (wird wohl noch nicht ganz funktionieren, habs das grad sozusagen "from scratch" geschrieben:

Delphi-Quellcode:

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;

Hier noch eine Test CSV-Datei:

Code:

TEST;TEST2;TEST3
"TEST";"TEST2";"TEST3"
"Te""st";"TE;ST2";TEST3

Kann jemand den Fehler nachvollziehen?