(**************************************************)
(* Name: Filter                                   *)
(* Last Revision: 16 February 2010                *)
(* Version: 2.0                                   *)
(*                                                *)
(* Copyright © 2000 - 2010 by Christian Aaangel   *)
(**************************************************)
(*                                                *)
(* Please Note that this new version can use      *)
(* strings as seperator, but it's NOT implemented *)
(* in the routine REPLACEFILT it's still char     *)
(* operated                                       *)
(*                                                *)
(**************************************************)

// Added as of Version 2.0
// -----------------------
// Enables you to cut strings using a
// start seperator and end seperator
//
// Eg. [Using "<" as Start Seperator and ">" as End Seperator] (Default seperators)
//
// ABC<1>D<2>E
//
// Using OutsideXXX will get everything not in the "<>" field
// Using InsideXXX will get everything in between the "<>" field



unit Filter;

interface

uses sysUtils;


Const
 Sep = ',';
 StartSp = '<';
 EndSp = '>';

Type
 TFilterList = Class(TObject)
 private
  fList: String;
    fDELIMITER: String;
    function GETITEM(Index: Integer): String;
    procedure SETITEM(Index: Integer; const Value: String);
    procedure SETTEXT(const Value: String);
    function GETCOUNT: Integer;
    function GETTEXT: String;
 public
  Constructor Create(aDelimeter: string);
  Property Count: Integer read GETCOUNT;
  Property Items[Index: Integer]: String read GETITEM write SETITEM; default;
  Procedure Add(Str: String);
  Procedure Delete(Index: Integer); overload;
  Procedure Delete(Str: String); overload;
  Property Delimiter: String read fDELIMITER write fDELIMITER;
  Property Text: String read GETTEXT write SETTEXT;
 end;

Function CountFilt(From: String; Seperator: String = Sep; CaseSensitive: Boolean = True): Integer;
Function GetFilt(From: String; Number: Integer; Seperator: String = Sep; CaseSensitive: Boolean = True): String;
Function GetLastFilt(From: String; Seperator: String = Sep): String;
Function DelFilt(From: String; Number: Integer; Seperator: String = Sep): String;
Function DelLastFilt(From: String; Seperator: String = Sep): String;
Function ReplaceFilt(From: String; Number: Integer; ReplaceWith: String; Seperator: String = Sep): String;
Function AddFilt(Too: String; AddWhat: String; Seperator: String = Sep): String;
Function AddFirstFilt(Too: String; AddWhat: String; Seperator: String = Sep): String;

// Added as of Version 2.0
// -----------------------
// Enables you to cut strings using a
// start seperator and end seperator
//
// Eg. [Using "<" as Start Seperator and ">" as End Seperator]
// ABC<1>D<2>E
//
// Using OutsideXXX will get everything not in the "<>" field
// Using InsideXXX will get everything in between the "<>" field

Function CountOutsideSegments(From: String; StartSep: Char = StartSp; EndSep: Char = EndSp): Integer;
Function CountInsideSegments(From: String; StartSep: Char = StartSp; EndSep: Char = EndSp): Integer;
Function GetOutsideSegments(From: String; Count: Integer; StartSep: Char = StartSp; EndSep: Char = EndSp): String;
Function GetInsideSegments(From: String; Count: Integer; StartSep: Char = StartSp; EndSep: Char = EndSp): String;
Function CopyEx(From: String; StartPoint, EndPoint: Integer): String;


implementation

Function CountFilt(From: String; Seperator: String = Sep; CaseSensitive: Boolean = True): Integer;
var
 Res, IC: Integer;
Begin
 Res := 0;
 If Not CaseSensitive Then begin
  From := Uppercase(From);
  Seperator := Uppercase(Seperator);
 end;
 If Length(From) > 0 Then begin
  Res := 1;
  For IC := 1 to length(From) do begin
   If Copy(From, IC, Length(Seperator)) = Seperator Then Inc(Res);
  End;
 End;
 Result := Res;
End;

Function GetFilt(From: String; Number: Integer; Seperator: String = Sep; CaseSensitive: Boolean = True): String;
Var
 LastRecorded, CStart, CSlut, ATF, IC: Integer;
 TFrom: String;
 Res: String;
Begin
 Res := '';
 If Not CaseSensitive Then TFrom := Uppercase(From)
  else TFrom := From;
 If Not CaseSensitive Then Seperator := Uppercase(Seperator);
 If Number > CountFilt(TFrom, Seperator, CaseSensitive) Then Begin
  Result := Res;
  Exit;
 End;
 If Length(TFrom) > 0 Then begin
  If (Copy(TFrom, 1, Length(Seperator)) = Seperator) And (Number = 1) Then Begin
   Result := Res;
   Exit;
  End;
  CStart := 0;
  CSlut := 0;
  ATF := 1;
  LastRecorded := 0;
  If Number = 1 Then CStart := 1;
  For IC := 1 to length(TFrom) do begin
   LastRecorded := IC;
   If Copy(TFrom, IC, Length(Seperator)) = Seperator Then begin
    Inc(ATF);
    If ATF = Number Then CStart := IC + Length(Seperator);
    If ATF = Number + 1 Then CSlut := IC - 1 ;
   End;
  end;
  If (CStart <> 0) And (CSlut = 0) Then CSlut := LastRecorded;
  Res := Copy(From, CStart, CSlut - CStart + 1);
 End;
 Result := Res;
End;

Function DelFilt(From: String; Number: Integer; Seperator: String = sep): String;
Var
 MAt, At, Start, Count, ICount: Integer;
 Finish: String;
Begin
 If Length(From) > 0 Then begin
  At := 1;
  Start := 1;
  If At = Number Then Start := 1;
  Count := 0;
  MAt := 0;
  If (countfilt(from, seperator) - 1) = 0 then begin
   Result := '';
   exit;
  end;
  For ICount := 1 to length(From) do begin
   If Copy(From, ICount, length(Seperator)) = Seperator Then begin
    At := At + 1;
    If At = Number Then Start := ICount - 1;
    If At = Number + 1 Then Count := ICount;
   End;
   MAt := ICount;
  End;
  If At = Number Then Count := MAt;
  If Count = 0 Then Finish := From;
  If Number = 1 Then Count := Count + 1;
  If Number = 1 Then begin
   Finish := Copy(From, Count, Length(From));
  End;
  If Number > 1 Then Finish := Copy(From, 1, Start) + Copy(From, Count, Length(From));
  If Number = CountFilt(From, Seperator) Then Finish := Copy(From, 1, Start);
  Result := Finish;
 End;
End;

Function ReplaceFilt(From: String; Number: Integer; ReplaceWith: String; Seperator: String = Sep): String;
Var
 IC: Integer;
 TempStr: String;
Begin
 If Number > CountFilt(From, Seperator) Then Begin
  // Intercept Exception - Out of Arguments
  Result := From;
 End
  else
 Begin
  TempStr := '';
  For IC := 1 to Number-1 do begin
   TempStr := TempStr + Seperator + GetFilt(From, IC, Seperator);
  End;
  If copy(TempStr, 1, length(Seperator)) = Seperator then begin
   TempStr := Copy(TempStr, length(Seperator) + 1, Length(TempStr));
  end;
  TempStr := TempStr + Seperator + ReplaceWith;
  For IC := Number+1 to CountFilt(From, Seperator) do begin
   TempStr := TempStr + Seperator + GetFilt(From, IC, Seperator);
  End;
  If Length(TempStr) > 0 Then
   If copy(TempStr, 1, length(Seperator)) = Seperator Then TempStr := Copy(TempStr, length(seperator) + 1, Length(TempStr));
  Result := TempStr;
 End;
End;

Function AddFilt(Too: String; AddWhat: String; Seperator: String = Sep): String;
Var
 TempStr: String;
Begin
 TempStr := '';
 If Too = '' Then TempStr := AddWhat
  else
 Begin
  TempStr := Too;
  If Too[Length(Too)] <> Seperator Then TempStr := TempStr + Seperator;
  TempStr := TempStr + AddWhat;
 End;
 Result := TempStr;
End;

Function AddFirstFilt(Too: String; AddWhat: String; Seperator: String = Sep): String;
Var
 TempStr: String;
Begin
 TempStr := '';
 If Too = '' Then TempStr := AddWhat
  else
 Begin
  TempStr := Too;
  If Too[1] <> Seperator Then TempStr := Seperator + TempStr;
  TempStr := AddWhat + TempStr;
 End;
 Result := TempStr;
End;

Function GetLastFilt(From: String; Seperator: String = Sep): String;
begin
 Result := GetFilt(From, countfilt(from, seperator), seperator);
end;

Function DelLastFilt(From: String; Seperator: String = Sep): String;
begin
 Result := DelFilt(From, CountFilt(From, Seperator), Seperator);
end;

{ TFilterList }

procedure TFilterList.Add(Str: String);
begin
 fList := fList + Delimiter + Str;
 If copy(fList, 1, length(delimiter)) = delimiter then begin
  fList := Copy(fList, length(delimiter) + 1, length(fList));
 end;
end;

constructor TFilterList.Create(aDelimeter: string);
begin
 fDelimiter := aDelimeter;
end;

procedure TFilterList.Delete(Index: Integer);
begin
 fList := DelFilt(fList, Index + 1, delimiter);
end;

procedure TFilterList.Delete(Str: String);
Var
 I: Integer;
begin
 For I := 1 to count do begin
  If uppercase(GetFilt(fList, I, delimiter)) = uppercase(STR) then begin
   Delete(I - 1);
   Break;
  end;
 end;
end;

function TFilterList.GETCOUNT: Integer;
begin
 Result := CountFilt(fList, Delimiter);
end;

function TFilterList.GETITEM(Index: Integer): String;
begin
 Result := GetFilt(fList, Index + 1, Delimiter);
end;

function TFilterList.GETTEXT: String;
begin
 Result := fList;
end;

procedure TFilterList.SETITEM(Index: Integer; const Value: String);
begin
 fList := ReplaceFilt(fList, Index + 1, Value, delimiter);
end;

procedure TFilterList.SETTEXT(const Value: String);
begin
 fList := Value;
end;

function CopyEx(From: String; StartPoint, EndPoint: Integer): String;
begin
 If EndPoint < StartPoint then Begin
  Result := From;
  Exit;
 End;
 If EndPoint = StartPoint then begin
  Result := From[StartPoint];
  Exit;
 end;
 EndPoint := EndPoint - StartPoint + 1;
 Result := Copy(From, StartPoint, EndPoint);
end;

function CountInsideSegments(From: String; StartSep,
  EndSep: Char): Integer;
Var
 At: Integer;
 InSegment: Boolean;
 Handled: Boolean;
begin
 Result := 0;
 At := 1;
 InSegment := False;
 Repeat
  Handled := false;
  If (From[At] = StartSep) and (Not InSegment) then begin
   InSegment := true;
   Handled := true;
  end;
  If (From[At] = StartSep) and (InSegment) and (Not handled) then begin
   Raise Exception.Create('Error: Found start seperator before end seperator');
  end;
  If (From[At] = EndSep) and (InSegment) and (Not Handled) then begin
   Handled := true;
   InSegment := false;
   Inc(Result);
  end;
  If (From[At] = EndSep) and (Not InSegment) and (Not Handled) Then begin
   Raise Exception.Create('Error: Found End seperator before Start seperator');
  end;
  Inc(At);
 Until At > Length(From);
 If InSegment then begin
  Raise Exception.Create('Error: Segment not closed at the end');
 end;
end;

function CountOutsideSegments(From: String; StartSep, EndSep: Char): Integer;
Var
 At: Integer;
 InSegment: Boolean;
 Handled: Boolean;
begin
 Result := 1;
 At := 1;
 InSegment := False;
 Repeat
  Handled := false;
  If (From[At] = StartSep) and (Not InSegment) then begin
   InSegment := true;
   Handled := true;
  end;
  If (From[At] = StartSep) and (InSegment) and (Not handled) then begin
   Raise Exception.Create('Error: Found start seperator before end seperator');
  end;
  If (From[At] = EndSep) and (InSegment) and (Not Handled) then begin
   Handled := true;
   InSegment := false;
   Inc(Result);
  end;
  If (From[At] = EndSep) and (Not InSegment) and (Not Handled) Then begin
   Raise Exception.Create('Error: Found End seperator before Start seperator');
  end;
  Inc(At);
 Until At > Length(From);
 If InSegment then begin
  Raise Exception.Create('Error: Segment not closed at the end');
 end;
end;

function GetInsideSegments(From: String; Count: Integer; StartSep,
  EndSep: Char): String;
Var
 At: Integer;
 SegmentCount: Integer;
 InSegment: Boolean;
 Handled: Boolean;
 StartPoint: Integer;
begin
 Result := From;
 SegmentCount := 0;
 At := 1;
 StartPoint := 1;
 InSegment := False;
 Repeat
  Handled := false;
  If (From[At] = StartSep) and (Not InSegment) then begin
   InSegment := true;
   Handled := true;
   StartPoint := At + 1;
   Inc(SegmentCount);
  end;
  If (From[At] = StartSep) and (InSegment) and (Not handled) then begin
   Raise Exception.Create('Error: Found start seperator before end seperator');
  end;
  If (From[At] = EndSep) and (InSegment) and (Not Handled) then begin
   Handled := true;
   InSegment := false;

   If SegmentCount = Count then begin
    If (At = 1) and (StartPoint = 1) then begin
     Result := '';
     Exit;
    end
     else
    begin
     Result := CopyEx(From, StartPoint, At - 1);
     Exit;
    end;
   end;

  end;
  If (From[At] = EndSep) and (Not InSegment) and (Not Handled) Then begin
   Raise Exception.Create('Error: Found End seperator before Start seperator');
  end;
  Inc(At);
 Until At > Length(From);
 If InSegment then begin
  Raise Exception.Create('Error: Segment not closed at the end');
 end;

   If SegmentCount = Count then begin
    If (At = 1) and (StartPoint = 1) then begin
     Result := '';
     Exit;
    end
     else
    begin
     Result := Copy(From, StartPoint, At - 1);
     Exit;
    end;
   end;

end;

function GetOutsideSegments(From: String; Count: Integer; StartSep,
  EndSep: Char): String;
Var
 At: Integer;
 SegmentCount: Integer;
 InSegment: Boolean;
 Handled: Boolean;
 StartPoint: Integer;
begin
 Result := From;
 SegmentCount := 1;
 At := 1;
 StartPoint := 1;
 InSegment := False;
 Repeat
  Handled := false;
  If (From[At] = StartSep) and (Not InSegment) then begin
   InSegment := true;
   Handled := true;

   If SegmentCount = Count then begin
    If (At = 1) and (StartPoint = 1) then begin
     Result := '';
     Exit;
    end
     else
    begin
     Result := CopyEx(From, StartPoint, At - 1);
     Exit;
    end;
   end;

  end;
  If (From[At] = StartSep) and (InSegment) and (Not handled) then begin
   Raise Exception.Create('Error: Found start seperator before end seperator');
  end;
  If (From[At] = EndSep) and (InSegment) and (Not Handled) then begin
   Handled := true;
   InSegment := false;
   Inc(SegmentCount);
   StartPoint := At + 1;
  end;
  If (From[At] = EndSep) and (Not InSegment) and (Not Handled) Then begin
   Raise Exception.Create('Error: Found End seperator before Start seperator');
  end;
  Inc(At);
 Until At > Length(From);
 If InSegment then begin
  Raise Exception.Create('Error: Segment not closed at the end');
 end;

   If SegmentCount = Count then begin
    If (At = 1) and (StartPoint = 1) then begin
     Result := '';
     Exit;
    end
     else
    begin
     Result := Copy(From, StartPoint, At - 1);
     Exit;
    end;
   end;

end;

end.
