unit Receive;
{$M 50000, 8192}   {kell a quicksortnak sok verem, max log2(maxi) a veremmélység}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Gauges;

const
     verstring='v';{verziójel}
     ver=1.0;   {aktuális verziószám}
     minver=1.0;{felismert minimális verziószám}
     startstring='VEND##';{adatkezdő jel}
     endstring='V';{adatlezáró jel}
     fieldsep=',';{szeparátorjel}
     wildchar='*';{tetszőleges karakter jele}

type
    {rekordmezők megnevezése}
    Trecordfield=(TTELNUM, TDATE, TTIME, TLENGTH, TDEST, TPRICE, TCOUNTRY, TFORWARDED, TPRODUCT);
    Trelation=(LESS, EQUAL, MORE);
    Trecord=record  {Mezőhosszokat elég csak itt változtatni}
                  telnum: array[1..8] of char;
                  date: array[1..8] of char;
                  time: array[1..6] of char;
                  length: word;
                  dest: array[1..18] of char;
                  price: longint; {100-szoros ár}
                  country: array[1..5] of char;
                  forwarded: char;
                  product: array[1..5] of char;
    end;
    Prec=^Trecord;

    TFilter=class
    private
          result: boolean;
    protected
          data: Trecord;
          function eval: boolean; virtual;
    public
          constructor Create;
          function filter(var rec: Trecord): boolean;
          function lastresult: boolean;
          function lastrecord: TRecord;
    end;

    TInverseFilter=class(TFilter)
    private
           afilter: TFilter;
           function eval: boolean; override;
    public
          constructor Create(afilter: TFilter);
          destructor Destroy; override;
    end;

    TAndOrFilter=class(TFilter)
    private
           tags: TList;
           andor: boolean; {igaz, ha and}
           function eval: boolean; override;
    public
          constructor Create(andor:boolean);
          destructor Destroy; override;
          procedure add(filter: TFilter);
    end;

    TSimpleFilter=class(TFilter)
    private
           value: string;
           lvalue: longint;
           field: TRecordField;
           op: Trelation;
           function eval: boolean; override;
    public
          constructor Create(field: TRecordfield; op: Trelation; value: string);
    end;

    TMaskFilter=class(TFilter)
    {Maszzknál rövidebb szöveget elutasít, maszknak megfelelő kezdetű stringeket fogad el}
    private
           mask: string;
           field: TRecordField;
           function eval: boolean; override;
    public
          constructor Create(field: TRecordfield; mask: string);
    end;

    TRangeFilter=class(TFilter)
    private
           value1, value2: string;
           lvalue1, lvalue2: longint;
           field: TRecordField;
           function eval: boolean; override;
    public
          constructor Create(field: TRecordfield; value1, value2: string);
    end;

    TGroupFilter=class(TFilter)
    private {nem csinál másolatot a listáról}
           values: TStrings;
           field: TRecordField;
           function eval: boolean; override;
    public
          constructor Create(field: TRecordfield; values: TStrings);
    end;

    TSort = class
    private
           field: TRecordField;
           ascend: boolean; {igaz, ha növekvő a sorrend}
           next: TSort;
    public
          constructor Create(field: TRecordfield; ascend: boolean);
          destructor Destroy; override;
          procedure add(next: TSort);  {Sorrendben hozzáveszi az alrendező mezőket}
          function inorder(r1, r2: prec): boolean; {megfelelő sorrendben van-e a két paraméter (=-ség esetén igazat ad)}
          function getfield(var field: TRecordfield): boolean; {visszaadja a szűrés mezőjét, tru, ha van még mező a sorrendben}
    end;

  TfrmReceive = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    CloseBitBtn: TBitBtn;
    AbortBitBtn: TBitBtn;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel3: TPanel;
    Gauge: TGauge;
    Memo: TMemo;
    procedure FilterTestButtonClick(Sender: TObject);
    procedure testconvertButtonClick(Sender: TObject);
    procedure AbortBitBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    sorting, running, aborting: boolean;
    Buf: array[1..8*4096] of Char;
    xrec, rec: TRecord; {quicksortból kitranszformált változók a stackfoglalás minimalizálásáért}
    x, y: Prec;
    i: longint;
  public
    { Public declarations }
    procedure receive;
    procedure sort(filename:string; sorts: TList; indexdir: string);
    procedure log(s: string); {logolás timestamppel}
    procedure start;
    procedure stop;
    function isrunning: boolean;
    function aborted: boolean;
  end;

