mwtextsort.pas

一个速度很快的文字排序引擎(TextSort engine)

    end;

  while ( FFileOne.Full ) and ( FFileThree.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileThree.FLeft) <= 0 then
        begin
          if MergeCompare(FFileOne.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileOne.fLeft^.Data);
              FFileOne.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileThree.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileThree.fLeft^.Data);
              FFileThree.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileFour.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileFour.FLeft) <= 0 then
        begin
          if MergeCompare(FFileOne.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileOne.fLeft^.Data);
              FFileOne.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileFour.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileFour.fLeft^.Data);
              FFileFour.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileThree.Full ) and ( FFileFour.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileThree.FLeft) <= 0 then
        begin
          if MergeCompare(FFileTwo.FLeft, FFileFour.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileTwo.fLeft^.Data);
              FFileTwo.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFour.fLeft^.Data);
              FFileFour.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileThree.FLeft, FFileFour.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileThree.fLeft^.Data);
              FFileThree.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFour.fLeft^.Data);
              FFileFour.Next;
            end;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileThree.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileThree.FLeft) <= 0 then
        begin
          if MergeCompare(FFileTwo.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileTwo.fLeft^.Data);
              FFileTwo.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileThree.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileThree.fLeft^.Data);
              FFileThree.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileFour.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileFour.FLeft) <= 0 then
        begin
          if MergeCompare(FFileTwo.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileTwo.fLeft^.Data);
              FFileTwo.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileFour.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileFour.fLeft^.Data);
              FFileFour.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end;
    end;

  while ( FFileThree.Full ) and ( FFileFour.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileThree.FLeft, FFileFour.FLeft) <= 0 then
        begin
          if MergeCompare(FFileThree.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileThree.fLeft^.Data);
              FFileThree.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end
      else
        begin
          if MergeCompare(FFileFour.FLeft, FFileFive.FLeft) <= 0 then
            begin
              writeln(fOutFile, FFileFour.fLeft^.Data);
              FFileFour.Next;
            end
          else
            begin
              writeln(fOutFile, FFileFive.fLeft^.Data);
              FFileFive.Next;
            end;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileTwo.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileTwo.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileOne.fLeft^.Data);
          FFileOne.Next;
        end
      else
        begin
          writeln(fOutFile, FFileTwo.fLeft^.Data);
          FFileTwo.Next;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileThree.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileThree.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileOne.fLeft^.Data);
          FFileOne.Next;
        end
      else
        begin
          writeln(fOutFile, FFileThree.fLeft^.Data);
          FFileThree.Next;
        end;
    end;

   while ( FFileOne.Full ) and ( FFileFour.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileFour.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileOne.fLeft^.Data);
          FFileOne.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFour.fLeft^.Data);
          FFileFour.Next;
        end;
    end;

  while ( FFileOne.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileOne.FLeft, FFileFive.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileOne.fLeft^.Data);
          FFileOne.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFive.fLeft^.Data);
          FFileFive.Next;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileThree.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileThree.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileTwo.fLeft^.Data);
          FFileTwo.Next;
        end
      else
        begin
          writeln(fOutFile, FFileThree.fLeft^.Data);
          FFileThree.Next;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileFour.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileFour.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileTwo.fLeft^.Data);
          FFileTwo.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFour.fLeft^.Data);
          FFileFour.Next;
        end;
    end;

  while ( FFileTwo.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileTwo.FLeft, FFileFive.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileTwo.fLeft^.Data);
          FFileTwo.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFive.fLeft^.Data);
          FFileFive.Next;
        end;
    end;

  while ( FFileThree.Full ) and ( FFileFour.Full ) do
    begin
      if MergeCompare(FFileThree.FLeft, FFileFour.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileThree.fLeft^.Data);
          FFileThree.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFour.fLeft^.Data);
          FFileFour.Next;
        end;
    end;

  while ( FFileThree.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileThree.FLeft, FFileFive.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileThree.fLeft^.Data);
          FFileThree.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFive.fLeft^.Data);
          FFileFive.Next;
        end;
    end;

  while ( FFileFour.Full ) and ( FFileFive.Full ) do
    begin
      if MergeCompare(FFileFour.FLeft, FFileFive.FLeft) <= 0 then
        begin
          writeln(fOutFile, FFileFour.fLeft^.Data);
          FFileFour.Next;
        end
      else
        begin
          writeln(fOutFile, FFileFive.fLeft^.Data);
          FFileFive.Next;
        end;
    end;

  while FFileOne.Full do    { Write Rest of First SubFile }
    begin
      writeln(fOutFile, FFileOne.fLeft^.Data);
      FFileOne.Next;
    end;

  while FFileTwo.Full do    { Write Rest of Second SubFile }
    begin
      writeln(fOutFile, FFileTwo.fLeft^.Data);
      FFileTwo.Next;
    end;

  while FFileThree.Full do   { Write Rest of Third SubFile }
    begin
      writeln(fOutFile, FFileThree.fLeft^.Data);
      FFileThree.Next;
    end;

  while FFileFour.Full do   { Write Rest of Fourth SubFile }
    begin
      writeln(fOutFile, FFileFour.fLeft^.Data);
      FFileFour.Next;
    end;

  while FFileFive.Full do   { Write Rest of Fifth SubFile }
    begin
      writeln(fOutFile, FFileFive.fLeft^.Data);
      FFileFive.Next;
    end;

