[SOLVED] Comparing few TStringLists

[TomTom]

  This is one of "those embarrassing" problems. I know it's simple, but somehow I can't figure it out. Here's what I have
I have such an N element array of TStringLists. I don't know how many of them I'll have, since they will ultimately be lists of file paths from multiple folders, but for testing purposes I made a simpler example.
So I have such an array of TStringList. For now, let's assume that there are 3 StringLists in this array.
What I need to do is compare each element (well part of it, part after _ underscore, but for now I want to compare/display each comparison) of each StringList (even with the elements of themselves) with the elements in the other lists and find duplicates.
So what I'm thinking I'm gonna need, is that I'll have to use few (3?) nested FOR loops. But I can't figure out how to set them up. Sometimes visualization helps me in such a problem, but this time I somehow can't visualize the problem

So in my example
Compare
0_1 with 0_1, 0_2, 0_3, 0_4, 0_5, 1_5, 1_6, 1_7, 1_8, 2_5, 2_6, 2_2, 2_8, and so on..
0_2 with 0_1, 0_2, 0_3, 0_4, 0_5, 1_5, 1_6, 1_7, 1_8, 2_5, 2_6, 2_2, 2_8, and so on..
...
1_5 with 0_1, 0_2, 0_3, 0_4, 0_5, 1_5, 1_6, 1_7, 1_8, 2_5, 2_6, 2_2, 2_8, and so on..
1_6 with 0_1, 0_2, 0_3, 0_4, 0_5, 1_5, 1_6, 1_7, 1_8, 2_5, 2_6, 2_2, 2_8, and so on..
....
etc.

For now I don't care if im comparing elements few times.
 

Code: Pascal  [Select][+][-]

1. procedure TForm1.Button1Click(Sender: TObject);
2. var
3.   tab : array of TStringList;
4.   i, j, k: Integer;
5.   sstr: String;
6. begin
7.   SetLength(tab,2);
8.   tab[0] := TStringList.Create;
9.   tab[1] := TStringList.Create;
10.   tab[2] := TStringList.Create;
11.   tab[0].Sorted:=true;
12.   tab[1].Sorted:=true;
13.   tab[2].Sorted:=true;
14.  
15.   tab[0].add('0_1');
16.   tab[0].add('0_2');
17.   tab[0].add('0_3');
18.   tab[0].add('0_4');
19.   tab[0].add('0_5');
20.  
21.   tab[1].add('1_5');
22.   tab[1].add('1_6');
23.   tab[1].add('1_7');
24.   tab[1].add('1_8');
25.   tab[2].add('2_5');
26.   tab[2].add('2_6');
27.   tab[2].add('2_2');
28.   tab[2].add('2_8');
29.  
30.  
31.  
32.   for i:=0 to Length(tab) do
33.   Begin
34.     for j:= 0 to tab[i].Count-1 do
35.     Begin
36.      //  sstr := copy(tab[i][j],2,9);
37.        for k:=0 to tab[i].count -1 do
38.        Begin
39.           Memo1.lines.add('Comparing '+ tab[i][j]+' with '+tab[i][k]);
40.  
41.       end;
42.     end;
43.  
44.   end;
45.  
46.   end;

[ASerge]

What I need to do is compare each element (well part of it, part after _ underscore, but for now I want to compare/display each comparison) of each StringList (even with the elements of themselves) with the elements in the other lists and find duplicates.

Code: Pascal  [Select][+][-]

1. {$MODE OBJFPC}
2. {$LONGSTRINGS ON}
3. {$APPTYPE CONSOLE}
4.  
5. uses SysUtils, Classes;
6.  
7. type
8.   TMyCompareList = class(TStringList)
9.   protected
10.     function DoCompareText(const S1, S2: string): PtrInt; override;
11.   end;
12.  
13. function TMyCompareList.DoCompareText(const S1, S2: string): PtrInt;
14. var
15.   P1, P2: SizeInt;
16. begin
17.   P1 := Pos('_', S1);
18.   P2 := Pos('_', S2);
19.   Result := CompareStr(
20.     Copy(S1, P1 + 1, MaxInt),
21.     Copy(S2, P2 + 1, MaxInt));
22. end;
23.  
24. procedure Test;
25. const
26.   CExternalData = '0_1 0_2 0_3 0_4 0_5 1_5 2_3';
27. var
28.   Source, DupFinder: TStringList;
29.   Index: Integer;
30.   S: string;
31. begin
32.   Source := TStringList.Create;
33.   try
34.     Source.CommaText := CExternalData;
35.     DupFinder := TMyCompareList.Create;
36.     try
37.       DupFinder.SortStyle := sslUser; // Sort, but skip Insert error
38.       for S in Source do
39.       begin
40.         if DupFinder.Find(S, Index) then
41.           Writeln('Item ', S, ' is duplicate of ', DupFinder[Index])
42.         else
43.           DupFinder.Insert(Index, S);
44.       end;
45.     finally
46.       DupFinder.Free;
47.     end;
48.   finally
49.     Source.Free;
50.   end;
51. end;
52.  
53. begin
54.   Test;
55.   Readln;
56. end.