var
  frmReceive: TfrmReceive;

function pad(s: string; b: byte): string; {string balraigazítása}
function crop(s: string): string; {szélső space-k levágása}
procedure convertrecord(s: string; var rec: TRecord); {szövegrekord átvevése}
function deconvertrecord(var rec: TRecord; cropped: boolean): string; {Rekord szövegsorrá alakítása}

implementation

{$R *.DFM}

function pad(s: string; b: byte): string; {string jobbraigazítása}
begin
     if length(s)>b then s[0]:=char(b)
     else while length(s)<b do s:=s+' ';
     result:=s;
end;

function crop(s: string): string;
begin
     while (s<>'') and (s[1]=' ') do delete(s, 1, 1);
     while (s<>'') and (s[length(s)]=' ') do delete(s, length(s), 1);
     result:=s;
end;

function deconvertrecord(var rec: TRecord; cropped: boolean): string;
var s: string;
begin
     s:='';
     with rec do begin
          if cropped then s:=s+crop(telnum)
          else s:=s+telnum;
          s:=s+fieldsep;
          if cropped then s:=s+crop(date)
          else s:=s+date;
          s:=s+fieldsep;
          if cropped then s:=s+crop(time)
          else s:=s+time;
          s:=s+fieldsep;
          if cropped then s:=s+inttostr(length)
          else s:=s+format('%*d', [5, length]);
          s:=s+fieldsep;
          if cropped then s:=s+crop(dest)
          else s:=s+dest;
          s:=s+fieldsep;
          if cropped then s:=s+floattostrf(price/100, ffFixed, 10, 2)
          else s:=s+format('%10.2f', [price/100]);
          s:=s+fieldsep;
          if cropped then s:=s+crop(country)
          else s:=s+country;
          s:=s+fieldsep+forwarded+fieldsep;
          if cropped then s:=s+crop(product)
          else s:=s+product;
     end;
     result:=s;
end;

constructor TFilter.Create;
begin
     result:=true;
end;

function TFilter.filter(var rec: Trecord): boolean;
begin
     data:=rec;
     result:=eval;
     self.result:=result;
end;

function TFilter.eval: boolean;
begin
     result:=true;
end;

function TFilter.lastresult: boolean;
begin
     result:=self.result;
end;

function TFilter.lastrecord: TRecord;
begin
     result:=data;
end;

constructor TInverseFilter.Create(afilter: TFilter);
begin
     inherited Create;
     self.afilter:=afilter;
end;

destructor TInverseFilter.Destroy;
begin
     afilter.free;
     inherited destroy;
end;

function TInverseFilter.eval: boolean;
begin
     result:=not afilter.filter(data);
     self.result:=result;
end;

constructor TAndOrFilter.Create(andor: boolean);
begin
     inherited Create;
     tags:=TList.create;
     self.andor:=andor;
end;

destructor TAndOrFilter.Destroy;
var i: integer;
begin
     for i:=0 to tags.count-1 do TFilter(tags[i]).free;
     tags.free;
     inherited destroy;
end;

function TAndOrFilter.eval: boolean;
var f: TFilter;
    i: integer;
begin
     i:=tags.count;
     while (i>0) and (TFilter(tags[pred(i)]).filter(data)=andor) do dec(i);
     if i=0 then result:=andor or (tags.count=0)
     else result:=not(andor);
end;

procedure TAndOrFilter.add(filter: TFilter);
begin
     tags.add(filter);
end;

constructor TSimpleFilter.Create(field: TRecordfield; op: Trelation; value: string);
var rec: TRecord;
begin
     inherited Create;
     self.field:=field;
     self.op:=op;
     case field of
          TTELNUM: self.value:=pad(value, sizeof(rec.telnum));
          TDATE: self.value:=pad(value, sizeof(rec.date));
          TTIME: self.value:=pad(value, sizeof(rec.time));
          TLENGTH, TPRICE: lvalue:=strtoint(value);
          TDEST: self.value:=pad(value, sizeof(rec.dest));
          TCOUNTRY: self.value:=pad(value, sizeof(rec.country));
          TPRODUCT: self.value:=pad(value, sizeof(rec.product));
     else
          self.value:=value;
     end;
end;

