PROGRAM   ChSptB14 ;
{$IFDEF VER60}                 USES   Objects ;   {$ENDIF}
{$IFDEF VER70}{$IFDEF MSDOS}   USES   Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER70}{$IFDEF DPMI}    USES   Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER70}{$IFDEF WINDOWS}   USES   WinCRT , Objects ;   {$ENDIF}{$ENDIF}
{$IFDEF VER80}                   USES   WinCRT , Objects ;   {$ENDIF}      {--- Delphi1 }

{
!------------------------------------------------------------------------------
! Small toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TCollection (of String) routines
!---------------
! TCollectionOfString_FreeItems
!---------------
}
{===== TCollectionOfString_FreeItems }

PROCEDURE   TCollectionOfString_FreeItems   ( Var Self : TCollection );
VAR
   L_i : Longint ;
BEGIN
   {----- LOOP , Free all String items }
   FOR L_i := 0 TO Self.Count -1 DO BEGIN
      DisposeStr ( Self.At(L_i) );
   END;

   Self.DeleteAll ;
END;

{
!------------------------------------------------------------------------------
! This program toolbox
!------------------------------------------------------------------------------
}
{
!---------------
! TCollection (of String) routines
!---------------
! TCollectionOfString_ChSplitBufLen
!---------------
}
{===== TCollectionOfString_ChSplitBufLen }

PROCEDURE   TCollectionOfString_ChSplitBufLen   ( Var Self : TCollection
                                                ; I_PBuf : PChar
                                                ; I_Len  : Longint
                                                ; I_ChSeparator : Char );
LABEL
   L_LOOP_END ;
VAR
   L_PLast    : PChar ;
   L_FldBegin : PChar ;
   L_FldAEnd  : PChar ;
   L_i_String : String ;
BEGIN
   TCollectionOfString_FreeItems ( Self );

   IF I_Len = 0 THEN EXIT ;

   Longint(L_PLast) := Longint(I_PBuf) + I_Len -1 ;
   L_FldBegin := I_PBuf ;
   L_FldAEnd  := I_PBuf ;

   {----- LOOP 1 , Search each field }
   WHILE TRUE DO BEGIN
      {----- LOOP 2 , Search separator }
      WHILE (Longint(L_FldAEnd) <= Longint(L_PLast)) and (L_FldAEnd^ <> I_ChSeparator)
      DO Inc ( L_FldAEnd );

      {----- Add field }
      L_i_String[0] := Char( L_FldAEnd - L_FldBegin );
      Move ( L_FldBegin^ , L_i_String[1] , Length(L_i_String) );
      Self.AtInsert ( Self.Count , NewStr(L_i_String) );

      {----- If inside the string (separator found),... }
      IF Longint(L_FldAEnd) <= Longint(L_PLast)
      THEN BEGIN
         {----- Prepare next search }
         Inc ( L_FldAEnd );
         L_FldBegin := L_FldAEnd ;
      END
      ELSE GOTO L_LOOP_END ;      {--BREAK ;--}
   END;{while}
  L_LOOP_END:
END;


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


FUNCTION   TCollectionOfString_Join   ( Var Self : TCollection
                                      ; I_Separator : String ) : String ;
VAR
   L_Result : String ;
   L_i       : Integer ;
   L_PString : PString ;
BEGIN
   L_Result := '' ;

   {----- LOOP , Concat items }
   FOR L_i := 0 TO Self.Count -1 DO BEGIN
      L_PString := Self.At(L_i);

      IF L_i > 0 THEN L_Result := L_Result  +  I_Separator ;
      IF L_PString <> Nil
      THEN L_Result := L_Result  +  L_PString^ ;
   END;{for}

   TCollectionOfString_Join := L_Result ;
END;

{===== Test Speed variables }
LABEL
   G_TEST_SPEED ;
VAR
   G_SPEED_LoopMax  : Longint ;
   G_SPEED_String1  : String ;
   G_SPEED_i        : Longint ;
   G_SPEED_DummyStr : String ;

   GI_SPEED_TmpStr : String ;
   G_SPEED_ErrPos  : Integer ;

VAR
   G_MyStrings : TCollection ;

   G_MyString : String ;

   G_i : Integer ;

BEGIN
   G_MyStrings.Init ( 0 , 4 );



   IF ParamStr(1) = 'TestSpeed' THEN GOTO G_TEST_SPEED ;      {--- Test speed ?  }



   G_MyString := '' ;
   TCollectionOfString_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 (   PString(G_MyStrings.At(G_i))^   );
   END;{i}
   WriteLn (   '<== ( '  ,  G_MyStrings.Count  ,  '  fields )'   );


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


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


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


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


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


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


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


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


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


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



   {***************  TEST SPEED  ***************}
  G_TEST_SPEED:

   {----- Get Parameter 2  ( optional ) : Loop max }
   G_SPEED_LoopMax := 10 ;      {--- Default value }
   GI_SPEED_TmpStr := ParamStr(2);
   IF GI_SPEED_TmpStr <> '' THEN BEGIN
      Val ( GI_SPEED_TmpStr , G_SPEED_LoopMax , G_SPEED_ErrPos );
      IF G_SPEED_ErrPos <> 0 THEN BEGIN
         WriteLn (   'ERROR: '  ,  'Number expected  ( Parameter 2 ).'   );
         HALT ( 1 );
      END;
   END;

   G_SPEED_String1 := 'Red,Green,Blue,Red,,..........,Green..........,Blue..........,,Red,Green,Blue,,,' ;
                      {12345678901234567890123456789012345678901234567890123456789012345678901234567890}

   {----- LOOP , Call a split }
   FOR G_SPEED_i := 1 TO G_SPEED_LoopMax DO BEGIN
      TCollectionOfString_ChSplitBufLen ( G_MyStrings , @G_SPEED_String1[1] , Length(G_SPEED_String1) , ',' );
   END;{i}



   TCollectionOfString_FreeItems ( G_MyStrings );
   G_MyStrings.Done ;
END.