[TomTom]

Although I won't use Your solution it made me commit JUICY face palm  
I have tendency to overcomplicate simple tasks. OFCOURSE I can use one TStringList for this (well and second one for result of processing first one).
Just two nested FOR loops will do for me .

Code: Pascal  [Select][+][-]

1. procedure TForm1.FormCreate(Sender: TObject);
2. begin
3.    a:=TStringlist.create;
4. a.add('X:\tomjab\2022\ZielonaGora\18637-18780\89\225\0\2\170\');
5. a.add('X:\tomjab\2022\ZielonaGora\18637-18780\89\225\0\2\171\');
6. a.add('X:\tomjab\2022\ZielonaGora\18637-18780\89\225\0\2\172\');
7. a.add('X:\tomjab\2022\ZielonaGora\18637-18781\89\960\0\1\1\');
8. a.add('X:\tomjab\2022\ZielonaGora\18637-18781\89\960\0\1\2\');
9. a.add('X:\tomjab\2022\ZielonaGora\18637-18781\89\225\0\2\171\');
10. a.add('X:\tomjab\2022\ZielonaGora\18637-18783\89\960\0\1\2\');
11. a.add('X:\tomjab\2022\ZielonaGora\18637-18784\89\963\0\1\2\');
12. a.add('X:\tomjab\2022\ZielonaGora\18637-18785\89\960\0\1\2\');
13.  
14.  
15. end;
16.  
17. procedure TForm1.Button1Click(Sender: TObject);
18. var
19.   i, j: Integer;
20.   syg, ser, cd, zesp, arch, st: String;
21.   r: TStringList;
22. begin
23.      r:=TStringList.Create;
24.      r.sorted:=true;
25.      r.duplicates:=dupignore;
26.  
27.   for i:=0 to a.Count-1 do
28.   Begin
29.     syg  := ReverseString(ExtractDelimited(2,ReverseString(a[i]),['\'])); // 1st folder from the end
30.     ser  := ReverseString(ExtractDelimited(3,ReverseString(a[i]),['\'])); // 2nd folder from the end
31.     cd   := ReverseString(ExtractDelimited(4,ReverseString(a[i]),['\'])); // 3rd folder from the end
32.     zesp := ReverseString(ExtractDelimited(5,ReverseString(a[i]),['\'])); // 4th folder from the end
33.     arch := ReverseString(ExtractDelimited(6,ReverseString(a[i]),['\'])); // 5th folder from the end
34.     st:=arch+'\'+zesp+'\'+cd+'\'+ser+'\'+syg; //whole main folder structure string
35.     for j:=0 to a.count-1 do
36.         Begin
37.               if i<>j then
38.               begin
39.                    if AnsiContainsText(a[j],st) then
40.                       Begin
41.                            r.add(a[j]);
42.                       end;
43.               end;
44.         end;
45.   end;
46.   memo1.lines.add('===============');
47.   for i:=0 to r.count-1 do
48.   begin
49.     memo1.lines.add(r[i]);
50.   end;
51.  
52. end;

Code: Pascal  [Select][+][-]

1. {$MODE OBJFPC}
2. {$LONGSTRINGS ON}
3. {$APPTYPE CONSOLE}
4.  
5. uses SysUtils, Classes;
6.  
7. type
8.   TMyCompareList = class(TStringList)
9.   protected
10.     function DoCompareText(const S1, S2: string): PtrInt; override;
11.   end;
12.  
13. function TMyCompareList.DoCompareText(const S1, S2: string): PtrInt;
14. var
15.   P1, P2: SizeInt;
16. begin
17.   P1 := Pos('_', S1);
18.   P2 := Pos('_', S2);
19.   Result := CompareStr(
20.     Copy(S1, P1 + 1, MaxInt),
21.     Copy(S2, P2 + 1, MaxInt));
22. end;
23.  
24. procedure Test;
25. const
26.   CExternalData = '0_1 0_2 0_3 0_4 0_5 1_5 2_3';
27. var
28.   Source, DupFinder: TStringList;
29.   Index: Integer;
30.   S: string;
31. begin
32.   Source := TStringList.Create;
33.   try
34.     Source.CommaText := CExternalData;
35.     DupFinder := TMyCompareList.Create;
36.     try
37.       DupFinder.SortStyle := sslUser; // Sort, but skip Insert error
38.       for S in Source do
39.       begin
40.         if DupFinder.Find(S, Index) then
41.           Writeln('Item ', S, ' is duplicate of ', DupFinder[Index])
42.         else
43.           DupFinder.Insert(Index, S);
44.       end;
45.     finally
46.       DupFinder.Free;
47.     end;
48.   finally
49.     Source.Free;
50.   end;
51. end;
52.  
53. begin
54.   Test;
55.   Readln;
56. end.