function TSimpleFilter.eval: boolean;
begin
     case field of
          TTELNUM: case op of
                        LESS: result:=data.telnum<value;
                        EQUAL: result:=data.telnum=value;
                        MORE: result:=data.telnum>value;
                   end;
          TDATE: case op of
                      LESS: result:=data.date<value;
                      EQUAL: result:=data.date=value;
                      MORE: result:=data.date>value;
                 end;
          TTIME: case op of
                      LESS: result:=data.time<value;
                      EQUAL: result:=data.time=value;
                      MORE: result:=data.time>value;
                 end;
          TLENGTH: case op of
                        LESS: result:=data.length<lvalue;
                        EQUAL: result:=data.length=lvalue;
                        MORE: result:=data.length>lvalue;
                   end;
          TDEST: case op of
                      LESS: result:=data.dest<value;
                      EQUAL: result:=data.dest=value;
                      MORE: result:=data.dest>value;
                 end;
          TPRICE: case op of
                       LESS: result:=data.price<lvalue;
                       EQUAL: result:=data.price=lvalue;
                       MORE: result:=data.price>lvalue;
                  end;
          TCOUNTRY: case op of
                         LESS: result:=data.country<value;
                         EQUAL: result:=data.country=value;
                         MORE: result:=data.country>value;
                    end;
          TFORWARDED: case op of
                           LESS: result:=data.forwarded<value;
                           EQUAL: result:=data.forwarded=value;
                           MORE: result:=data.forwarded>value;
                      end;
          TPRODUCT: case op of
                         LESS: result:=data.product<value;
                         EQUAL: result:=data.product=value;
                         MORE: result:=data.product>value;
                    end;
          else begin
               result:=true;
               exit;
          end;
     end;
end;

constructor TMaskFilter.Create(field: TRecordfield; mask: string);
var rec: TRecord;
begin
     inherited Create;
     self.field:=field;
     self.mask:=mask;
end;

function TMaskFilter.eval: boolean;
var s: string;
    b: byte;
begin
     case field of
          TTELNUM: s:=data.telnum;
          TDATE: s:=data.date;
          TTIME: s:=data.time;
          TDEST: s:=data.dest;
          TCOUNTRY: s:=data.country;
          TPRODUCT: s:=data.product;
          else begin
               result:=true;
               exit;
          end;
     end;
     b:=length(mask);
     if length(s)<b then begin
        result:=false;
        exit;
     end;
     while (b>0) and ((s[b]=mask[b]) or (mask[b]=wildchar)) do dec(b);
     result:=b=0;
end;

constructor TRangeFilter.Create(field: TRecordfield; value1, value2: string);
var b: byte;
    rec: TRecord;
begin
     inherited Create;
     self.field:=field;
     b:=0;
     case field of
          TTELNUM: b:=sizeof(rec.telnum);
          TDATE: b:=sizeof(rec.date);
          TTIME: b:=sizeof(rec.time);
          TDEST: b:=sizeof(rec.dest);
          TCOUNTRY: b:=sizeof(rec.country);
          TPRODUCT: b:=sizeof(rec.product);
          TLENGTH, TPRICE: begin
                   lvalue1:=strtoint(value1);
                   lvalue2:=strtoint(value2);
          end;
     else
          b:=1;
     end;
     if b>0 then begin
        self.value1:=pad(value1, b);
        self.value2:=pad(value2, b);
     end;
end;

function TRangeFilter.eval: boolean;
begin
     case field of
          TTELNUM: result:=(data.telnum>=value1) and (data.telnum<=value2);
          TDATE: result:=(data.date>=value1) and (data.date<=value2);
          TTIME: result:=(data.time>=value1) and (data.time<=value2);
          TLENGTH: result:=(data.length>=lvalue1) and (data.length<=lvalue2);
          TDEST: result:=(data.dest>=value1) and (data.dest<=value2);
          TPRICE: result:=(data.price>=lvalue1) and (data.price<=lvalue2);
          TPRODUCT: result:=(data.product>=value1) and (data.product<=value2);
          else begin
               result:=true;
               exit;
          end;
     end;
end;

constructor TGroupFilter.Create(field: TRecordfield; values: TStrings);
begin
     inherited Create;
     self.field:=field;
     self.values:=values;
end;

function TGroupFilter.eval: boolean;
var s: string;
begin
     case field of
          TTELNUM: s:=data.telnum;
          TDATE: s:=data.date;
          TTIME: s:=data.time;
          TDEST: s:=data.dest;
          TPRODUCT: s:=data.product;
          TCOUNTRY: s:=data.country;
          else begin
               result:=true;
               exit;
          end;
     end;
     result:=values.indexof(crop(s))>=0;
