Sortowanie plikow , laczenie proste

Otrzymałeś(aś) rozwiązanie do zamieszczonego zadania? - podziękuj autorowi rozwiązania! Kliknij
Robakks
Czasem tu bywam
Czasem tu bywam
Posty: 126
Rejestracja: 30 wrz 2012, 20:36
Podziękowania: 2 razy
Otrzymane podziękowania: 10 razy
Płeć:

Sortowanie plikow , laczenie proste

Post autor: Robakks » 18 sie 2017, 00:22

Kod: Zaznacz cały

uses crt;

procedure split(partLength:longint;var inFile:text;auxFileOne:text;auxFileTwo:text);
var buffer:string;
    counter:longint;
begin
  repeat
     counter:=1;
     while((counter<=partLength)and(not eof(inFile)))do
     begin
       readln(inFile,buffer);
       writeln(auxFileOne,buffer);
       counter:=counter+1;
     end;
     counter:=1;
     while((counter<=partLength)and(not eof(inFile)))do
     begin
       readln(inFile,buffer);
       writeln(auxFileTwo,buffer);
       counter:=counter+1;
     end;
  until eof(inFile);
end;

procedure combine(partLength:longint;auxFileOne:text;auxFileTwo:text;var inputFile:text);
var bufferOne,bufferTwo:string;
    counterOne,counterTwo:longint;
begin
  if(eof(auxFileOne)=false)then
     readln(auxFileOne,bufferOne);
  if(eof(auxFileTwo)=false)then
     readln(auxFileTwo,bufferTwo);
  while((eof(auxFileOne)=false)and(eof(auxFileTwo)=false))do
  begin
    counterOne:=1;
    counterTwo:=1;
    repeat
      if(bufferOne<bufferTwo)then
      begin
        writeln(inputFile,bufferOne);
        if(eof(auxFileOne=false))then
            readln(auxFileOne,bufferOne);
        counterOne:=counterOne+1;
      end
      else
      begin
        writeln(inputFile,bufferTwo);
        if(eof(auxFileTwo=false))then
            readln(auxFileTwo,bufferTwo);
        counterTwo:=counterTwo+1;
      end;
      until not((counterOne<=partLength)and(counterTwo<=partLength)and(eof(auxFileOne)=false)and(eof(auxFileTwo)=false));
      while((counterOne<=partLength)and(eof(auxFileOne)=false))do
      begin
        readln(auxFileOne,bufferOne);
        writeln(inputFile,bufferOne);
        counterOne:=counterOne+1;
      end;
      while((counterTwo<=partLength)and(eof(auxFileTwo)=false))do
      begin
        readln(auxFileTwo,bufferTwo);
        writeln(inputFile,bufferTwo);
        counterTwo:=counterTwo+1;
      end;
    end;
    while(eof(auxFileOne)=false)do
    begin
      readln(auxFileOne,bufferOne);
      writeln(inputFile,bufferOne);
    end;
    while(eof(auxFileTwo)=false)do
    begin
      readln(auxFileTwo,bufferTwo);
      writeln(inputFile,bufferTwo);   
    end;
end;

var inputFile,auxFileOne,auxFileTwo:text;
    inputFileName,auxFileNameOne,auxFileNameTwo:string;
    partLength:longint;
    exitCond:boolean;

begin
  clrscr;
  writeln('Enter source file path: ');
  readln(inputFileName);
  
  auxFileNameOne:=copy(inputFileName,1,pos('.',inputFileName)-1)+'_temp001.txt';
  auxFileNameTwo:=copy(inputFileName,1,pos('.',inputFileName)-1)+'_temp002.txt';

  assign(inputFile,inputFileName);
  assign(auxFileOne,auxFileNameOne);
  assign(auxFileTwo,auxFileNameTwo);

  partLength:=1;
  exitCond:=false;
  
  repeat
    
    reset(inputFile);
    rewrite(auxFileOne);
    rewrite(auxFileTwo);
    
    split(partLength,inputFile,auxFileOne,auxFileTwo);

    close(auxFileOne);
    close(auxFileTwo);   
    close(inputFile);

    rewrite(inputFile);
    reset(auxFileOne);
    reset(auxFileTwo);

    if not eof(auxFileTwo)then
    begin
       combine(partLength,auxFileOne,auxFileTwo,inputFile);
       partLength:=2*partLength;
    end
    else
       exitCond:=true;
    
    close(auxFileTwo);
    close(auxFileOne);
    close(inputFile);
    
    until exitCond=true;
     
end.

Znalazlem u pewnego kolesia kod sortowania przez laczenie proste jednak
nie wyglada na to aby kopiowal cale pliki i nie wiem gdzie jest blad

vbc2
Witam na forum
Witam na forum
Posty: 3
Rejestracja: 20 paź 2017, 07:30

Post autor: vbc2 » 20 paź 2017, 07:33

Poszukaj innego skryptu, będzie szybciej