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

{
!------------------------------------------------------------------------------
! This program toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TStrings routines
!---------------
! TStrings_ChSplitBufLen
!---------------
}
{===== TStrings_ChSplitBufLen }

PROCEDURE   TStrings_ChSplitBufLen   ( Self : TStrings
                                     ; I_PBuf : PChar
                                     ; I_Len  : Longint
                                     ; I_ChSeparator : Char );
VAR
   L_Len      : Longint ;
   L_FldBegin : PChar ;
   L_FldAEnd  : PChar ;
   L_FldLen   : Longint ;
   L_i_String : String ;
BEGIN
   Self.BeginUpdate ;
   TRY
      Self.Clear ;

      IF I_Len = 0 THEN EXIT ;

      L_Len      := I_Len ;
      L_FldBegin := I_PBuf ;
      L_FldAEnd  := I_PBuf ;
      L_FldLen   := 0 ;

      {----- LOOP 1 , Search each field }
      REPEAT

         {----- LOOP 2 , Search separator }
         WHILE (L_Len > 0) and (L_FldAEnd^ <> I_ChSeparator)
         DO BEGIN  Dec ( L_Len );  Inc(L_FldAEnd);  Inc(L_FldLen);  END;

         {----- If inside the string (separator found),... }
         IF L_Len > 0
         THEN BEGIN
            {----- Add field }
           {$IFDEF WIN32}
            SetLength ( L_i_String , L_FldLen );
           {$ELSE}
            L_i_String[0] := Char( L_FldLen );
           {$ENDIF}
            Move ( L_FldBegin^ , L_i_String[1] , Length(L_i_String) );
            Self.Add ( L_i_String );

            {----- Prepare next search }
            Dec ( L_Len );
            Inc ( L_FldAEnd );
            L_FldBegin := L_FldAEnd ;
            L_FldLen   := 0 ;
         END;

      UNTIL L_Len <= 0 ;

      {----- One more at the end... }
     {$IFDEF WIN32}
      SetLength ( L_i_String , L_FldLen );
     {$ELSE}
      L_i_String[0] := Char( L_FldLen );
     {$ENDIF}
      Move ( L_FldBegin^ , L_i_String[1] , Length(L_i_String) );
      Self.Add ( L_i_String );
   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_MyString : String ;

   G_i : Integer ;

BEGIN
   G_MyStrings := TStringList.Create ;
   TRY
      G_MyString := '' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      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 )'   );


      G_MyString := ',' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := ',,' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := 'Red,Green,Blue' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
      WriteLn ;


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


      G_MyString := 'a' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := 'a,b' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := 'a,b,c' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := ',b,c' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := 'a,,c' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


      G_MyString := 'a,b,' ;
      TStrings_ChSplitBufLen ( G_MyStrings , @G_MyString[1] , Length(G_MyString) , ',' );
      WriteLn (   TStrings_Join(G_MyStrings,';')  ,  '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );
   FINALLY
      G_MyStrings.Free ;
   END;
END.