end;

procedure TfrmReceive.FilterTestButtonClick(Sender: TObject);
const rec: TRecord = (
                  telnum: '12345678';
                  date: '12345678';
                  time: '123456';
                  length: 0;
                  dest: '123456789012345678';
                  price: 0;
                  country: '123';
                  forwarded: '0';
                  product: '12345'
);
var
   inf: TInverseFilter;
   aof1, aof2: TAndOrFilter;
   sf: TSimpleFilter;
   mf: TMaskFilter;
   ts: TStringList;
begin
     aof1:=TAndOrFilter.Create(true);
     sf:=TSimpleFilter.Create(TFORWARDED, EQUAL, '0');
     aof1.add(sf);
     aof1.add(TMaskFilter.Create(TTIME, '1*3*5*'));
     aof2:=TAndOrFilter.create(false);
     aof2.add(TRangeFilter.Create(TLENGTH, '10000', '22222'));
     ts:=TStringList.Create;
     ts.add('123');
     aof2.add(TGroupFilter.create(TCOUNTRY, ts));
     aof1.add(aof2);
     inf:=TInverseFilter.Create(aof1);
     if inf.filter(rec) then showmessage('igen') else showmessage('nem');
     ts.free;
     inf.free;
end;

procedure convertrecord(s: string; var rec: TRecord);
  procedure fill(pcc: Pchar; s: string; b: byte);
  var pc: pchar;
  begin
       s:=pad(s, b);
       pc:=@s;
       inc(pc);
       move(pc^, pcc^, b);
  end;
var b: byte;
s2: string;
begin
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik a telefonszám mező!');
     fill(@rec.telnum, copy(s, 1, b-1), sizeof(rec.telnum));
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik a dátum mező!');
     fill(@rec.date, copy(s, 1, b-1), sizeof(rec.date));
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik az idő mező!');
     fill(@rec.time, copy(s, 1, b-1), sizeof(rec.time));
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik a hossz mező!');
     rec.length:=strtointdef(copy(s, 1, b-1), 0);
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik a hívott mező!');
     fill(@rec.dest, copy(s, 1, b-1), sizeof(rec.dest));
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik az ár mező!');
     rec.price:=round(strtofloat(copy(s, 1, b-1))*100);
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik az ország mező!');
     fill(@rec.country, copy(s, 1, b-1), sizeof(rec.country));
     delete(s, 1, b);
     b:=pos(fieldsep, s);
     if b=0 then raise Exception.Create('Hiányzik a forward mező!');
     rec.forwarded:=copy(s, 1, b-1)[1];
     delete(s, 1, b);
     fill(@rec.product, s, sizeof(rec.product));
end;

procedure TfrmReceive.testconvertButtonClick(Sender: TObject);
var rec: TRecord;
begin
     convertrecord(
     '20420234000,19960325,232036,461,0038661329470,605.60,,0,90022',
     rec);
end;

procedure TfrmReceive.Start;
begin
     gauge.progress:=0;
     running:=true;
     AbortBitbtn.enabled:=true;
     CloseBitBtn.enabled:=false;
     memo.lines.clear;
     aborting:=false;
end;

procedure TfrmReceive.Stop;
begin
     running:=false;
     CloseBitBtn.enabled:=true;
     AbortBitBtn.enabled:=false;
end;

function TfrmReceive.isrunning:boolean;
begin
     result:=running;
end;

function TfrmReceive.aborted:boolean;
begin
     result:=aborting;
end;

procedure TfrmReceive.AbortBitBtnClick(Sender: TObject);
begin
     aborting:=true;
     stop;
end;

procedure TfrmReceive.log(s: string);
  begin
       try
          memo.lines.add('['+datetimetostr(now)+'] '+s);
       except
          memo.lines[memo.lines.count-1]:='['+datetimetostr(now)+'] '+s;
       end;
  end;

procedure TfrmReceive.receive;
var
   y, m, w: word;
   s: string;
   tin, tout: textfile;
   FromF, ToF: file;
   NumRead, NumWritten: integer;
   byteread, lineread, totalbyte: longint;
   pc: pchar;
   copied: boolean;
   dout: file of TRecord;
   rec: TRecord;
