Szybki sposob na zliczanie danych w plikach

var
i, a, x : integer;
s1, s2 : string;
sl, sl1, sl2, sl5, sl6 : TStringList;
begin
  sl := TStringList.Create;
  sl1 := TStringList.Create;
  sl2 := TStringList.Create;
  sl5 := TStringList.Create;
  sl6 := TStringList.Create;

  for i := MojaLista2.Count -1 downto 0 do
  begin
    sl.Clear;
    if pos(' ',MojaLista2[i]) > 0 then ExtractStrings([' '], [' '], PChar(MojaLista2[i]), sl);
    if pos(' ',MojaLista2[i]) > 0 then sl1.Add(Trim(sl[15]+' '+sl[6]+' '+sl[0]));

    application.ProcessMessages;
  end;

  MojaLista2.Text := sl1.Text;
  //ListBox2.Count := MojaLista2.Count;

  sl1.Clear;

  MojaLista2.Sorted := True;
  MojaLista2.Sorted := False;

  MojaLista2.Insert(0,'[] [] [] [] [] [] [] []');
  //MojaLista2.Insert(0,'[]');

  ListBox2.Count := MojaLista2.Count;

  //MojaLista.Insert(0,'');
  //ListBox1.Count := MojaLista.Count;

for i := MojaLista2.Count -1 downto 1 do
begin
 sl.Clear;
 sl2.Clear;
 sl5.Clear;
 sl6.Clear;

 ExtractStrings([' ',' '], [ ], Pchar(MojaLista2[i]),  sl5);
 ExtractStrings([' ',' '], [ ], Pchar(MojaLista2[i-1]),sl6);

 s1 := sl5[0]+' '+sl5[1];
 s2 := sl6[0]+' '+sl6[1];

 //s1 := sl5[0];
 //s2 := sl6[0];

 if s1 = s2 then inc(a);
 if a = 0 then x := 0;

 if s1 <> s2 then ExtractStrings([' ',' '], [ ], Pchar(MojaLista2[i]),sl2);

 if s1 <> s2  then sl.Text := sl2[1]+' => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+sl2[0];

 ExtractStrings([' ',' '], [ ], Pchar(MojaLista2[i]),sl2);

 x := x + strtoint(sl2[2]);

 if s1 <> s2 then a := 0;

 if s1 <> s2 then sl1.Add(inttostr(x)+' razy wystąpiło powtórzenie w rzędzie '+sl[sl.Count-1]);

 if a = 0 then x := 0;
 
 if i = 1 then break;

 application.ProcessMessages;
end;

 MojaLista2.Delete(0);
// ListBox4.Count := MojaLista1.Count;
 
 MojaLista2.Text := sl1.Text;
 Listbox2.Count := MojaLista2.Count;

 sl.free;
 sl1.free;
 sl2.free;
 sl5.free;
 sl6.free;

 Sortuj__;
 SendMessage(ListBox2.Handle,WM_VSCROLL,SB_BOTTOM,0);

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, IniFiles;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    ListBox2: TListBox;
    Label2: TLabel;
    ListBox3: TListBox;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Button3: TButton;
    MainMenu1: TMainMenu;
    Plik1: TMenuItem;
    Button5: TButton;
    CheckBox1: TCheckBox;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Zliczaj1;
    procedure Zliczaj2;
    procedure ListBox1Data(Control: TWinControl; Index: Integer;
      var Data: String);
    procedure ListBox3Data(Control: TWinControl; Index: Integer;
      var Data: String);
    procedure Button3Click(Sender: TObject);
    procedure ListBox2Data(Control: TWinControl; Index: Integer;
      var Data: String);
    procedure Sortuj;
    procedure Button5Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  iiii : integer;
  ssss : string;
  BreakProces : Boolean; // przerwanie pętli

  TimeA, TimeB, TimeC, TimeD : TDateTime;

  ZliczajListe, ZliczajListe1, MyList, MyList1  : TStringList;

implementation

{$R *.dfm}

// SORTOWANIE 2
function Sortowanie(List : TStringList; Index1, Index2 : Integer) : Integer;
var
  I1, I2 : integer;
