PROGRAM   CQSptS10 ;
{$IFDEF VER80}   USES   WinCRT , Classes ;   {$ENDIF}      {--- Delphi1 }
{$IFDEF WIN32}   {$APPTYPE CONSOLE}   USES   Classes ;   {$ENDIF}      {--- Delphi2,... }

{
!------------------------------------------------------------------------------
! This program toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TStrings routines
!---------------
! CFQ = Char separated Fields, Quote optional
!---------------
! TStrings_ChQtSplitString
!---------------
}
{===== TStrings_ChQtSplitString }

FUNCTION   TStrings_ChQtSplitString   ( Self : TStrings
                                      ; {$IFDEF VER80}Const{$ENDIF} I_String : String
                                      ; I_ChSeparator : Char
                                      ; I_QuoteCh     : Char
                                      ) : Boolean ;      {--- TRUE=Ok   False=Quote not closed }
VAR
   L_FldBegin : Longint ;
   L_FldAEnd  : Longint ;
   L_i_String : String ;

   L_j_InsideQuotesQ : Boolean ;
   L_j_QuoteCount    : Longint ;
   L_j : Longint ;
   L_k : Longint ;
BEGIN
   Result := TRUE ;      {--- Optimistic (quote closed) }

   Self.BeginUpdate ;
   TRY
      Self.Clear ;

      L_FldBegin := 1 ;
      L_FldAEnd  := 1 ;
      L_j_InsideQuotesQ := False ;
      L_j_QuoteCount    := 0 ;

      {----- LOOP , Search each field }
      WHILE L_FldAEnd <= Length(I_String) DO BEGIN

         {----- Begin quote found ?  }
         IF I_String[L_FldAEnd] = I_QuoteCh THEN BEGIN
            L_j_InsideQuotesQ := TRUE ;
            Inc ( L_j_QuoteCount );
            Inc ( L_FldAEnd );

            {----- LOOP 3 , Search ending quote  ( skipping double quotes )  }
            WHILE L_FldAEnd <= Length(I_String) DO BEGIN
               IF I_String[L_FldAEnd] = I_QuoteCh
               THEN BEGIN
                  Inc ( L_j_QuoteCount );      {--- One more quote found... }
                  IF L_FldAEnd = Length(I_String)
                  THEN BEGIN  L_j_InsideQuotesQ := False ;  Inc(L_FldAEnd);  BREAK;  END
                  ELSE BEGIN
                     Inc ( L_FldAEnd );
                     IF I_String[L_FldAEnd] = I_QuoteCh      {--- Skip double quote ?  }
                     THEN Inc ( L_FldAEnd )
                     ELSE BEGIN  L_j_InsideQuotesQ := False ;  BREAK;  END
                  END;
               END
               ELSE Inc ( L_FldAEnd );
            END;{while}
         END
         ELSE BEGIN
            {----- If separator found... }
            IF I_String[L_FldAEnd] = I_ChSeparator
            THEN BEGIN
               IF L_j_QuoteCount = 0
               THEN BEGIN
                  {----- Add non quoted field }
                  IF L_FldAEnd = L_FldBegin
                  THEN Self.Add ( '' )
                  ELSE Self.Add ( Copy(I_String,L_FldBegin,L_FldAEnd-L_FldBegin) );
               END
               ELSE BEGIN
                  {----- Copy unquoting }
                 {$IFDEF WIN32}
                  SetLength ( L_i_String , L_FldAEnd - L_FldBegin - L_j_QuoteCount );
                 {$ELSE}
                  L_i_String[0] := Char( L_FldAEnd - L_FldBegin - L_j_QuoteCount );
                 {$ENDIF}
                  L_k := 1 ;
                  L_j := L_FldBegin ;
                  {----- LOOP 4 , Copy  ( checking double quotes )  }
                  WHILE L_j < L_FldAEnd DO BEGIN
                     IF I_String[L_j] <> I_QuoteCh
                     THEN BEGIN
                        L_i_String[L_k] := I_String[L_j];
                        Inc ( L_k );
                        Inc ( L_j );
                     END
                     ELSE BEGIN
                        Inc ( L_j );
                        IF (L_j < L_FldAEnd) and (I_String[L_j] = I_QuoteCh) THEN BEGIN
                           L_i_String[L_k] := I_String[L_j];      {--- If 2 quotes, copy one only }
                           Inc ( L_k );
                           Inc ( L_j );
                        END;
                     END;
                  END;{while}
                  Self.Add ( L_i_String );      {--- Add unquoted field }
                  L_j_QuoteCount := 0 ;
               END;

               Inc ( L_FldAEnd );
               L_FldBegin := L_FldAEnd ;
            END
            ELSE Inc ( L_FldAEnd );
         END;
      END;{while}

      {----- One more at the end... }
      IF I_String <> '' THEN BEGIN
         IF L_j_QuoteCount = 0
         THEN BEGIN
            {----- Add non quoted field }
            IF L_FldAEnd = L_FldBegin
            THEN Self.Add ( '' )
            ELSE Self.Add ( Copy(I_String,L_FldBegin,L_FldAEnd-L_FldBegin) );
         END
         ELSE BEGIN
            {----- Copy unquoting }
           {$IFDEF WIN32}
            SetLength ( L_i_String , L_FldAEnd - L_FldBegin - L_j_QuoteCount );
           {$ELSE}
            L_i_String[0] := Char( L_FldAEnd - L_FldBegin - L_j_QuoteCount );
           {$ENDIF}
            L_k := 1 ;
            L_j := L_FldBegin ;
            {----- LOOP 4 , Copy  ( checking double quotes )  }
            WHILE L_j < L_FldAEnd DO BEGIN
               IF I_String[L_j] <> I_QuoteCh
               THEN BEGIN
                  L_i_String[L_k] := I_String[L_j];
                  Inc ( L_k );
                  Inc ( L_j );
               END
               ELSE BEGIN
                  Inc ( L_j );
                  IF (L_j < L_FldAEnd) and (I_String[L_j] = I_QuoteCh) THEN BEGIN
                     L_i_String[L_k] := I_String[L_j];      {--- If 2 quotes, copy one only }
                     Inc ( L_k );
                     Inc ( L_j );
                  END;
               END;
            END;{while}
            Self.Add ( L_i_String );      {--- Add unquoted field }
         END;
      END;

      Result := (L_j_InsideQuotesQ = False);
   FINALLY
      Self.EndUpdate ;
   END;