begin
     if running or sorting then exit;
     decimalseparator:='.';
     stop;
     memo.lines.clear;
     if not OpenDialog.execute then begin
        close;
        exit;
     end;
     decodedate(now, y, m, w);
     if m<10 then s:='0'+inttostr(m)
     else s:=inttostr(m);
     SaveDialog.filename:='hv'+inttostr(y)+s+'.hv';
     if not SaveDialog.execute then begin
        close;
        exit;
     end;
     Savedialog.filename:=changefileext(Savedialog.filename, '.hv');
     copied:=false;
     if uppercase(extractfileext(Opendialog.filename))='.EXE' then try
        if extractfilepath(Opendialog.filename)<>extractfilepath(Savedialog.filename) then begin
           copied:=true;
           if showing then log(Opendialog.filename+' másolása '+extractfilepath(Savedialog.filename)+'-be');
           s:=OpenDialog.FileName;
           AssignFile(FromF, s);
           Reset(FromF, 1);
           s:=extractfilename(s);
           AssignFile(ToF, extractfilepath(SaveDialog.FileName)+s);
           Rewrite(ToF, 1);
           repeat
                 BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
                 BlockWrite(ToF, Buf, NumRead, NumWritten);
           until (NumRead = 0) or (NumWritten <> NumRead);
           CloseFile(FromF);
           CloseFile(ToF);
        end;
        s:=extractfilepath(Savedialog.filename)+extractfilename(Opendialog.filename);
        if showing then log(s+' kitömörítése');
        s:=s+#0;
        pc:=@s;
        inc(pc);
        w:=winexec(pc, SW_RESTORE);
        if w<32 then begin
           if copied then deletefile(s);
           abort;
        end;
        while getmoduleusage(w)<>0 do Application.processmessages;{Megvárom, míg befejeződik}
        if copied then deletefile(s);
        Opendialog.filename:=changefileext(Opendialog.filename, '.txt');
        Opendialog.filename:=extractfilepath(Savedialog.filename)+extractfilename(Opendialog.filename);
     except
        if showing then log('Kitömörítés nem sikerült!');
        exit;
     end;
     assignfile(tin, Opendialog.filename);
     if showing then log(Opendialog.filename+' megnyitása olvasásra');
     assignfile(fromf, Opendialog.filename);
     reset(fromf, 1);
     totalbyte:=filesize(fromf) div 100;
     if totalbyte=0 then totalbyte:=1;
     closefile(fromf);
     reset(tin);
     readln(tin, s);
     byteread:=length(s)+2;
     if copy(s, 1, length(verstring))<>verstring then begin
        closefile(tin);
        showmessage('Hibás kezdetű fájl!');
        if copied then deletefile(Opendialog.filename);
        exit;
     end;
     delete(s, 1, length(verstring));
     if (strtofloat(s)<minver) or (strtofloat(s)>ver) then begin
        closefile(tin);
        showmessage('Hibás verziójú fájl!');
        if copied then deletefile(Opendialog.filename);
        exit;
     end;
     s:=verstring+s;
     assignfile(tout, Savedialog.filename);
     if showing then log(Savedialog.filename+' megnyitása írásra');
     rewrite(tout);
     while not(eof(tin)) and (s<>startstring) do begin
           inc(byteread, length(s)+2);
           writeln(tout, s);
           readln(tin, s);
     end;
     inc(numread, length(s)+2);
     closefile(tout);
     readln(tin, s);
     if eof(tin) then begin
        closefile(tin);
        showmessage('Hiányoznak az adatok!');
        if copied then deletefile(Opendialog.filename);
        exit;
     end;
     assignfile(dout, Savedialog.filename+'d');
     rewrite(dout);
     start;
     if showing then log(Savedialog.filename+'d megnyitása írásra');
     lineread:=0;
     while running and not(eof(tin)) and (copy(s, 1, length(endstring))<>endstring) do begin
           inc(byteread, length(s)+2);
           if showing then if gauge.progress<byteread div totalbyte then gauge.progress:=byteread div totalbyte;
           Application.processmessages;
           inc(lineread);
           try
              convertrecord(s, rec);
              write(dout, rec);
              readln(tin, s);
           except
                 on e: exception do begin
                    if showing then log(inttostr(lineread)+'. adatsor hibás: '+e.message+' ('+s+')');
                    readln(tin, s);
                 end;
           end;
     end;
     closefile(tin);
     if copied then deletefile(Opendialog.filename);
     closefile(dout);
     if showing then log('Beolvasott sorok száma = '+inttostr(lineread));
     if running then begin
        if showing then gauge.progress:=100;
        if copy(s, 1, length(endstring))<>endstring then begin
           showmessage('Hiányzik az ellenőrző szám!');
           AbortBitbtn.click;
           exit;
        end;
        delete(s, 1, length(endstring));
        if s<>inttostr(lineread) then begin
           showmessage('Rossz az ellenőrző szám!');
           AbortBitbtn.click;
           exit;
        end;
     end else
         if showing then log('Betöltés megszakítva!');
     stop;
