* Implemented StrictDelimiter without the delphi bugs (mantis #8910)

git-svn-id: trunk@11686 -

rtl/objpas/classes/classesh.inc

@@ -503,6 +503,7 @@ type
     FUpdateCount: Integer;
     FAdapter: IStringsAdapter;
     FLBS : TTextLineBreakStyle;
+    FStrictDelimiter : Boolean;
     function GetCommaText: string;
     function GetName(Index: Integer): string;
     function GetValue(const Name: string): string;
@@ -568,6 +569,7 @@ type
     Property TextLineBreakStyle : TTextLineBreakStyle Read GetLBS Write SetLBS;
     property Delimiter: Char read FDelimiter write SetDelimiter;
     property DelimitedText: string read GetDelimitedText write SetDelimitedText;
+    Property StrictDelimiter : Boolean Read FStrictDelimiter Write FStrictDelimiter;
     property QuoteChar: Char read FQuoteChar write SetQuoteChar;
     Property NameValueSeparator : Char Read FNameValueSeparator Write SetNameValueSeparator;
     property ValueFromIndex[Index: Integer]: string read GetValueFromIndex write SetValueFromIndex;

rtl/objpas/classes/stringl.inc

@@ -92,18 +92,22 @@ function TStrings.GetCommaText: string;
 
 Var
   C1,C2 : Char;
+  FSD : Boolean;
 
 begin
   CheckSpecialChars;
+  FSD:=StrictDelimiter;
   C1:=Delimiter;
   C2:=QuoteChar;
   Delimiter:=',';
   QuoteChar:='"';
+  StrictDelimiter:=False;
   Try
     Result:=GetDelimitedText;
   Finally
     Delimiter:=C1;
     QuoteChar:=C2;
+    StrictDelimiter:=FSD;
   end;
 end;
 
@@ -113,22 +117,31 @@ Function TStrings.GetDelimitedText: string;
 Var
   I : integer;
   p : pchar;
+  c : set of char;
+  S : String;
+  
 begin
   CheckSpecialChars;
   result:='';
+  if StrictDelimiter then
+    c:=[#0,Delimiter]
+  else  
+    c:=[#0..' ',QuoteChar,Delimiter];
   For i:=0 to count-1 do
     begin
-    p:=pchar(strings[i]);
+    S:=Strings[i];
-    while not(p^ in [#0..' ',QuoteChar,Delimiter]) do
+    p:=pchar(S);
+    while not(p^ in c) do
      inc(p);
 // strings in list may contain #0
-    if p<>pchar(strings[i])+length(strings[i]) then
+    if (p<>pchar(S)+length(S)) and not StrictDelimiter then
-     Result:=Result+QuoteString (Strings[I],QuoteChar)
+      Result:=Result+QuoteString(S,QuoteChar)
     else
-     result:=result+strings[i];
+      Result:=Result+S;
-    if I<Count-1 then Result:=Result+Delimiter;
+    if I<Count-1 then 
+      Result:=Result+Delimiter;
     end;
-  If (Length(Result)=0)and(count=1) then
+  If (Length(Result)=0) and (Count=1) then
     Result:=QuoteChar+QuoteChar;
 end;
 
@@ -223,6 +236,26 @@ end;
 
 Procedure TStrings.SetDelimitedText(const AValue: string);
 
+  Procedure  SetStrictDelimited;
+  
+  Var
+    P,PL : Integer;
+    
+  begin
+    PL:=1;
+    P:=1;
+{
+    While Length(S)>0 do
+      begin
+      P:=Pos(FDelimiter,S);
+      If (P=0) then
+        P:=Length(S)+1;
+      Add(Copy(S,1,P-1));
+      System.Delete(S,1,P));
+      end;
+}  end;  
+    
+
 var i,j:integer;
     aNotFirst:boolean;
 begin
@@ -230,52 +263,71 @@ begin
  BeginUpdate;
 
  i:=1;
+ j:=1;
  aNotFirst:=false;
 
  try
   Clear;
-  while i<=length(AValue) do begin
+  If StrictDelimiter then
-   // skip delimiter
+    begin
-   if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
+    // Easier, faster loop.
+    While I<=Length(AValue) do
+      begin
+      If (AValue[I] in [FDelimiter,#0]) then
+        begin
+        Add(Copy(AValue,J,I-J));
+        J:=I+1;
+        end;
+      Inc(i);
+      end;
+    If (Length(AValue)>0) then
+      Add(Copy(AValue,J,I-J));  
+    end
+  else 
+    begin
+    while i<=length(AValue) do begin
+     // skip delimiter
+     if aNotFirst and (i<=length(AValue)) and (AValue[i]=FDelimiter) then inc(i);
 
-   // skip spaces
+     // skip spaces
-   while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
+     while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
-  
+    
-   // read next string
+     // read next string
-   if i<=length(AValue) then begin
+     if i<=length(AValue) then begin
-    if AValue[i]=FQuoteChar then begin
+      if AValue[i]=FQuoteChar then begin
-     // next string is quoted
+       // next string is quoted
-     j:=i+1;
+       j:=i+1;
-     while (j<=length(AValue)) and
+       while (j<=length(AValue)) and
-           ( (AValue[j]<>FQuoteChar) or
+             ( (AValue[j]<>FQuoteChar) or
-             ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
+               ( (j+1<=length(AValue)) and (AValue[j+1]=FQuoteChar) ) ) do begin
-      if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
+        if (j<=length(AValue)) and (AValue[j]=FQuoteChar) then inc(j,2)
-                                                        else inc(j);
+                                                          else inc(j);
+       end;
+       // j is position of closing quote
+       Add( StringReplace (Copy(AValue,i+1,j-i-1),
+                           FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
+       i:=j+1;
+      end else begin
+       // next string is not quoted
+       j:=i;
+       while (j<=length(AValue)) and
+             (Ord(AValue[j])>Ord(' ')) and
+             (AValue[j]<>FDelimiter) do inc(j);
+       Add( Copy(AValue,i,j-i));
+       i:=j;
+      end;
+     end else begin
+      if aNotFirst then Add('');
      end;
-     // j is position of closing quote
+
-     Add( StringReplace (Copy(AValue,i+1,j-i-1),
+     // skip spaces
-                         FQuoteChar+FQuoteChar,FQuoteChar, [rfReplaceAll]));
+     while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
-     i:=j+1;
+
-    end else begin
+     aNotFirst:=true;
-     // next string is not quoted
+    end;
-     j:=i;
-     while (j<=length(AValue)) and
-           (Ord(AValue[j])>Ord(' ')) and
-           (AValue[j]<>FDelimiter) do inc(j);
-     Add( Copy(AValue,i,j-i));
-     i:=j;
     end;
-   end else begin
-    if aNotFirst then Add('');
-   end;
-
-   // skip spaces
-   while (i<=length(AValue)) and (Ord(AValue[i])<=Ord(' ')) do inc(i);
-
-   aNotFirst:=true;
-  end;
  finally
-  EndUpdate;
+   EndUpdate;
  end;
 end;