begin
  I1 := Integer(List.Objects[Index1]);
  I2 := Integer(List.Objects[Index2]);
  if I1 < I2 then
    Result := -1
  else if I1 > I2 then
    Result := 1
  else
    Result := CompareText(List[Index1], List[Index2]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i : integer;
begin
MyList.Clear;

for i := strtoint(Edit2.Text) to strtoint(Edit3.Text) do
begin
  MyList.Add('1 razy wystąpiło powtórzenie w rzędzie [1] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+inttostr(i)+'?');
  MyList.Add('1 razy wystąpiło powtórzenie w rzędzie [2] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+inttostr(i)+'?');
  MyList.Add('1 razy wystąpiło powtórzenie w rzędzie [3] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+inttostr(i)+'?');
  MyList.Add('1 razy wystąpiło powtórzenie w rzędzie [4] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+inttostr(i)+'?');
  MyList.Add('1 razy wystąpiło powtórzenie w rzędzie [5] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: '+inttostr(i)+'?');
end;

ListBox3.Count := MyList.Count;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
sr: TSearchRec;
begin
ZliczajListe := TStringList.Create;
ZliczajListe1 := TStringList.Create;
MyList := TStringlist.Create;
MyList1 := TStringlist.Create;

ListBox2.Style := lbVirtual;
ListBox3.Style := lbVirtual;

if FindFirst(ExtractFilePath(Application.ExeName)+'Szablony\PowtorzeniaLiczb\Inne\542\DO\*', faDirectory, sr) = 0 then
begin
repeat
if ((sr.Attr and faDirectory) <> 0) and
(sr.Name <> '.') and (sr.Name <> '..') then
begin
//Mojalista2.Add(sr.Name);
//ListBox2.Items.Add(sr.Name);
ZliczajListe1.Add(sr.Name);
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ListBox2.Items.SaveToFile('wynikiss.txt');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
i : integer;
begin
 ListBox2.Enabled := False;
 ListBox3.Enabled := False;
 CheckBox1.Enabled := False;

 BreakProces := false;

 ListBox3.ItemIndex := 0;

 TimeC := StrtoDateTime(FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));

 for i := strtoint(Edit1.Text)-1 to ListBox3.Items.Count -1 do
 begin
  ZliczajListe.Clear;
  ListBox3.ItemIndex := i;
  TimeA := StrtoDateTime(FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));

  ssss := ListBox3.Items[i];

  Zliczaj1;

  MyList1.Add(Label1.Caption +' '+Label2.Caption);
  ListBox2.Count := MyList1.Count;

  if CheckBox1.Checked = True then
  begin
  Sortuj;
  SendMessage(listbox2.Handle,WM_VSCROLL,SB_BOTTOM,0);
  end;

  Label8.Caption := Inttostr(ListBox2.Items.Count)+' / '+Inttostr(ListBox3.Items.Count);

  TimeB := StrtoDateTime(FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));

  Label6.Caption := TimeToStr(TimeB-TimeA);

  TimeD := StrtoDateTime(FormatDateTime('yyyy-mm-dd hh:nn:ss', Now));
  Label10.Caption := TimeToStr(TimeC-TimeD);

  if BreakProces = True then break;
 end;

 ListBox2.Enabled := True;
 ListBox3.Enabled := True;
 CheckBox1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ZliczajListe.Free;
  ZliczajListe1.Free;
  MyList.Free;
  MyList1.Free;
end;

procedure TForm1.Zliczaj1;
var
i : integer;
begin
for i := 1 to ZliczajListe1.Count -1 do
begin
  iiii := i;
  
  Zliczaj2;

  application.ProcessMessages;
end;
Label1.caption := inttostr(ZliczajListe.Count);
end;

procedure TForm1.Zliczaj2;
var
PlikTekstowy : TextFile;
s : string;
begin
  AssignFile(PlikTekstowy, ExtractFilePath(Application.ExeName)+'Szablony\PowtorzeniaLiczb\Inne\542\DO\'+trim(ZliczajListe1[iiii])+'\PLBS1.txt');
  Reset(PlikTekstowy);

  repeat
    readln(PlikTekstowy,s);
    if pos(s+'?', ssss) > 0 then
    ZliczajListe.Add(s);

    if pos(s+'?', ssss) > 0 then Label2.Caption := s+'?';
    if pos(s+'?', ssss) > 0 then break;

  until eof(PlikTekstowy);

  Closefile(PlikTekstowy);
end;

procedure TForm1.ListBox1Data(Control: TWinControl; Index: Integer;
  var Data: String);
begin
 // Data := Mylist[index];
end;

procedure TForm1.ListBox3Data(Control: TWinControl; Index: Integer;
  var Data: String);
begin
  Data := Mylist[index];
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.ListBox2Data(Control: TWinControl; Index: Integer;
  var Data: String);
begin
  Data := Mylist1[index];
end;

procedure TForm1.Sortuj;
var
  i : integer;
  s : string;
  sl, sl1 : TStringList;
begin
  sl := TStringList.Create;
  sl1 := TStringList.Create;
  sl1.Text := ListBox2.Items.Text;

  for i := 0 to sl1.Count - 1 do
  begin
    s := Copy(sl1[i], 1, Pos(#32, sl1[i]) - 1);
    sl.AddObject(sl1[i], TObject(Integer(StrToInt(S))));
  end;
  sl.CustomSort(Sortowanie);
  MyList1.Assign(sl);
  ListBox2.Count := MyList1.Count;

  sl.Free;
  sl1.Free;
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
  BreakProces := True;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
case Key of 
    '0'..'9',#8: else Key := Char(0);
end;
end;

end.

**plik 1**

abc cde efg
ddd fff rrr

**plik 2**

abc cde hhh
rty fff rry

*Wyjście:*
abc 2
cde 2
efg 1
ddd 1
fff 2
rrr 1
rry 1 

1 razy wystąpiło powtórzenie w rzędzie [5] => Powtórzenia liczb z sortowaniem pliki PLBS.txt Poz.: 1

1 5 1

{--------------------------------------------------------------------------
A very fast stringlist Quicksorting routine - many many times faster than
Delhpi's built in TStringlist.sort - even in spite of the double casts.
The whole routine sorts 100.000 words in about 1 sec (on a 650MHz machine (sic!)).

It is also much faster than using the TStringlist.Sorted := true property
while filling the stringlist. Set the sorted property to false and sort it using
this routine afterwards.

Copyright Hans J. Klarskov Mortensen 2004 - (h@hjkm.dk) Sorting routine
based on M. C. Kerman's book "Programming and Problem Solving
with Delphi", Pearsons Education, 2002.

If anyone can use this unit they're welcome. But I ask you to let
this copyright notice stay and that you don't pretend that you wrote it.

No warranty imaginable accepted. Use at your own risk.

(Language note: My native language is Danish. In this language "ord" means
"word" not ordinal.)

Usage : FastSortStList(YourStringlist);
-------------------------------------------------------------------------}
unit Quicksorting;

interface

uses
  ComCtrls, Classes, Windows, Sysutils;

type
  {This explains part of the speed! I wish I (really) knew why!
  If this declaration is placed in connection with the
  procedure the whole procedure is more than ten times slower.
  The reason may be that placing it here means that the array is
  created when the program loads - if it is declared "locally"
  it is not created until the procedure requests it.}
  OrdArray = array of string;

procedure FastSortStList(Stlist: TStringlist);

implementation

{------------ Standard hand coded quicksort ------------------------------}
{ The sorting is - as you can see - based on ANSI-values, thus it is case sensitive.
If case insensitivity is needed use ANSIUPPERCASE.

If the string variables indicated are replaced by integer variables it'll
happily sort integers as well, but of course a StrToInt cast is needed.
--------------------------------------------------------------------------}

procedure Swap(var Value1, Value2: string);
var
  temp: string; //Integer;
begin
  temp := Value1;
  Value1 := Value2;
  Value2 := temp;
end;

function GetPIndex(lo, hi: Integer): Integer;
var
i : integer;
begin
  i := (lo+hi) div 2;
  GetPIndex := i;
end;

procedure Quicksort(low, high: Integer; var Ordliste: OrdArray);
var
  pivotIndex: Integer;
  pivotValue: string;
  left, right: Integer;
begin

  pivotIndex := GetPIndex(low, high);
  pivotValue := Ordliste[pivotIndex];

  left := low;
  right := high;
  repeat

    while ((left <= high) and (Ordliste[left] < pivotValue)) do
    begin
      Inc(left);
    end;

    while ((right >= low) and (pivotValue < Ordliste[right])) do
    begin
      Dec(right);
    end;
    if (left <= right) then
    begin
      Swap(Ordliste[left], Ordliste[right]);
      Inc(left);
      Dec(right);
    end;

  until (left > right);

  if (low < right) then
  begin
    Quicksort(low, right, Ordliste);
  end;

  if (left < high) then
  begin
    Quicksort(left, high, Ordliste);
  end;
end;
{-----------   End of Quicksort routines   -----------------------------}

{-----------   The Stringlist sorting routine with casts   -------------}

procedure FastSortStList(Stlist: TStringlist);
var
  SortArray: OrdArray;
  i, j: Integer;
begin
  //Cast Stringlist to an array
  setlength(sortArray, Stlist.count);
  for i := 0 to Stlist.count - 1 do
    SortArray[i] := Trim(Stlist.strings[i]);

  //Now sort
  QuickSort(Low(SortArray), High(SortArray), SortArray);

  //Recast
  for j := low(SortArray) to High(SortArray) do
    begin //Sometimes empty entries abound, get rid of them
    if StList.strings[j] <> '' then
    Stlist.Strings[j] := Sortarray[j];
    end;

  //Free the array
  SetLength(SortArray,0);
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Quicksorting;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    ListBox1: TListBox;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
 
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ZaladujListe : TStringList;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i, a : integer;
s1, s2 : string;
sl, sl1 : TStringList;
begin

FastSortStList(ZaladujListe);

sl := TStringList.Create;
sl1 := TStringList.Create;

ZaladujListe.Insert(0,'');

for i := ZaladujListe.Count -1 downto 1 do
begin
 s1 := ZaladujListe[i];
 s2 := ZaladujListe[i-1];

 if s1 = s2 then inc(a);
 if s1 = s2  then sl.Text := inttostr(a+1)+' razy wystąpiło powtórzenie wartości statystycznej '+ZaladujListe[i];
 if s1 <> s2 then sl.Text := inttostr(a+1)+' razy wystąpiło powtórzenie wartości statystycznej '+ZaladujListe[i];

 if s1 <> s2 then a := 0;
 if s1 <> s2 then sl1.Add(sl[sl.Count-1]);

 if i = 1 then break;

 //application.ProcessMessages;
end;
  ZaladujListe.Delete(0);

  ListBox1.Items.Text := sl1.Text;
  
  sl.free;
  sl1.free;
end;

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  
  ZaladujListe := TStringList.Create;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i, int : integer;
begin
  for I := 0 to 10000000 do
  begin

  int := 1 + Random(10);
  ZaladujListe.Add(IntToStr(int));
  end;
end;

end.