end;

procedure TfrmReceive.FormCreate(Sender: TObject);
begin
     running:=false;
     sorting:=false;
end;

procedure TfrmReceive.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
     AbortBitBtn.click;
     sorting:=false;
end;

constructor TSort.Create(field: TRecordfield; ascend: boolean);
begin
     self.field:=field;
     self.ascend:=ascend;
     next:=nil;
end;

destructor TSort.Destroy;
begin
     next.free;
     inherited Destroy;
end;

procedure TSort.add(next: TSort);
var ts: TSort;
begin
     ts:=self;
     while ts.next<>nil do ts:=ts.next;
     ts.next:=next;
end;

function TSort.inorder(r1, r2: prec): boolean;
begin
     case field of
          TTELNUM: if ascend then result:=r1^.telnum<=r2^.telnum
                   else result:=r1^.telnum>=r2^.telnum;
          TDATE: if ascend then result:=r1^.date<=r2^.date
                 else result:=r1^.date>=r2^.date;
          TTIME: if ascend then result:=r1^.time<=r2^.time
                 else result:=r1^.time>=r2^.time;
          TLENGTH: if ascend then result:=r1^.length<=r2^.length
                   else result:=r1^.length>=r2^.length;
          TDEST: if ascend then result:=r1^.dest<=r2^.dest
                 else result:=r1^.dest>=r2^.dest;
          TPRICE: if ascend then result:=r1^.price<=r2^.price
                  else result:=r1^.price>=r2^.price;
          TCOUNTRY: if ascend then result:=r1^.country<=r2^.country
                    else result:=r1^.country>=r2^.country;
          TFORWARDED: if ascend then result:=r1^.forwarded<=r2^.forwarded
                      else result:=r1^.forwarded>=r2^.forwarded;
          TPRODUCT: if ascend then result:=r1^.product<=r2^.product
                    else result:=r1^.product>=r2^.product;
          else begin
               result:=true;
          end;
     end;
     if result and (next<>nil) then {Többmezős szűrés}
        case field of
             TTELNUM:  if r1^.telnum=r2^.telnum then result:=next.inorder(r1, r2);
             TDATE: if r1^.date=r2^.date then result:=next.inorder(r1, r2);
             TTIME: if r1^.time=r2^.time then result:=next.inorder(r1, r2);
             TLENGTH: if r1^.length=r2^.length then result:=next.inorder(r1, r2);
             TDEST: if r1^.dest=r2^.dest then result:=next.inorder(r1, r2);
             TPRICE: if r1^.price=r2^.price then result:=next.inorder(r1, r2);
             TCOUNTRY: if r1^.country=r2^.country then result:=next.inorder(r1, r2);
             TFORWARDED: if r1^.forwarded=r2^.forwarded then result:=next.inorder(r1, r2);
             TPRODUCT: if r1^.product=r2^.product then result:=next.inorder(r1, r2);
     end;
end;

function TSort.getfield(var field: TRecordfield): boolean; {visszaadja a szűrés mezőjét, tru, ha van még mező a sorrendben}
begin
     result:=next<>nil;
     field:=self.field;
end;

