{$M 00, 0, 0}

 

uses dos;

 

procedure action(in_name, out_name: string;

          is_adding: boolean);

var

  s: string;

  f_in, f_out: text;

begin

  assign(f_in, in_name); reset(f_in);

  assign(f_out, out_name); rewrite(f_out);

 

  while not eof(f_in) do begin

    readln(f_in, s);

    if is_adding then writeln(f_out, length(s):3, ' ' + s)

    else writeln(f_out, copy(s, 5, length(s)));

  end;

 

  close(f_out);

  close(f_in);

 

end;

 

const

  in_name = 't.txt';

  out_name = 't2.txt';

  temp_1_name = '1.tmp';

  temp_2_name = '2.tmp';

 

var

  f_in, f_out: text;

 

begin

  action(in_name, temp_1_name, true);

 

  { Внимание, сейчас будет самое интересное !!! }

  swapvectors;

  exec(getenv('comspec'), '/c sort ' + temp_1_name + ' /O ' + temp_2_name);

  swapvectors;

 

  action(temp_2_name, out_name, false);

 

  { ну, тут не забываем почистить tmp -файлы, естественно... }

end.

program test;

{$I-}

uses

    crt;

type

    Tvector = array[1..1] of string;

    Tnumber = array[1..1] of byte;

var

    t : text;

    i, j : byte;

    s : string;

    vector : ^TVector;

    number : ^Tnumber;

    size : integer;

    k : byte;

    b : byte;

    bs : string;

    newT : text;

begin

    clrscr;

 

    assign(t, 'c:\as\forum\t.txt');

    reset(t);

    i := 0;

    while not eof(t) do

    begin

        readln(t, s);

        inc(i);

    end;

 

    size := i * sizeOf(string);

    getMem(vector, size);

    size := i * sizeOf(integer);

    getMem(number, size);

    close(t);

 

    reset(t);

    i := 1;

    while not eof(t) do

    begin

        readln(t, vector^[i]);

        number^[i] := length(vector^[i]);

        inc(i);

    end;

 

{   writeln(i);{i - 1}

    for k := (i - 1) downto 2 do

    begin

        for j := 1 to (k - 1) do

        begin

            if(number^[j] > number^[j + 1]) then

            begin

                b := number^[j];

                number^[j] := number^[j + 1];

                number^[j + 1] := b;

                bs := vector^[j];

                vector^[j] := vector^[j + 1];

                vector^[j + 1] := bs;

            end;

        end;

    end;

 

    assign(newT, 'c:\as\forum\t1.txt');

    rewrite(newT);

 

    writeln('После сортировки имеем: ');

    for k := 1 to (i - 1) do

    begin

        writeln(vector^[k]);

        writeln(newT, vector^[k]);

    end;

 

    close(t);

    close(newT);

 

         freeMem(vector, size);  {наверное лучше применить разные size для памяти, чтоб потом можно было корректно освободить оба массива}

 

    readln;

end.

dsfdsf dsf sdfsdfsd fsdlf

dsfsdfdsf dfjs

sdfdsf dsflsdf fsdlfjs

dsfdsfj sdlfjsdlfs fklsdfjsdlfsdlf

dflsdfjsdfl sdlfkdslf sdlkfsd

ldsfjsdlf dslfsdlfsdlkf

dsfdsf

df

dfdsf

ds sdf sdf sdf sdf

d