end; { FileMerge }

procedure TMergeFile.MergeSort(MergeCompare: TMergeCompare);
var
  a, b, c, d, e: String;
  N, todo: LongInt;
begin
  fOutList:= TStringList.Create;
  fOutList.Clear;
  todo:= 0;
  N:= fInList.Count;
  fFileOne:= TTempFile.Create;
  fFileTwo:= TTempFile.Create;
  fFileThree:= TTempFile.Create;
  fFileFour:= TTempFile.Create;
  fFileFive:= TTempFile.Create;
  while fInList.Count > 1 do
  begin
    while todo < fInList.Count do
    begin
      fFileName:= 'Temp' + IntToStr(N);
      inc(N);
      AssignFile(fOutFile, fFileName);
      rewrite(fOutFile);
      fOutList.Add(fFileName);
      a:= fInList.Strings[todo]; inc(todo);
      if todo < fInList.Count then begin b:= fInList.Strings[todo]; inc(todo) end else b:= '';
      if todo < fInList.Count then begin c:= fInList.Strings[todo]; inc(todo) end else c:= '';
      if todo < fInList.Count then begin d:= fInList.Strings[todo]; inc(todo) end else d:= '';
      if todo < fInList.Count then begin e:= fInList.Strings[todo]; inc(todo) end else e:= '';
      FFileOne.Init(a);
      FFileTwo.Init(b);
      FFileThree.Init(c);
      FFileFour.Init(d);
      FFileFive.Init(e);
      FileMerge(MergeCompare);
      CloseFile(fOutFile);
      if todo = fInList.Count -1 then
        begin
          fOutList.Add(fInList.Strings[todo]);
          inc(todo);
        end;
    end;
      todo:= 0;
      TempList:= fInList;
      fInList:= fOutList;
      fOutList:= TempList;
      fOutList.Clear;
  end;
    fFileOne.Free;
    fFileTwo.Free;
    fFileThree.Free;
    fFileFour.Free;
    fFileFive.Free;
    fOutList.Free
end;  { MergeSort }

constructor TTextSort.Create(Compare: TMergeCompare);
begin
  inherited Create;
  fCompare:= Compare;
  fFileName:= '';
  FMaxLines := 60000;
  FMaxMem := 4000000;
end;  { Create }

procedure TTextSort.Init(FileName: String);
begin
  fFileName:= FileName;
  fTempFileList:= TStringList.Create;
end;

procedure TTextSort.Start;
var
  ToSort: TextFile;
  TempFile: TextFile;
  TempFileName, BackFileName, InFileName, TextLine: String;
  I, K, TempSize: Integer;
  LineData: PMergeData;
begin
  I:= 0;
  InFileName:= fFileName;
  BackFileName:= ChangeFileExt(fFileName, '.bak');
  if FileExists(BackFileName) then DeleteFile(PChar(BackFileName));
  AssignFile(ToSort, FFileName);
  Reset(ToSort);
  while not Eof(ToSort) do
  begin
    fMerArray:= TM3Array.Create;
    TempSize:= 0;
    TempFileName:= 'Temp' + IntToStr(I);
    fTempFileList.Add(TempFileName);
    AssignFile(TempFile, TempFileName);
    Rewrite(TempFile);
    inc(I);
    while (fMerArray.Count < fMaxLines) and (TempSize < fMaxMem) and (not Eof(ToSort)) do
    begin
      readln(ToSort, TextLine);
      TempSize:= TempSize +Length(TextLine) +8;
      New(LineData);
      LineData^.Data:= TextLine;
      fMerArray.Add(LineData);
    end;        { while }
    fMerArray.MergeSort(fCompare);
    for K := 0 to  fMerArray.Count -1 do       { Iterate }
    begin
      LineData:= fMerArray[K];
      writeln(TempFile, LineData^.Data);
      Dispose(LineData);
    end;        { for }
    CloseFile(TempFile);
    fMerArray.Free;
  end;        { while }
  CloseFile(ToSort);
  if fTempFileList.Count > 1 then
  begin
    MergeFile:= TMergeFile.Create(fTempFileList);
    MergeFile.MergeSort(fCompare);
    RenameFile(InFileName, BackFileName);
    RenameFile(MergeFile.FileName, FFileName);
    MergeFile.Free;
  end else
  begin
    RenameFile(InFileName, BackFileName);
    RenameFile(TempFileName, FFileName);
  end;
end;

destructor TTextSort.Destroy;
begin
  inherited Destroy;
end;  { Destroy }

end.
{--------------------------------------------------------------------}
{ Martin Waldenburg
  Landaeckerstrasse 27
  71642 Ludwigsburg
  Germany
  Share your Code}
{--------------------------------------------------------------------}