procedure TfrmReceive.sort(filename:string; sorts: TList; indexdir: string);
var th: THandle;
    rp, rap: prec;
    din, dout, dtemp: file;{ of TRecord;}
    i, ii, iii, maxi: longint;
    srap, blockmax, readi: word;
    rec: TRecord;
    sort: TSort;
    fesu: boolean;

    function getprec(i: longint): prec;
    var s, o: longint;
    begin {i. elem indexe, elem nem lóghat át 64k határon}
         o:=(i mod blockmax)*sizeof(TRecord);
         s:=(i div blockmax)*selectorinc+srap;
         result:=Prec(ptr(s, o));
    end;
    procedure writebuff(ii: longint); {hány elemet kell kiírni}
    var rec: TRecord;
        pr: prec;
        neof: boolean;
        j, iiii: longint;
    begin
         if ii<=0 then exit;
         if showing then gauge.progress:=0;
         if fesu then begin  {Összefésülés}
            if showing then log(inttostr(filesize(dtemp))+' + '+inttostr(ii)+' rekord összefésülése');
            iii:=filesize(dtemp)+ii; i:=0;
            iiii:=iii div 100;
            if iiii<=0 then iiii:=1;
            neof:=not(eof(dtemp));
            blockread(dtemp, rec, 1);
            pr:=getprec(0);
            while (i<ii) and neof and (iii>0) do begin
                  if showing then if gauge.progress<100-(iii div iiii) then
                     gauge.progress:=100-(iii div iiii);
                  Application.processmessages;
                  if not running then abort;
                  if sort.inorder(@rec, pr) then begin
                     blockwrite(dout, rec, 1);
                     if eof(dtemp) then neof:=false
                     else blockread(dtemp, rec, 1);
                  end else begin
                      blockwrite(dout, pr^, 1);
                      inc(i);
                      pr:=getprec(i);
                  end;
                  dec(iii);
            end;
            if iii>0 then
               if i>=ii then begin  {tempfile-ból maradék hozzáfűzése}
                  blockwrite(dout, rec, 1);
                  while not(eof(dtemp)) do begin
                        if showing then if gauge.progress<100-(iii div iiii) then
                           gauge.progress:=100-(iii div iiii);
                        Application.processmessages;
                        if not running then abort;
                        blockread(dtemp, buf, sizeof(buf) div sizeof(TRecord), readi);
                        blockwrite(dout, buf, readi);
                        dec(iii, readi);
                  end;
               end else begin {memóból maradék kiírása}
                   j:=blockmax-(i mod blockmax);
                   if j+i>ii then j:=ii-i;
                   blockwrite(dout, getprec(i)^, j);
                   inc(i, j);
                   dec(iii, j);
                   while ii-i>=blockmax do begin
                         if showing then if gauge.progress<100-(iii div iiii) then
                            gauge.progress:=100-(iii div iiii);
                         Application.processmessages;
                         if not running then abort;
                         blockwrite(dout, getprec(i)^, blockmax);
                         inc(i, blockmax);
                         dec(iii, blockmax);
                   end;
                   if i<ii then begin
                      blockwrite(dout, getprec(i)^, ii-i);
                   end;
            end;
         end else begin    {Csak kiírás}
             if showing then log(inttostr(ii)+' rekord kiírása');
             i:=0; iii:=ii div 100;
             if iii<=0 then iii:=1;
             while ii>0 do begin
               if showing then if gauge.progress<i div iii then gauge.progress:=i div iii;
               Application.processmessages;
               if not running then abort;
               readi:=blockmax;
               if readi+i-1>maxi then readi:=maxi-i+1;
               if ii<readi then readi:=ii;
               blockwrite(dout, getprec(i)^, readi, readi);
               dec(ii, readi);
               if readi<=0 then raise EInOutError.Create('');
               inc(i, readi);
             end;
         end;
         if showing then gauge.progress:=0;
    end;
    procedure quicksort(p, r: longint);
    var j: longint;
    begin
         while p<r do begin
               Application.processmessages;
               if not running then abort;
               xrec:=getprec(p+round(random*(r-p)))^;  {véletlen strázsaszám=előrendezettség elrontása}
               i:=pred(p);
               j:=succ(r);
               while true do begin
                     repeat dec(j) until sort.inorder(getprec(j), @xrec);
                     repeat inc(i) until sort.inorder(@xrec, getprec(i));
                     if i<j then begin
                        x:=getprec(i);
                        y:=getprec(j);
                        rec:=x^;
                        x^:=y^;
                        y^:=rec;
                     end else break;
               end;
               if j-p>=r-j then begin {stackmélység minimalizálása=egyoldali rekurzió}
                  if succ(succ(j))<r then quicksort(succ(j), r) {kételemű eset kiszűrése}
                  else if succ(j)<r then begin {egyelemű eset kiszűrése}
                       x:=getprec(succ(j));
                       y:=getprec(r);
                       if not(sort.inorder(x, y)) then begin
                          rec:=x^;
                          x^:=y^;
                          y^:=rec;
                       end;
                  end;
                  r:=j;
               end else begin
                   if succ(p)<j then quicksort(p, j){kételemű eset kiszűrése}
                   else if p<j then begin{egyelemű eset kiszűrése}
                        x:=getprec(p);
                        y:=getprec(j);
                        if not(sort.inorder(x, y)) then begin
                           rec:=x^;
                           x^:=y^;
                           y^:=rec;
                        end;
                   end;
                   p:=succ(j);
               end;
               {quicksort(succ(j), r);break;}
         end;
    end;
    procedure rendezz(maxi: longint); {hány elemet kell rendezni}
    var w: word;
    begin
         if maxi<=0 then exit;
         for w:=1 to sorts.count do begin
             randomize;
             assignfile(dout, changefileext(indexdir+extractfilename(filename), '.'+inttostr(w)));
             if fesu then begin  {Összefésülés}
                deletefile(changefileext(indexdir+extractfilename(filename), '.idx'));
                renamefile(changefileext(indexdir+extractfilename(filename), '.'+inttostr(w)),
                           changefileext(indexdir+extractfilename(filename), '.idx'));
                if showing then log(changefileext(indexdir+extractfilename(filename), '.idx')+' olvasása');
                reset(dtemp, sizeof(TRecord));
             end;
             sort:=TSort(sorts[w-1]);
             if showing then log(inttostr(maxi)+' rekord rendezése');
             quicksort(0, pred(maxi));
             if showing then log(changefileext(indexdir+extractfilename(filename), '.'+inttostr(w))+' írása');
             try
                rewrite(dout, sizeof(TRecord));
                writebuff(maxi);
             finally
                closefile(dout);
             end;
             if fesu then begin
                closefile(dtemp);
                deletefile(changefileext(indexdir+extractfilename(filename), '.idx'));
             end;
         end;
         fesu:=true;
    end;
