home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 January / Chip_1999-01_cd.bin / zkuste / delphi / D4 / MRECSORT.ZIP / mwFixedRecSort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-16  |  19.4 KB  |  775 lines

  1. {+--------------------------------------------------------------------------+
  2.  | Unit:        mwFixedRecSort
  3.  | Created:     12.97 - 9.98
  4.  | Author:      Martin Waldenburg
  5.  | Copyright    1997, all rights reserved.
  6.  | Description: A buffered sorter for an unlimmited amount of records with a fixed
  7.  |              length using a three-way merge for memory and a buffered
  8.  |              multi-way merge  for files.
  9.  |              The multi-way merge is the same as in mSor.
  10.  | Version:     1.5
  11.  | Status       FreeWare
  12.  | It's provided as is, without a warranty of any kind.
  13.  | You use it at your own risc.
  14.  | E-Mail me at Martin.Waldenburg@t-online.de
  15.  +--------------------------------------------------------------------------+}
  16.  
  17.  
  18. unit mwFixedRecSort;
  19.  
  20. interface
  21.  
  22. uses
  23.   Windows,
  24.   SysUtils,
  25.   Classes;
  26.  
  27. type
  28.   TmSorCompare=function(Item1, Item2: Pointer): Integer;
  29.  
  30.   TMergeCompare=function(Item1, Item2: Pointer): Integer;
  31.   PMergeArray=^TMergeArray;
  32.   TMergeArray=array[0..0]of Pointer;
  33.  
  34. { TSub3Array defines the boundaries of a SubArray and determines if
  35.   the SubArray is full or not.
  36.   The MergeSort Algorithm is easier readable with this class.}
  37.   TSub3Array=class(TObject)
  38.   private
  39.     FMax: LongInt;
  40.   protected
  41.   public
  42.     FLeft: LongInt; { - Initialized to 0. }
  43.     FRight: LongInt; { - Initialized to 0. }
  44.     Full: Boolean;
  45.     constructor Create(MaxValue: LongInt);
  46.     destructor Destroy; override;
  47.     procedure Init(LeftEnd, RightEnd: LongInt);
  48.     procedure Next;
  49.   end; { TSub3Array }
  50.  
  51. { TM3Array class }
  52.   TM3Array=class(TObject)
  53.   private
  54.     FLeftArray, FMidArray, FRightArray: TSub3Array;
  55.     FM3Array, TempArray, SwapArray: PMergeArray;
  56.     FCount: Integer;
  57.     fCapacity: Integer;
  58.     procedure SetCapacity(NewCapacity: Integer);
  59.     procedure Expand;
  60.   protected
  61.     function Get(Index: Integer): Pointer;
  62.     procedure Put(Index: Integer; Item: Pointer);
  63.     procedure Merge(SorCompare: TMergeCompare);
  64.   public
  65.     destructor Destroy; override;
  66.     function Add(Item: Pointer): Integer;
  67.     procedure Clear;
  68.     function Last: Pointer;
  69.     procedure MergeSort(SorCompare: TMergeCompare);
  70.     procedure QuickSort(SorCompare: TMergeCompare);
  71.     property Count: Integer read FCount write FCount;
  72.     property Items[Index: Integer]: Pointer read Get write Put; default;
  73.     property M3Array: PMergeArray read FM3Array;
  74.     property Capacity: Integer read fCapacity write SetCapacity;
  75.   published
  76.   end; { TM3Array }
  77.  
  78.   TmSorIO=class(TObject)
  79.   private
  80.     IOStream: TFileStream;
  81.     fFilledSize: Longint;
  82.     fBufferSize: LongInt;
  83.     fBufferPos: LongInt;
  84.     fBuffer: Pointer;
  85.     fNeedFill: Boolean;
  86.     fEof: Boolean;
  87.     fFileEof: Boolean;
  88.     FRecCount: Cardinal;
  89.     fSize: Longint;
  90.     fFilePos: LongInt;
  91.     fDataLen: Longint;
  92.     procedure AllocBuffer(NewValue: Longint);
  93.   protected
  94.   public
  95.     constructor create(Stream: TFileStream; DataLen, BuffSize: Integer);
  96.     destructor destroy; override;
  97.     procedure FillBuffer;
  98.     function ReadData: Pointer;
  99.     procedure WriteData(Var NewData);
  100.     procedure FlushBuffer;
  101.     property Eof: Boolean read fEof;
  102.     property RecCount: Cardinal read FRecCount;
  103.     property Size: Longint read fSize;
  104.     property DataLen: Longint read fDataLen;
  105.     property FilePos: Longint read fFilePos;
  106.   published
  107.   end; { TmSorIO }
  108.  
  109. Type
  110.   TmMergePart=class(TObject)
  111.   private
  112.     fPartStream: TFileStream;
  113.     PartFilePos: LongInt;
  114.     RecsToRead: LongInt;
  115.     RecsReaded: LongInt;
  116.     fBufferSize: LongInt;
  117.     fBufferPos: LongInt;
  118.     fBuffer: Pointer;
  119.     fNeedFill: Boolean;
  120.     fEof: Boolean;
  121.     FRecCount: Cardinal;
  122.     fDataLen: Longint;
  123.     fData: Pointer;
  124.     fNumber: Integer;
  125.     procedure AllocBuffer(NewValue: Longint);
  126.     procedure FillBuffer;
  127.   protected
  128.   public
  129.     constructor create(Stream: TFileStream; FilePos, DataLen, Count, aNumber:
  130.       LongInt);
  131.     destructor destroy; override;
  132.     procedure next;
  133.     procedure Init;
  134.     property Eof: Boolean read fEof;
  135.     property Data: Pointer read fData;
  136.     property Number: Integer read fNumber;
  137.   published
  138.   end; { TmMergePart }
  139.  
  140. type
  141.   TFixRecSort=class(TObject)
  142.   private
  143.     FParts: TList;
  144.     ReadStream: TFileStream;
  145.     MergeStream: TFileStream;
  146.     WriteStream: TFileStream;
  147.     Reader: TmSorIo;
  148.     Writer: TmSorIo;
  149.     FRecordLen: Integer;
  150.     SorList: TM3Array;
  151.     SorFileName: String;
  152.     TempFileName: String;
  153.     fStable: Boolean;
  154.     procedure InitMerge;
  155.     procedure Merge;
  156.     procedure LooserSort;
  157.     procedure CalculateBuffers;
  158.   protected
  159.   public
  160.     constructor Create(RecLen: Integer);
  161.     destructor Destroy; override;
  162.     procedure Start(InFile, OutFile: String; Compare: TmSorCompare);
  163.     property Stable: Boolean read fStable write fStable;
  164.   end; { TFixRecSort }
  165.  
  166. var
  167.   SorCompare: TmSorCompare;
  168.   ReadBuffSize: LongInt;
  169.   WriteBuffSize: LongInt;
  170.   PartBuffSize: LongInt;
  171.  
  172. implementation
  173. uses Unit1;
  174.  
  175. constructor TSub3Array.Create(MaxValue: LongInt);
  176. begin
  177.   FLeft:=0;
  178.   FRight:=0;
  179.   Full:=False;
  180.   FMax:=MaxValue;
  181. end; { Create }
  182.  
  183. procedure TSub3Array.Init(LeftEnd, RightEnd: LongInt); { public }
  184. begin
  185.   FLeft:=LeftEnd;
  186.   FRight:=RightEnd;
  187.   if FLeft>FMax then Full:=False else
  188.   begin
  189.     Full:=True;
  190.     if FRight>FMax then FRight:=FMax;
  191.   end;
  192. end; { Init }
  193.  
  194. procedure TSub3Array.Next;
  195. begin
  196.   inc(FLeft);
  197.   if FLeft>FRight then Full:=False;
  198. end; { Next }
  199.  
  200. destructor TSub3Array.Destroy;
  201. begin
  202.   inherited Destroy;
  203. end; { Destroy }
  204.  
  205. { TM3Array }
  206. destructor TM3Array.Destroy;
  207. begin
  208.   Clear;
  209.   inherited Destroy;
  210. end;
  211.  
  212. function TM3Array.Add(Item: Pointer): Integer;
  213. begin
  214.   Result:=FCount;
  215.   if Result=FCapacity then Expand;
  216.   FM3Array[Result]:=Item;
  217.   Inc(FCount);
  218. end;
  219.  
  220. procedure TM3Array.Expand;
  221. begin
  222.   SetCapacity(FCapacity+8192);
  223. end;
  224.  
  225. procedure TM3Array.SetCapacity(NewCapacity: Integer);
  226. begin
  227.   FCapacity:=NewCapacity;
  228.   ReallocMem(FM3Array, FCapacity*4);
  229. end;
  230.  
  231. procedure TM3Array.Clear;
  232. begin
  233.   FCount:=0;
  234.   ReallocMem(TempArray, 0);
  235.   ReallocMem(FM3Array, 0);
  236.   FCapacity:=0;
  237. end;
  238.  
  239. function TM3Array.Get(Index: Integer): Pointer;
  240. begin
  241.   Result:=FM3Array[Index];
  242. end;
  243.  
  244. function TM3Array.Last: Pointer;
  245. begin
  246.   Result:=Get(FCount-1);
  247. end;
  248.  
  249. procedure TM3Array.Put(Index: Integer; Item: Pointer);
  250. begin
  251.   FM3Array[Index]:=Item;
  252. end;
  253.  
  254. { Based on a non-recursive QuickSort from the SWAG-Archive.
  255.   ( TV Sorting Unit by Brad Williams ) }
  256. procedure TM3Array.QuickSort(SorCompare: TMergeCompare);
  257. var
  258.   Left, Right, SubArray, SubLeft, SubRight: LongInt;
  259.   Temp, Pivot: Pointer;
  260.   Stack: array[1..32]of record First, Last: LongInt;
  261.   end;
  262. begin
  263.   SubArray:=1;
  264.   Stack[SubArray].First:=0;
  265.   Stack[SubArray].Last:=Count-1;
  266.   repeat
  267.     Left:=Stack[SubArray].First;
  268.     Right:=Stack[SubArray].Last;
  269.     Dec(SubArray);
  270.     repeat
  271.       SubLeft:=Left;
  272.       SubRight:=Right;
  273.       Pivot:=FM3Array[(Left+Right)shr 1];
  274.       repeat
  275.         while SorCompare(FM3Array[SubLeft], Pivot)<0 do Inc(SubLeft);
  276.         while SorCompare(FM3Array[SubRight], Pivot)>0 do Dec(SubRight);
  277.         IF SubLeft<=SubRight then
  278.         begin
  279.           Temp:=FM3Array[SubLeft];
  280.           FM3Array[SubLeft]:=FM3Array[SubRight];
  281.           FM3Array[SubRight]:=Temp;
  282.           Inc(SubLeft);
  283.           Dec(SubRight);
  284.         end;
  285.       until SubLeft>SubRight;
  286.       IF SubLeft<Right then
  287.       begin
  288.         Inc(SubArray);
  289.         Stack[SubArray].First:=SubLeft;
  290.         Stack[SubArray].Last:=Right;
  291.       end;
  292.       Right:=SubRight;
  293.     until Left>=Right;
  294.   until SubArray=0;
  295. end; { QuickSort }
  296.  
  297. {This is a three way merge routine.
  298.  Unfortunately the " Merge " routine needs additional memory}
  299. procedure TM3Array.Merge(SorCompare: TMergeCompare);
  300. var
  301.   TempPos: integer;
  302. begin
  303.   TempPos:=FLeftArray.FLeft;
  304.   while(FLeftArray.Full)and(FMidArray.Full)and(FRightArray.Full)do{Main Loop}
  305.   begin
  306.     if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft])<=0 then
  307.     begin
  308.       if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FRightArray.FLeft])<=0
  309.         then
  310.       begin
  311.         TempArray[TempPos]:=FM3Array[FLeftArray.FLeft];
  312.         FLeftArray.Next;
  313.       end
  314.       else
  315.       begin
  316.         TempArray[TempPos]:=FM3Array[FRightArray.FLeft];
  317.         FRightArray.Next;
  318.       end;
  319.     end
  320.     else
  321.     begin
  322.       if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft])<=0
  323.         then
  324.       begin
  325.         TempArray[TempPos]:=FM3Array[FMidArray.FLeft];
  326.         FMidArray.Next;
  327.       end
  328.       else
  329.       begin
  330.         TempArray[TempPos]:=FM3Array[FRightArray.FLeft];
  331.         FRightArray.Next;
  332.       end;
  333.     end;
  334.     inc(TempPos);
  335.   end;
  336.  
  337.   while(FLeftArray.Full)and(FMidArray.Full)do
  338.   begin
  339.     if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FMidArray.FLeft])<=0 then
  340.     begin
  341.       TempArray[TempPos]:=FM3Array[FLeftArray.FLeft];
  342.       FLeftArray.Next;
  343.     end
  344.     else
  345.     begin
  346.       TempArray[TempPos]:=FM3Array[FMidArray.FLeft];
  347.       FMidArray.Next;
  348.     end;
  349.     inc(TempPos);
  350.   end;
  351.  
  352.   while(FMidArray.Full)and(FRightArray.Full)do
  353.   begin
  354.     if SorCompare(FM3Array[FMidArray.FLeft], FM3Array[FRightArray.FLeft])<=0 then
  355.     begin
  356.       TempArray[TempPos]:=FM3Array[FMidArray.FLeft];
  357.       FMidArray.Next;
  358.     end
  359.     else
  360.     begin
  361.       TempArray[TempPos]:=FM3Array[FRightArray.FLeft];
  362.       FRightArray.Next;
  363.     end;
  364.     inc(TempPos);
  365.   end;
  366.  
  367.   while(FLeftArray.Full)and(FRightArray.Full)do
  368.   begin
  369.     if SorCompare(FM3Array[FLeftArray.FLeft], FM3Array[FRightArray.FLeft])<=0
  370.       then
  371.     begin
  372.       TempArray[TempPos]:=FM3Array[FLeftArray.FLeft];
  373.       FLeftArray.Next;
  374.     end
  375.     else
  376.     begin
  377.       TempArray[TempPos]:=FM3Array[FRightArray.FLeft];
  378.       FRightArray.Next;
  379.     end;
  380.     inc(TempPos);
  381.   end;
  382.  
  383.   while FLeftArray.Full do{ Copy Rest of First Sub3Array }
  384.   begin
  385.     TempArray[TempPos]:=FM3Array[FLeftArray.FLeft];
  386.     inc(TempPos); FLeftArray.Next;
  387.   end;
  388.  
  389.   while FMidArray.Full do{ Copy Rest of Second Sub3Array }
  390.   begin
  391.     TempArray[TempPos]:=FM3Array[FMidArray.FLeft];
  392.     inc(TempPos); FMidArray.Next;
  393.   end;
  394.  
  395.   while FRightArray.Full do{ Copy Rest of Third Sub3Array }
  396.   begin
  397.     TempArray[TempPos]:=FM3Array[FRightArray.FLeft];
  398.     inc(TempPos); FRightArray.Next;
  399.   end;
  400.  
  401. end; { Merge }
  402.  
  403. {Non-recursive Mergesort.
  404.  Very fast, if enough memory available.
  405.  The number of comparisions used is nearly optimal, about 3/4 of QuickSort.
  406.  If comparision plays a very more important role than exchangement,
  407.  it outperforms QuickSort in any case.
  408.  ( Large keys in pointer arrays, for example text with few short lines. )
  409.  From all Algoritms with O(N lg N) it's the only stable, meaning it lefts
  410.  equal keys in the order of input. This may be important in some cases. }
  411. procedure TM3Array.MergeSort(SorCompare: TMergeCompare);
  412. var
  413.   a, b, c, N, todo: LongInt;
  414. begin
  415.   ReallocMem(TempArray, FCount*4);
  416.   FLeftArray:=TSub3Array.Create(FCount-1);
  417.   FMidArray:=TSub3Array.Create(FCount-1);
  418.   FRightArray:=TSub3Array.Create(FCount-1);
  419.   N:=1;
  420.   repeat
  421.     todo:=0;
  422.     repeat
  423.       a:=todo;
  424.       b:=a+N;
  425.       c:=b+N;
  426.       todo:=C+N;
  427.       FLeftArray.Init(a, b-1);
  428.       FMidArray.Init(b, c-1);
  429.       FRightArray.Init(c, todo-1);
  430.       Merge(SorCompare);
  431.     until todo>=Fcount;
  432.     SwapArray:=FM3Array; {Alternating use of the arrays.}
  433.     FM3Array:=TempArray;
  434.     TempArray:=SwapArray;
  435.     N:=N+N+N;
  436.   until N>=Fcount;
  437.   FLeftArray.Free;
  438.   FMidArray.Free;
  439.   FRightArray.Free;
  440.   ReallocMem(TempArray, 0);
  441. end; { MergeSort }
  442.  
  443. function StableCompare(P1, P2: Pointer): Integer;
  444. begin
  445.   Result:=SorCompare(TmMergePart(P1).Data, TmMergePart(P2).Data);
  446.   if Result=0 then
  447.   begin
  448.     if TmMergePart(P1).Number<TmMergePart(P2).Number then Result:=-1;
  449.     if TmMergePart(P1).Number>TmMergePart(P2).Number then Result:=1;
  450.   end;
  451. end; { StableCompare }
  452.  
  453. constructor TmSorIO.create(Stream: TFileStream; DataLen, BuffSize: Integer);
  454. begin
  455.   IOStream:=Stream;
  456.   FSize:=IOStream.Size;
  457.   FDataLen:=DataLen;
  458.   fBufferSize:=BuffSize;
  459.   FRecCount:=BuffSize Div DataLen;
  460.   fBufferSize:=DataLen*FRecCount;
  461.   fNeedFill:=True;
  462.   fEof:=False;
  463.   fFileEof:=False;
  464.   AllocBuffer(fBufferSize);
  465.   fBufferPos:=0;
  466. end; { create }
  467.  
  468. destructor TmSorIO.destroy;
  469. begin
  470.   ReallocMem(fBuffer, 0);
  471.   inherited destroy;
  472. end; { destroy }
  473.  
  474. procedure TmSorIO.AllocBuffer(NewValue: Longint);
  475. begin
  476.   fFilledSize:=NewValue;
  477.   ReallocMem(fBuffer, NewValue);
  478. end; { SetBufferSize }
  479.  
  480. procedure TmSorIO.FillBuffer;
  481. var
  482.   Readed: LongInt;
  483. begin
  484.   Readed:=IOStream.Read(FBuffer^, fBufferSize);
  485.   fFilePos:=fFilePos+Readed;
  486.   if fFilePos=fSize then fFileEof:=True else fFileEof:=False;
  487.   fBufferPos:=0;
  488.   fFilledSize:=Readed;
  489.   fNeedFill:=False;
  490. end; { FillBuffer }
  491.  
  492. function TmSorIO.ReadData: Pointer;
  493. begin
  494.   fEof:=False;
  495.   if fNeedFill then FillBuffer;
  496.   Result:=Pointer(Integer(fBuffer)+fBufferPos);
  497.   inc(fBufferPos, fDataLen);
  498.   if fBufferPos>=fFilledSize then
  499.   begin
  500.     fNeedFill:=True;
  501.     if FFileEof then FEof:=True;
  502.   end;
  503. end; { ReadData }
  504.  
  505. procedure TmSorIO.WriteData(Var NewData);
  506. var
  507.   Pos: LongInt;
  508. begin
  509.   if(fBufferPos>=0)and(Pointer(NewData)<>nil)then
  510.   begin
  511.     Pos:=fBufferPos+fDataLen;
  512.     if Pos>0 then
  513.     begin
  514.       if Pos>=FBufferSize then
  515.       begin
  516.         FlushBuffer;
  517.       end;
  518.       Move(NewData, Pointer(LongInt(fBuffer)+fBufferPos)^, fDataLen);
  519.       inc(fBufferPos, fDataLen);
  520.       inc(fFilePos, fDataLen);
  521.     end;
  522.   end;
  523. end; { WriteData }
  524.  
  525. procedure TmSorIO.FlushBuffer;
  526. begin
  527.   IOStream.Write(fBuffer^, fBufferPos);
  528.   fBufferPos:=0;
  529. end; { FlushBuffer }
  530.  
  531. constructor TmMergePart.create(Stream: TFileStream; FilePos, DataLen, Count,
  532.   aNumber: LongInt);
  533. begin
  534.   fPartStream:=Stream;
  535.   PartFilePos:=FilePos;
  536.   RecsToRead:=Count;
  537.   RecsReaded:=0;
  538.   FNumber:=aNumber;
  539.   FDataLen:=DataLen;
  540.   FRecCount:=PartBuffSize div DataLen;
  541.   fBufferSize:=DataLen*FRecCount;
  542.   fNeedFill:=True;
  543.   fEof:=False;
  544.   fBufferPos:=0;
  545. end; { create }
  546.  
  547. destructor TmMergePart.destroy;
  548. begin
  549.   ReallocMem(fBuffer, 0);
  550.   inherited destroy;
  551. end; { destroy }
  552.  
  553. procedure TmMergePart.AllocBuffer(NewValue: Longint);
  554. begin
  555.   ReallocMem(fBuffer, NewValue);
  556. end; { SetBufferSize }
  557.  
  558. procedure TmMergePart.FillBuffer;
  559. var
  560.   Readed: LongInt;
  561. begin
  562.   FPartStream.Position:=PartFilePos;
  563.   Readed:=FPartStream.Read(FBuffer^, fBufferSize);
  564.   PartFilePos:=PartFilePos+Readed;
  565.   if Readed=0 then FEof:=True;
  566.   fBufferPos:=0;
  567.   fNeedFill:=False;
  568. end; { FillBuffer }
  569.  
  570. procedure TmMergePart.Init;
  571. begin
  572.   AllocBuffer(fBufferSize);
  573.   next;
  574. end; { Init }
  575.  
  576. procedure TmMergePart.next;
  577. begin
  578.   fEof:=False;
  579.   if fNeedFill then FillBuffer;
  580.   fData:=Pointer(Integer(fBuffer)+fBufferPos);
  581.   inc(fBufferPos, fDataLen);
  582.   inc(RecsReaded);
  583.   if fBufferPos>=fBufferSize then fNeedFill:=True;
  584.   if RecsReaded=RecsToRead then FEof:=True;
  585. end; { Read }
  586.  
  587. constructor TFixRecSort.Create(RecLen: Integer);
  588. begin
  589.   inherited Create;
  590.   FRecordLen:=RecLen;
  591. end; { Create }
  592.  
  593. destructor TFixRecSort.Destroy;
  594. begin
  595.   inherited Destroy;
  596. end; { Destroy }
  597.  
  598. procedure TFixRecSort.InitMerge;
  599. var
  600.   I: Integer;
  601. begin
  602.   I:=0;
  603.   while I<FParts.Count do
  604.   begin
  605.     TmMergePart(FParts[I]).Init;
  606.     inc(I);
  607.   end;
  608.   if FParts.Count>1 then FParts.Sort(StableCompare);
  609. end; { InitMerge }
  610.  
  611. { Similar to the Tree of Looser, but not as effective}
  612. procedure TFixRecSort.LooserSort;
  613. var
  614.   First, Last, I: Integer;
  615.   Larger: ByteBool;
  616. begin
  617.   if FParts.Count>1 then
  618.   begin
  619.     First:=1;
  620.     Last:=FParts.Count-1;
  621.     while First<=Last do
  622.     begin
  623.       I:=(First+Last)shr 1;
  624.       Case StableCompare(FParts[0], FParts[I])<=0 of
  625.         True:
  626.           begin
  627.             Last:=I-1;
  628.             Larger:=False;
  629.           end;
  630.         False:
  631.           begin
  632.             First:=I+1;
  633.             Larger:=True;
  634.           end;
  635.       end;
  636.     end;
  637.     if I>0 then
  638.       Case Larger of
  639.         True: FParts.Move(0, I);
  640.         False: FParts.Move(0, I-1);
  641.       end;
  642.   end;
  643. end; { LooserSort }
  644.  
  645. {Quick and dirty multi merge routine}
  646. procedure TFixRecSort.Merge;
  647. begin
  648.   WriteStream:=TFileStream.Create(SorFileName, fmOpenWrite);
  649.   Writer:=TmSorIO.create(WriteStream, FRecordLen, WriteBuffSize);
  650.   while FParts.Count>0 do
  651.   begin
  652.     Writer.WriteData(TmMergePart(FParts[0]).Data^);
  653.     if TmMergePart(FParts[0]).Eof then
  654.     begin
  655.       TmMergePart(FParts[0]).Free;
  656.       FParts.Delete(0);
  657.       if FParts.Count=0 then
  658.       begin
  659.         FParts.Free;
  660.         break;
  661.       end;
  662.     end else
  663.     begin
  664.       TmMergePart(FParts[0]).Next;
  665.       LooserSort;
  666.     end;
  667.   end;
  668.   Writer.FlushBuffer;
  669.   Writer.Free;
  670.   MergeStream.Free;
  671.   WriteStream.Free;
  672. end; { Merge }
  673.  
  674. procedure TFixRecSort.CalculateBuffers;
  675. var
  676.   Size, PCount: LongInt;
  677.   RLen: String;
  678. begin
  679.   Size:=ReadStream.Size;
  680.   if Size mod FRecordLen<>0 then
  681.   begin
  682.     RLen:=IntToStr(FRecordLen);
  683.     raise exception.Create('File can`t be divided through '+RLen);
  684.   end;
  685.   if Size<=40000000 then
  686.   begin
  687.     ReadBuffSize:=Size div 12;
  688.     if ReadBuffSize<325000 then ReadBuffSize:=325000;
  689.     WriteBuffSize:=ReadBuffSize div 5;
  690.   end else;
  691.   if(Size>40000000)and(Size<=100000000)then
  692.   begin
  693.     ReadBuffSize:=Size div 17;
  694.     if ReadBuffSize<4000000 then ReadBuffSize:=4000000;
  695.     WriteBuffSize:=ReadBuffSize div 5;
  696.   end else;
  697.   if(Size>100000000)and(Size<=600000000)then
  698.   begin
  699.     ReadBuffSize:=Size div 25;
  700.     if ReadBuffSize<10000000 then ReadBuffSize:=10000000;
  701.     WriteBuffSize:=ReadBuffSize div 5;
  702.   end else;
  703.   if(Size>600000000)and(Size<=2000000000)then
  704.   begin
  705.     ReadBuffSize:=20000000;
  706.     WriteBuffSize:=ReadBuffSize div 5;
  707.   end;
  708.   PCount:=(Size div ReadBuffSize)+1;
  709.   PartBuffSize:=ReadBuffSize div PCount;
  710. end; { CalculateBuffers }
  711.  
  712. procedure TFixRecSort.Start(InFile, OutFile: String; Compare: TmSorCompare);
  713. var
  714.   aFile, bFile: File;
  715.   K, Readed: Integer;
  716.   WriterPos, SorCount, PartNumber: LongInt;
  717. begin
  718.   TempFileName:='SorTemp.mkw';
  719.   SorFileName:=OutFile;
  720.   AssignFile(aFile, TempFileName);
  721.   Rewrite(aFile);
  722.   CloseFile(aFile);
  723.   AssignFile(bFile, SorFileName);
  724.   Rewrite(bFile);
  725.   CloseFile(bFile);
  726.   PartNumber:=1;
  727.   SorCompare:=Compare;
  728.   SorList:=TM3Array.Create;
  729.   FParts:=TList.Create;
  730.   ReadStream:=TFileStream.Create(InFile, fmOpenRead);
  731.   CalculateBuffers;
  732.   MergeStream:=TFileStream.Create(TempFileName, fmOpenReadWrite);
  733.   Reader:=TmSorIO.create(ReadStream, FRecordLen, ReadBuffSize);
  734.   Writer:=TmSorIO.create(MergeStream, FRecordLen, WriteBuffSize);
  735.   while not Reader.Eof do
  736.   begin
  737.     Readed:=0;
  738.     SorList.Clear;
  739.     while(not Reader.Eof)and(Readed<ReadBuffSize)do
  740.     begin
  741.       SorList.Add(Reader.ReadData);
  742.       inc(Readed, FRecordLen);
  743.     end;
  744.     Case Stable of
  745.       True: SorList.MergeSort(Compare);
  746.       False: SorList.QuickSort(Compare);
  747.     end;
  748.     SorCount:=SorList.Count;
  749.     WriterPos:=Writer.FilePos;
  750.     For K:=0 to SorList.Count-1 do Writer.WriteData(SorList[K]^);
  751.     FParts.Add(TmMergePart.create(MergeStream, WriterPos, FRecordLen, SorCount,
  752.       PartNumber));
  753.     inc(PartNumber);
  754.   end;
  755.   Reader.Free;
  756.   Writer.FlushBuffer;
  757.   Writer.Free;
  758.   ReadStream.Free;
  759.   if FParts.Count>1 then
  760.   begin
  761.     InitMerge;
  762.     Merge;
  763.     DeleteFile(TempFileName);
  764.   end else
  765.   begin
  766.     MergeStream.Free;
  767.     DeleteFile(SorFileName);
  768.     RenameFile(TempFileName, SorFileName);
  769.   end;
  770.   SorList.Free;
  771. end; { Start }
  772.  
  773. end.
  774.  
  775.