Access Violation bei Zerlegung eines Strings. Warum?

[Linkat]

Hallo,
habe wieder einmal ein Problem.
Ich muss aus einen String, in dem Messdaten abgelegt sind, die x- und y-Werte extrahieren. Ein String kann mehr als 11.000 Zeichen beinhalten.
Das Programm funktioniert so: Der String wird aus einem SQL-Browser in das Clipboard kopiert. Über den Button Zerlegen wird der String in die einzelnen Werte zerlegt und in das Memo gechrieben. Die x- und y- Werte schreibe ich mit einem Delimiter getrennt, die dann mit Hielfe des Clipboards in ein Tabellenprogramm übertragen werden können.

Leider tritt die Fehlermeldung Access Violation auf und am Ende der Messwerte treten kryptische Zeichen auf.
Das beigefügte Programm wurde unter Linux geschrieben. Der gleiche Fehler tritt auch mit Lazarus unter Windows und mit Delphi auf.
Wer hat eine Idee, warum der Fehler auftritt?

Der String ist wie folgt aufgebaut: 1.2,1,2.3,3.2,4.2,5 etc.

Code: Alles auswählen

unit strzerlegenu;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Buttons,
  StdCtrls,ClipBrd;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    BtZerlegen: TButton;
    BtLoeschen: TButton;
    BtTrennZeichen: TButton;
    BtClipBoard: TButton;
    BtBeenden: TButton;
    Label1: TLabel;
    Memo1: TMemo;
    procedure BtBeendenClick(Sender: TObject);
    procedure BtClipBoardClick(Sender: TObject);
    procedure BtLoeschenClick(Sender: TObject);
    procedure BtTrennZeichenClick(Sender: TObject);
    procedure BtZerlegenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end; 
 
var
  Form1: TForm1; 
 
implementation
{ TForm1 }
 
const delimiter = #9;
      tz = 'Trennzeichen:  ';
      Version = 'LH-DB-String zerlegen Version:  01.07.07';
 
var   blkomma           :boolean;
 
function zerlegen(var s:string):string;
var i,j             :integer;
begin
  j:=length(s);
  for i:=1 to j do if s[i]=',' then s[i]:=delimiter;
  if blkomma then for i:=1 to j do if s[i]='.' then s[i]:=',';
  result:=s;
end;    {zerlegen}
 
procedure TForm1.BtBeendenClick(Sender: TObject);
begin
  close;
end;
 
procedure TForm1.BtClipBoardClick(Sender: TObject);
begin
  Memo1.SelectAll;
  Memo1.CopyToClipboard;
end;
 
procedure TForm1.BtLoeschenClick(Sender: TObject);
begin
  Memo1.Clear;
  Label1.Caption:='';
end;
 
procedure TForm1.BtTrennZeichenClick(Sender: TObject);
begin
  blkomma:=not blkomma;
  if blkomma then BtTrennZeichen.Caption:=tz+','
             else BtTrennZeichen.Caption:=tz+'.';
end;
 
procedure TForm1.BtZerlegenClick(Sender: TObject);
var  i,j,a               :integer;
     CBstr,s,s1,s2       :string;
     c                   :char;
begin
  CBstr:=ClipBoard.AsText;
  CBstr:=zerlegen(CBstr);
  a:=length(CBstr);
  Label1.Caption:=IntToStr(a);
  i:=1;
  repeat
    s:='';
    s1:='';
    s2:='';
    c:=CBstr[i];
    while c<>delimiter do begin
      s1:=s1+c;
      inc(i);
      c:=CBstr[i];
    end;
    if c=delimiter then begin inc(i);c:=CBstr[i];end;
    while c<>delimiter do begin
      s2:=s2+c;
      inc(i);
      c:=CBstr[i];
    end;
    if c=delimiter then begin inc(i);c:=CBstr[i];end;
    s:=s1+delimiter+s2;
    Memo1.Lines.Add(s);
  until i = a;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.Caption:=version;
  blkomma:=true;
  if blkomma then BtTrennZeichen.Caption:=tz+','
             else BtTrennZeichen.Caption:=tz+'.';
 
end;
 
initialization
  {$I strzerlegenu.lrs}
end.

Die gesamten Files habe ich als Attachment beigefügt.

Vielen Dank

Gruß, Linkat

[theo]

Das: "while cdelimiter do begin" ist zumindest unsauber. Auch hier musst du checken ob i < a.

[Christian]

Du würdest den Fehler warscheinlich sehr schnell finden wenn du das ganze im Debugger ausprobieren würdest. Wo tritt denn die Access Violation auf ?

Ich würde z.b. darauf Tippen das in der While Schleife aus Zeile 96 i irgendwann > s wird und dann natürlich versucht wird auf eine ungültige Speicheradresse zuzugreifen.

[Linkat]

Hallo theo und Christian,
vielen Dank für die Anregungen.
Den Debugger habe ich unter Lazarus noch nicht zum Laufen gekriegt.

Aber, Christian, die Richtung war schon richtig.
Da innerhalb der Repeat-Until-Schleife das i mehrmals incrementiert wird, muss der Fall in Until i = a nicht unbedingt auftreten.

Deshalb muss in Zeile 110 until i > a anstatt i = a stehen

Jetzt läuft alles prima.

Vielen Dank für das Zeigen des Scheunentores

Kann man denn irgendwo ein Icon für "Problem gelöst" anklicken ?

Gruß, Linkat

[Euklid]

Den Debugger habe ich unter Lazarus noch nicht zum Laufen gekriegt.

Wo liegt denn das Problem?

Euklid

[Christian]

Was hast du denn für stress mit dem debugger ?
Ich geh mal von Linux aus einfach gdb installieren in den Debuggereinstellungen debugegrpfad /usr/bin/gdb angeben und gdb auswählen, fertig.