нужно помочь)список двузвязний...

[jekie182]

На складе ежедневно в текстовый файл дописывалась информация о поступлении товаров. Каждая строка файла содержит название товара, количество штук, которые разделены пробелами. Данные в файл заносились в течение месяца. Вывести информацию о поступление товаров за месяц за ростом количества, а при равном количестве - вывести названия товаров по алфавиту.
вот я зделал і вроде работает:

program dvspisok;
uses crt;
Type
str=string[20];   
ptr=^element;     
element=record    
dani:str;  
kilk:integer;  
next,prev:ptr;                         
end;
var f:text;
head:ptr;
name:string; 

Procedure init_file(var f:text);{stvorennia tekstovogo faila}
var s:string;
begin
         rewrite(f);
         writeln('vvodum nazvu mix yakumu probil v end:#');
         readln(s);
         while s<>'#' do
         begin
         writeln(f,s);
         readln(s);
         end;
         close(f);
end;


Procedure Druk_file(var f:text);{vuvodum tekctovyi fail}
var s:string;
begin
         reset(f);
         while not(eof(f)) do
         begin
                  readln(f, s);
                  writeln(s);
         end;
         close(f);
end;

{dodaem nazvu}  
Procedure AddElemS(var current:ptr; slovo:str);
var X:ptr;
begin
         New(X);
         X^.dani:= slovo;
         X^.kilk:=1;
         X^.next := current^.next; 
         X^.prev := current;
         current^.next^.prev := X; 
         current^.next := X;
end;

procedure DelElem(var current : ptr); {vadal zi spusky}
var X:ptr;
begin
         X := current;
         current^.prev^.next:=current^.next;
         current^.next^.prev:=current^.prev;
         current := current^.next;
         Dispose(X);
end;

Procedure Perestanovka(var current:ptr);{perestanovka susidiv}
var k : integer;slovo : str;
begin
         
         slovo := current^.dani;
         k := current^.kilk;
         current^.dani:=current^.prev^.dani;
         current^.kilk:=current^.prev^.kilk;
         current^.prev^.dani:=slovo;
         current^.prev^.kilk:=k;
         current:=current^.prev;
end;

Procedure FindElem(var head:ptr; slovo:str); {wykaem misce y kilci}
var current:ptr;
begin
current:=head^.next;
while
(current<>head) and (current^.dani<>slovo) do
current:=current^.next;
if current^.dani=slovo then
current^.kilk:=current^.kilk + 1
else 
AddElemS(head, slovo);
end;

Procedure Write_file(var f:text; var head:ptr); {stvorennia faila}
Var s, slovo :string; i, j:byte;
begin
reset(f);
while not(eof(f)) do
begin
readln(f,s);
slovo:='';
         for i:=1 to length(s) do{вибірка слів із рядка}
         begin
         if s[i]<>' 'then slovo:=slovo+s[i]
                  else
                  if i< length(s) then
                           if s[i+1]<>' ' then
                                   begin
                                   FindElem(head, slovo);
                                   slovo:='';
                                   end;
         end;
         if (i= length(s)) and (slovo<>'') then
         FindElem(head, slovo);
         end;
         close(f);
end;

Procedure Vivod_Spisok(head:ptr);{vuvod nazv}
var current:ptr;
begin
 current:=head^.next;
         writeln('nazva':25,'kilk':10);
         while current<>head do
                  begin
                  writeln(current^.dani:25, current^.kilk:10);
current:=current^.next;
end;
end;

Procedure SortVstavka(var head:ptr); {sortuem slova}
var X, current:ptr;
begin
X:=head^.next^.next;
while X<>head do
begin
current := X;
while (current^.kilk > current^.prev^.kilk)
 and (current^.prev<>head) do
Perestanovka(current);
if current^.kilk = current^.prev^.kilk then
while (current^.kilk = current^.prev^.kilk) and
(current^.dani < current^.prev^.dani) do
Perestanovka(current);
X:=X^.next;
end;
end;

Procedure Dr_sp(var head:ptr);{naw spusok}
var X:ptr;
Begin
writeln('nazva':25, 'kilk':10);
X:=head^.next;
while (X<>head) do      
begin
writeln(x^.dani:25,x^.kilk:5);
writeln(X^.dani:25, X^.kilk:5);
DelElem(X);
end;
end;

BEGIN
clrscr;
New(head);
head^.dani:= '';
head^.kilk:=0;
head^.next:= head;
head^.prev:= head;
writeln('nazva faila');
readln(name);
assign(f,name);
init_file(f);
writeln('na ekran');
Druk_file(f);
readln;
Write_file(f, head);
writeln('duvumos nazvu');
Vivod_Spisok(head);
readln;
SortVstavka(head);
writeln('naw spusok');
Dr_sp(head);
END.

работает, но я пропустил (
там нужно самому вводить количество) и по ней сортировать а я считал количество за повторениями названий (
сейчас пробую исправить но ничего не выходит (


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.