begin
     start;
     assignfile(dtemp, changefileext(indexdir+extractfilename(filename), '.idx'));
     assignfile(din, filename);
     if showing then log('File megnyitása: '+filename);
     reset(din, sizeof(TRecord));
     try
     sorting:=true;
     blockmax:=65536 mod sizeof(TRecord); {64k-n maradék}
     maxi:=(filesize(din) div (65536 div sizeof(TRecord)))*65536+
           (filesize(din) mod (65536 div sizeof(TRecord)))*sizeof(TRecord);
     th:=globalalloc(gmem_fixed, maxi);
     rap:=globallock(th);
     i:=-1;
     if globalsize(th)<maxi then {Egyben nem fér be a memóba}
     while i<>globalsize(th) do begin {maximális darab lefoglalása}
         i:=globalsize(th);
         globalunlock(th);
         globaldiscard(th);
         globalfree(th);
         Application.processmessages;
         th:=globalalloc(gmem_fixed, maxavail);
         rap:=globallock(th);
     end;
     srap:=seg(rap^);
     maxi:=(globalsize(th)-blockmax*(globalsize(th) shr 16)) div sizeof(TRecord);
     dec(maxi);
     blockmax:=65536 div sizeof(Trecord); {64k-n rekordok száma}
     if showing then log('Memóriafoglalás '+inttostr(maxi+1)+' rekordnak');
     ii:=filesize(din); i:=0;
     if showing then gauge.progress:=0;
     fesu:=false;
     if showing and (ii>0) then log(inttostr(ii)+' rekord olvasása');
     while ii>0 do begin
           Application.processmessages;
           if not running then abort;
           if showing then if gauge.progress<100-(ii*100 div filesize(din)) then
              gauge.progress:=100-(ii*100 div filesize(din));
           readi:=blockmax;
           if readi+i-1>maxi then readi:=maxi-i+1;
           if ii<readi then readi:=ii;
           blockread(din, getprec(i)^, readi, readi);
           dec(ii, readi);
           inc(i, readi);
           if i>maxi then begin
              rendezz(i);
              if showing and (ii>0) then log('Hátralévő '+inttostr(ii)+' rekord olvasása');
              i:=0;
           end;
     end;
     rendezz(i);
     if showing then begin
        gauge.progress:=100;
        log('--- Kész ---');
     end;
     except
           on e:EInOutError do begin
              log('A lemez betelt!');
              aborting:=true;
           end;
           on e:exception do
              log('Rendezés megszakadt!');
     end;
     sorting:=false;
     globalunlock(th);
     globaldiscard(th);
     globalfree(th);
     closefile(din);
     stop;
end;

end.