How do I search a stringlist for matching string? 4

[doctorjellybean]

This is what I need to achieve.

I've got a stringlist which is loaded from a text file. I need to search the stringlist for all strings found matching a given expression, e.g. the list contains :

Hello
Help Me Make
Longfellow Serenade
Make Her happy
Mama, He Is Making Eyes At me

If I want to search for "he" with wildcard support, it should show the 1st 2 items (only searching the first word, not whole string). Each match must then be added to a new stringlist until search is completed. If possible, how? Thanks in advance.

 

[Zathras]

Assuming you know how to step thru the string list items, you should be able to use the Pos function.

First see if your search string ('he') is in the string. If so, then see whether ' ' (space) is in the string. If not, add the item to the new list. If space is found, add the item to the new list if the Pos is greater than the Pos of your search string (implying that it was found in the first word.)

 

[richardchaven]

If you are looking for matches in the first two characters, then you can use

Copy

to get a substring. You example seems to imply case insensitivity, which

SameText

gives:

for Counter := 0 to AList.Count - 1 do
begin
    if SameText(AList.Strings[Counter], 1, 2), 'he') then
        OtherList.Add(AList.Strings[Counter];
end;

You can add full wildcard support for leading and embedded characters as well.

Cheers

 

[doctorjellybean]

Thanks! However, the search expression can be anything, from a single letter upwards. Perhaps an example of Pos can be shown, as I've tried it without any success. Thanks again!

 

[Zathras]

Ok, you asked for it...
[blue]

unit Unit1;

interface

uses
  Windows, SysUtils, Classes, Controls, Forms, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    Edit1: TEdit;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    List1: TStringList;
    List2: TStringList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure FilterList( ListA, ListB:TStringList; Filter:string );
var
  nFilterLoc, nSpaceLoc, X: integer;
  sFilter, sItem: string;
begin
  ListB.Clear;
  sFilter := LowerCase( Filter );
  for X := 0 to ListA.Count - 1 do
    begin
      sItem := LowerCase(ListA[X]);
      nFilterLoc := Pos( sFilter, sItem );
      if nFilterLoc > 0 then
        begin
          nSpaceLoc := Pos( ' ', sItem );
          if ((nFilterLoc < nSpaceLoc) or (nSpaceLoc = 0)) then
            ListB.Add( ListA[X] );
        end;
    end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List1 := TStringList.Create;
  List2 := TStringList.Create;
  // Simulate loading from file
  List1.Add( 'Hello' );
  List1.Add( 'Help Me Make' );
  List1.Add( 'Longfellow Serenade' );
  List1.Add( 'Make Her happy' );
  List1.Add( 'Mama, He Is Making Eyes At me' );

  // Display contents of List1 in ListBox1
  ListBox1.Items.Assign( List1 );

  // Filter List1 into List2
  FilterList( List1, List2, 'he' );

  // Display contents of List2 in ListBox2
  ListBox2.Items.Assign( List2 );
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  List1.Free;
  List2.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  FilterList( List1, List2, Edit1.Text );
  ListBox2.Items.Assign( List2 );
end;

end.

[/color]
Type "el" in the edit box and click the button to see another example.

 

[richardchaven]

This code allows leading, trailing, and embedded wildcards.

function SameWildcardText(String1, String2 : string) : Boolean;

   function StripToNextWildcard(var AString : string; var AWildcard : Char) : string;
   var
       Counter : System.Integer;
   begin
       for Counter := 1 to Length(AString) do
       begin
           if AString[Counter] in ['?', '*'] then
           begin
               Result := Copy(AString, 1, Counter - 1);
               AWildcard := AString[Counter];
               Delete(AString, 1, Counter);
               Exit;
           end;
       end;
       Result := AString;
       AString := '';
       AWildcard := #0;
   end;

var
   ThisPortion : string;
   ThisWildcard : Char;
   Index : System.Integer;
begin
   Result := False;
   ThisPortion := StripToNextWildcard(String1, ThisWildcard);
   while (ThisPortion <> '') or (ThisWildcard <> '') do
   begin
       if ThisPortion <> '' then
       begin
           if SameText(ThisPortion, Copy(String2, 1, Length(ThisPortion))) then
               Delete(String2, 1, Length(ThisPortion))
           else
               Exit;                                                           //  return False
       end;

       case ThisWildcard of
           '?' :                                                               // matches any single character
               begin
                   if String2 = '' then
                       Exit                                                    //  return false
                   else
                   begin
                       Delete(String2, 1, 1);
                       ThisPortion := StripToNextWildcard(String1, ThisWildcard);
                   end;
               end;
           '*' :
               begin
                   if String1 = '' then                                        //   trailing wildcard
                   begin
                       String2 := '';
                       Break;
                   end
                   else
                   begin                                                       //      if the next character in String1 is a wildcard, then we will return False
                       ThisPortion := StripToNextWildcard(String1, ThisWildcard);
                       Index := Pos(UpperCase(ThisPortion), UpperCase(String2)); //  find the next matching character
                       if Index = -1 then
                           Exit                                                //  return False
                       else
                           Delete(String2, 1, Index - 1);
                   end;
               end;

           else
               ThisPortion := StripToNextWildcard(String1, ThisWildcard);
       end;
   end;

   Result := (String2 = '');
end;

Cheers

 

[doctorjellybean]

Thanks Zathras!

richardchaven, I do not want to appear lazy, but therory ain't my strong point Maybe you can provide full code (as in Zathras sample) which shows listboxes, edit box, etc. Taking your example above, I don't know how to connect waht with what. This way I can experiment and learn. Thanks in advance.

 

[doctorjellybean]

I've just experimented with the above code, and suddenly realized that I've not made myself very clear. Please accept my apologies! Ok, here I go again :

The stringlist is e.g. :

Hello
Help Me Make
Longfellow Serenade
Make Her Happy
Mama, He Is Making Eyes At Me

What I'm searching for is track tiles. Therefore, I want to find all tracks beginning with e.g. "ma", it will list the last 2 lines. If I want to find tracks with wildcard+"ma"+wildcard, it'll list 2nd and last 2 lines. It doesn't list each instance found in a single line, just once per line.

Hope this is clearer.

 

[Zathras]

Richard's code isn't just theory, it's a complete working function. Here it is again, slightly re-formatted for clarity. Just paste it in the unit as the first function in the [blue]

 implementation

[/color] section:
[blue]

function SameWildcardText(String1, String2 : string) : Boolean;

  {1} function StripToNextWildcard(var AString : string; var AWildcard : Char) : string;
  {1}  var
  {1}    Counter : System.Integer;
  {1}  begin
  {1}    for Counter := 1 to Length(AString) do
  {1}      if AString[Counter] in ['?', '*'] then
  {1}        begin
  {1}          Result := Copy(AString, 1, Counter - 1);
  {1}          AWildcard := AString[Counter];
  {1}          Delete(AString, 1, Counter);
  {1}          Exit;
  {1}        end;
  {1}    Result := AString;
  {1}    AString := '';
  {1}    AWildcard := #0;
  {1}  end;

var
   ThisPortion : string;
   ThisWildcard : Char;
   Index : System.Integer;
begin
   Result := False;
   ThisPortion := StripToNextWildcard(String1, ThisWildcard);
   while (ThisPortion <> '') or (ThisWildcard <> '') do
     begin
       if ThisPortion <> '' then
         if SameText(ThisPortion, Copy(String2, 1, Length(ThisPortion))) then
           Delete(String2, 1, Length(ThisPortion))
         else
           Exit;                                         //  return False
       case ThisWildcard of
   '?' : begin                                     // matches single character
           if String2 = '' then
             Exit                                  //  return false
           else
             begin
               Delete(String2, 1, 1);
               ThisPortion := StripToNextWildcard(String1, ThisWildcard);
             end;
         end; // case '?'

   '*' : begin                                  // matches all characters
           if String1 = '' then                 //   trailing wildcard
             begin
               String2 := '';
               Break;
             end
           else
             begin
               //  if the next character in String1 is a wildcard,
               //  then we will return False.
               ThisPortion := StripToNextWildcard(String1, ThisWildcard);
               //  find the next matching character
               Index := Pos(UpperCase(ThisPortion), UpperCase(String2));
               if Index = -1 then
                 Exit                                 //  return False
               else
                 Delete(String2, 1, Index - 1);
             end;
         end; // case '*'

         else
           ThisPortion := StripToNextWildcard(String1, ThisWildcard);
       end; // case

   end; // while
   Result := (String2 = '');
end;

[/color]
Then replace my [blue]

 FilterList

[/color] procedure with the following:
[blue]

procedure FilterList( ListA, ListB:TStringList; Filter:string );
var
  X: integer;
  sFilter, sItem: string;
begin
  ListB.Clear;
  sFilter := LowerCase( Filter );
  if (Pos('*',Filter) = 0) and (Pos('?',Filter) = 0) then
    Filter := Filter + '*';   // Add trailing wildcard if no wildcards.
    for X := 0 to ListA.Count - 1 do
    begin
      sItem := LowerCase(ListA[X]);
      if SameWildcardText(Filter, sItem) then
        ListB.Add( ListA[X] );
    end;
end;

[/color]
Richard's code is not completely correct, but I don't have time to debug it for you. Perhaps he can take a look. When I use the wildcard expression *e*e I would expect to see any title with an "e" in the middle and an "e" at the end, such as "Help Me Make" and "Longfellow Serenade" and "Mama, He Is Making Eyes At me" but it finds nothing.

 

[doctorjellybean]

Many thanks Zathras! It works beautifully, just want I wanted. Yes, as you say, Richard's code doesn't appear to work with wildcards. A solution for that would be much appreciated Richard. Once again, many thanks.

 

[richardchaven]

Indeed, a search string with an embeded wildcard and a trailing literal would fail. My apologies.

Here is a fixed version:

function SameWildcardText(String1, String2 : string) : Boolean;

   function StripToNextWildcard(var AString : string; var AWildcard : Char) : string;
   var
       Counter : System.Integer;
   begin
       for Counter := 1 to Length(AString) do
       begin
           if AString[Counter] in ['?', '*'] then
           begin
               Result := Copy(AString, 1, Counter - 1);
               AWildcard := AString[Counter];
               Delete(AString, 1, Counter);
               Exit;
           end;
       end;
       Result := AString;
       AString := '';
       AWildcard := #0;
   end;

var
   ThisPortion : string;
   ThisWildcard : Char;
   Index : System.Integer;
begin
   Result := False;
   ThisPortion := StripToNextWildcard(String1, ThisWildcard);
   while (ThisPortion <> '') or (ThisWildcard <> '') do
   begin
       if ThisPortion <> '' then
       begin
           if SameText(ThisPortion, Copy(String2, 1, Length(ThisPortion))) then
               Delete(String2, 1, Length(ThisPortion))
           else
               Exit;                                                           //  return False
       end;

       case ThisWildcard of
           '?' :                                                               // matches any single character
               begin
                   if String2 = '' then
                       Exit                                                    //  return false
                   else
                   begin
                       Delete(String2, 1, 1);
                       ThisPortion := StripToNextWildcard(String1, ThisWildcard);
                   end;
               end;
           '*' :
               begin
                   if String1 = '' then                                        //   trailing wildcard
                   begin
                       String2 := '';
                       Break;
                   end
                   else
                   begin
                       ThisPortion := StripToNextWildcard(String1, ThisWildcard);
                       if (String1 = '') and (ThisPortion = '') then       //  trailing wildcards
                       begin
                           Result := True;
                           Exit;
                       end;

                       if (String1 = '') and (ThisPortion <> '') then       //  last character
                       begin
                           Result := SameText(ThisPortion, Copy(String2, (Length(String2) - Length(ThisPortion)) + 1, Length(ThisPortion)));
                           Exit;
                       end;

                       if ThisPortion = '' then
                           Continue;

                       Index := Pos(UpperCase(ThisPortion), UpperCase(String2)); //  find the next matching character
                       if Index = -1 then
                           Exit                                                //  return False
                       else
                           Delete(String2, 1, Index - 1);
                   end;
               end;

           else
               ThisPortion := StripToNextWildcard(String1, ThisWildcard);
       end;
   end;

   Result := (String2 = '');
end;

Cheers

 

[doctorjellybean]

Many thanks for all your help!