END;


{===============}


FUNCTION   TStrings_Join   ( Self : TStrings
                           ; I_Separator : String ) : String ;
VAR
   L_i : Integer ;
BEGIN
   Result := '' ;

   {----- LOOP , Concat items }
   FOR L_i := 0 TO Self.Count -1 DO BEGIN
      IF L_i > 0 THEN Result := Result  +  I_Separator ;
      Result := Result  +  Self[L_i];
   END;{for}
END;


VAR
   G_MyStrings : TStrings ;

   G_i : Integer ;

BEGIN
   G_MyStrings := TStringList.Create ;
   TRY
      TStrings_ChQtSplitString ( G_MyStrings , '' , ',' , '"' );
      FOR G_i := 0 TO G_MyStrings.Count -1 DO BEGIN
         IF G_i > 0 THEN Write (   ';'   );
         Write (   G_MyStrings[G_i]   );
      END;{i}
      WriteLn (   '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , ',' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , ',,' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , 'Red,Green,Blue' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
      WriteLn ;


      {---------------}


      TStrings_ChQtSplitString ( G_MyStrings , 'a' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , 'a,b' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , 'a,b,c' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , ',b,c' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , 'a,,c' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , 'a,b,' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
      WriteLn ;


      {---------------}


      TStrings_ChQtSplitString ( G_MyStrings , '""' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"",""' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"","",""' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"Red","Green","Blue"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
      {--WriteLn ;--}


      {---------------}


      TStrings_ChQtSplitString ( G_MyStrings , '"a"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"a","b"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"a","b","c"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"","b","c"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"a","","c"' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"a","b",""' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
      {--WriteLn ;--}


      {---------------}


      TStrings_ChQtSplitString ( G_MyStrings , 'Red,"Gr""ee""n",Blue' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '"""R,ed""","""G,reen""","""B,lue"""' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      TStrings_ChQtSplitString ( G_MyStrings , '.."""R".."ed"""..,.."""G".."reen"""..,.."""B".."lue"""..' , ',' , '"' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
   FINALLY
      G_MyStrings.Free ;
   END;
END.
