Удаление последнего блока в типизированом файле

@BullRush · Регистрация: 18.11.2012

Студворк — интернет-сервис помощи студентам

Добрый день! написал программу для работы с типизироваными файлами: программа создает файл, выводит список на экран в консольном режиме, удаляет список, добавляет блок к голове списка. Нужно написать процедуры удаление последнего блока, само условие мне понятно а вот почему не работает понять не могу. Вот код программы

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
program Project4;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
  type PtrAuto=^Auto;
     Auto=record
           Name:string[20];          Marka:string[20];    nomer:string[10];
          end;
     PtrNode=^node;
     node=record
     info:auto;
     next:PtrNode;
         end;
         List=record
        head:PtrNode;
  tail:PtrNode;
  count:integer;
        end;
Proc=procedure(x:ptrnode);
var
 current:ptrnode;
 listfile:file of Auto;
    list0:list;
file_name:string;
    procedure create_list;
     begin
     reset(listfile);
      new(current);
     read(listfile,current^.info);
     list0.count:=1;
     list0.head:=current;
          while not eof(listfile) do
             begin
   new(current^.next);
       read(listfile,current^.next^.info); 
 
       inc(list0.count);
   current:=current^.next;
   end;
           list0.tail:=current;
           current^.next:=nil;
           close(listfile);
           readln;
            end;
procedure init_list;
begin
 list0.head:=nil;
 list0.tail:=nil;
 list0.count:=0;
 end;
 procedure print_list(cur:ptrnode);  far;
         begin
         if cur<> nil then
             begin
         writeln(' name:  ',cur^.info.name);
         writeln('  marka:  ',cur^.info.marka);
         writeln('nomer:  ',cur^.info.nomer);
         writeln;
            end;
end;
procedure forsearch(pr:proc;L:list);
         var cur:ptrnode;
         begin
         cur:=L.head;
         if L.count=0 then writeln('list empty') ;
         while cur<>nil do
         begin
         pr(cur);
         cur:=cur^.next;
         end;
         //readln
end;
procedure create_file;
    var i,n: integer;
        ch:char;
        autom:Auto;
   begin
   writeln('create file ? Y or N');
   readln(ch);
    if (ch = 'Y') or (ch = 'y') then
             begin
    rewrite(listfile);
    writeln ('how many record');
    readln(n);
    for i:=1 to n do
         begin
      write('name');
      readln (autom.name);
      write ('marka');
     readln (autom.marka);
      write ('nomer');
      readln (autom.nomer);
      write (listfile,autom);
           end;
    close(listfile);
    //readln;
     end;
   end;
 
procedure dispose_list;
    var temp:ptrnode;
      begin
      current:=list0.head;        // текущий указатель ставится на начало списка
      while current<>nil do    //цикл перемещения по списку
              begin
         temp:=current^.next;  // вспомогательный указатель перемещается на следующий узел
         current^.next:=nil;     // удаляется связь между текущим и последующим узлом
         dispose(current);       // удаляется текущий узел
         current:=temp;           //текущий указатель перемещается на следующий узел
         end;
      init_list;                        //инициализация списка
      writeln('LIST EMPTY');
      readln;
      end;
procedure AddtoHead;
             var newnode:ptrnode;
       begin
       new(newnode);
    write('name  '); readln(newnode^.info.name);
    write('marka   '); readln(newnode^.info.marka);
    write('nomer'); readln(newnode^.info.nomer);
          current:=list0.head;
           list0.head:=newnode;
      newnode^.next:=current;
    end;
    procedure disposetail(cur:ptrnode);  far;
         begin
         current:=list0.head;
         while current^.next^.next<> nil do
         begin
         cur:=cur^.next;
         end;
         current^.next:=nil ;
         dispose(cur^.next);
         cur^.next:=nil;
         current:=nil;
 
 
        end;
 
 
 
begin
  { TODO -oUser -cConsole Main : Insert code here }
      writeln('input name of file'); readln(file_name);
    assign(listfile,file_name);
    init_list;
    create_file;
    create_list;
    forsearch(print_list,list0);
    //forsearch(print_list,list0);
   // addtohead;
    forsearch(print_list,list0);
    //dispose_list;
  disposetail;
  forsearch(print_list,list0);
     readln;
 
 
     end.

Вот еще раз процедура удаления последнего блока:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure disposetail(cur:ptrnode);  far;
         begin
         current:=list0.head;
         while current^.next^.next<> nil do
         begin
         cur:=cur^.next;
         end;
         current^.next:=nil ;
         dispose(cur^.next);
         cur^.next:=nil;
         current:=nil;
 
 
        end;

Помогите пожалуйста ее исправить.

Одиночка · 16.03.2013, 19:31

Другие не проверял, но эту процедуру нужно так:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
procedure disposetail;
Var
  cur:ptrnode;
begin
  current:=list0.head;
  if current=nil then exit;
  cur:=nil;
  while current^.next<> nil do
  begin
    cur:=current;
    current:=current^.next;
  end;
  if cur<>nil then
  //Если был не последний
  cur^.next:=nil else
  //Если был последний
  List0.head:=nil;
 
  dispose(current);
  List0.count:=List0.count-1;
  List0.tail:=cur;
end;

И, раз вызываешь без параметров, так и приши без параметров. Или наоборот.

@BullRush · 17.03.2013, 15:12 **[ТС]**

Спасибо, если не сложно можете подсказать с таким заданием :Определить узел с заданным значением какого-либо поля записи. Что то я не понимаю что нужно сделать =(

Одиночка · 17.03.2013, 15:15

Это относится к этой же задаче?
Похоже, что да. Думаю, нужно сделать функцию, на входе которой: имя марка и номер. Она должна пройти по всей цепочке, сравнивая в Info каждого узла соответствующие данные. Если какой-либо из заданных параметров - пустая строка - его не сравнивать. На выход функции выдаётся ссылка на найденный узел или nil - если таковой не найден.

@BullRush · 17.03.2013, 15:29 **[ТС]**

И процедура удаление первого узла

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure DelHead ;
{Удаление первого узла списка}
var
cur:ptrnode;
begin
current:=list0.head;
  if current <> nil then begin
    cur:=current;
    current:= current^.Next;
    end;
    Dispose(current);
     List0.tail:=cur;
 
  end;

Добавлено через 1 минуту

Сообщение от Одиночка

Это относится к этой же задаче?
Похоже, что да. Думаю, нужно сделать функцию, на входе которой: имя марка и номер. Она должна пройти по всей цепочке, сравнивая в Info каждого узла соответствующие данные. Если какой-либо из заданных параметров - пустая строка - его не сравнивать. На выход функции выдаётся ссылка на найденный узел или nil - если таковой не найден.

Ясно спасибо пустых параметров по идее нет, попробую написать.

Одиночка · 17.03.2013, 15:35

Насчёт "пустых параметров" я имел в виду задаваемых. Т.е. поиск не обязательно выполняется сразу по всем, а может по одному или двум. Остальные передаются в функцию пустыми.

Процедура удаления первого узла:

Delphi
1
2
3
4
5
6
7
8
9
10
11
procedure DelHead ;
{Удаление первого узла списка}
begin
  current:=list0.head;
  if current <> nil then 
  begin
    List0.head:=current^.Next;
    Dispose(current);
    List0.Count:=List0.Count-1;
  end;
end;

@BullRush · 17.03.2013, 18:29 **[ТС]**

Что-то не получается у меня такую процедуру написать=( Не могли бы пожалуйста помочь... если можно то с краткими пояснениями.

Одиночка · 17.03.2013, 19:29

Вот всё подправил:

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
program Project1;
//program Project4;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
type
  PtrAuto=^Auto;
  Auto=record
        Name:string[20];          Marka:string[20];    nomer:string[10];
       end;
  PtrNode=^node;
  node=record
        info:auto;
        next:PtrNode;
       end;
  List=record
        head:PtrNode;
        tail:PtrNode;
        count:integer;
       end;
  Proc=procedure(x:ptrnode);
 
var
  current:ptrnode;
  listfile:file of Auto;
  list0:list;
  file_name:string;
 
procedure create_list;
begin
  reset(listfile);
  new(current);
  read(listfile,current^.info);
  list0.count:=1;
  list0.head:=current;
  while not eof(listfile) do
  begin
    new(current^.next);
    current:=current^.next;
    read(listfile,current^.info);
 
    inc(list0.count);
  end;
  list0.tail:=current;
  current^.next:=nil;
  close(listfile);
  readln;
end;
 
procedure init_list;
begin
  list0.head:=nil;
  list0.tail:=nil;
  list0.count:=0;
end;
 
procedure print_list(cur:ptrnode);
begin
  if cur<>nil then
  begin
    writeln('name:   ',cur^.info.name);
    writeln('marka:  ',cur^.info.marka);
    writeln('nomer:  ',cur^.info.nomer);
    writeln;
  end;
end;
 
procedure forsearch(pr:proc;L:list);
var cur:ptrnode;
begin
  cur:=L.head;
  if L.count=0 then writeln('list empty') ;
  while cur<>nil do
  begin
    pr(cur);
    cur:=cur^.next;
  end;
end;
 
procedure create_file;
var
  i,n: integer;
  ch:char;
  autom:Auto;
begin
  writeln('create file ? Y or N');
  readln(ch);
  if (ch = 'Y') or (ch = 'y') then
  begin
    rewrite(listfile);
    writeln ('how many record');
    readln(n);
    for i:=1 to n do
    begin
      write('name: ');
      readln (autom.name);
      write ('marka: ');
      readln (autom.marka);
      write ('nomer: ');
      readln (autom.nomer);
      write (listfile,autom);
    end;
    close(listfile);
    //readln;
  end;
end;
 
procedure dispose_list;
var temp:ptrnode;
begin
  current:=list0.head;     // текущий указатель ставится на начало списка
  while current<>nil do    //цикл перемещения по списку
  begin
    temp:=current^.next;  // вспомогательный указатель перемещается на следующий узел
    current^.next:=nil;   // удаляется связь между текущим и последующим узлом
    dispose(current);     // удаляется текущий узел
    current:=temp;        //текущий указатель перемещается на следующий узел
  end;
  init_list;              //инициализация списка
  writeln('LIST EMPTY');
  readln;
end;
 
function Find(n,m,no:String):ptrnode;
begin
  result:=nil;
  current:=list0.head;
  while (current <> nil) do
  with current^ do
  begin
    if ((n='') or (n=info.Name)) and //Если имя не задано или равно
    ((m='') or (m=info.Marka)) and   //марка - то же самое
    ((no='') or (m=info.nomer)) then //номер - --//--
    begin
      result:=current; //Указатель на выход
      break; //Выходим из цикла
    end;
    current:=next; //На следующий узел
  end;
end;
 
procedure AddtoHead;
var newnode:ptrnode;
begin
  new(newnode);
  write('name   '); readln(newnode^.info.name);
  write('marka   '); readln(newnode^.info.marka);
  write('nomer   '); readln(newnode^.info.nomer);
  current:=list0.head;
  list0.head:=newnode;
  newnode^.next:=current;
end;
 
procedure DelHead ;
{Удаление первого узла списка}
begin
  current:=list0.head;
  if current <> nil then
  begin
    List0.head:=current^.Next;
    Dispose(current);
    List0.Count:=List0.Count-1;
  end;
end;
 
procedure disposetail;
Var
  cur:ptrnode;
begin
  current:=list0.head;
  if current=nil then exit;
  cur:=nil;
  while current^.next<> nil do
  begin
    cur:=current;
    current:=current^.next;
  end;
  if cur<>nil then
  //Если был не последний
  cur^.next:=nil else
  //Если был последний
  List0.head:=nil;
 
  dispose(current);
  List0.count:=List0.count-1;
  List0.tail:=cur;
end;
 
Var
  n,m,no : string;
  cur:ptrnode;
begin
  writeln('input name of file'); readln(file_name);
  if file_name='' then file_name:='listfile.dat';
  assignfile(listfile,file_name);
  init_list;
  create_file;
  create_list;
  forsearch(print_list,list0);
//  addtohead;
//  forsearch(print_list,list0);
  //dispose_list;
  writeLn('------------- Udalyaem hvost:');
  disposetail;
  forsearch(print_list,list0);
 
  writeLn('------------- Udalyaem golovu:');
  DelHead ;
  forsearch(print_list,list0);
 
  //Поиск заданного
  writeLn;
  writeLn('Vvedite dannye dlya poiska:');
  write('name: '); readln (n);
  write ('marka: '); readln (m);
  write ('nomer: '); readln (no);
  cur:=Find(n,m,no);
  if cur=nil then
  writeln('Ne naideno!') else
  print_list(cur); //На экран данные найденного узла
 
  readln;
end.

@BullRush · 23.03.2013, 20:22 **[ТС]**

Спасибо, вроде все понял, последний вопрос по этой теме остался как процедуру сделать, которая будет удалять узел с указаным номером?

Одиночка · 23.03.2013, 21:33

Требуется уточнение. Что имеется в виду под "указанным номером"? Номер машины? Или порядковый номер узла в списке?

@BullRush · 23.03.2013, 22:09 **[ТС]**

Сообщение от Одиночка

Требуется уточнение. Что имеется в виду под "указанным номером"? Номер машины? Или порядковый номер узла в списке?

номер узла

Одиночка · 23.03.2013, 22:24

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure DelByNum(Num:Integer);
{Удаление узла списка по указанному номеру}
Var
  Prv:ptrnode;
begin
  If Num<1 Then Exit;
  current:=list0.head;
  Prv:=nil;
  while current<>nil do
  begin
    Dec(Num);
    If Num=0 Then
    {Удаляем узел из списка}
    Begin
      If Prv<>Nil Then
      Begin
        Prv^.next:=current^.next;
        Dispose(current);
        List0.Count:=List0.Count-1;
      End Else
      DelHead; {Удаляется первый узел списка}
 
      Break;
    End;
    Prv:=current; {Предыдущий узел}
    current:=current^.next;
  end;
end;

Новые блоги и статьи Все статьи Все блоги /
Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ФедосеевПавел 06.01.2026 Owen Logic: О недопустимости использования связки «аналоговый ПИД» + RegKZR ВВЕДЕНИЕ Введу сокращения: аналоговый ПИД — ПИД регулятор с управляющим выходом в виде числа в диапазоне от 0% до. . .	Модель микоризы: классовый агентный подход 2 anaschu 06.01.2026 репозиторий https:/ / github. com/ shumilovas/ fungi ветка по-частям. коммит Create переделка под биомассу. txt вход sc, но sm считается внутри мицелия. кстати, обьем тоже должен там считаться. . . .	Расчёт токов в цепи постоянного тока igorrr37 05.01.2026 / * Дана цепь постоянного тока с сопротивлениями и напряжениями. Надо найти токи в ветвях. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа и решает её. Последовательность действий:. . .	Новый CodeBlocs. Версия 25.03 palva 04.01.2026 Оказывается, недавно вышла новая версия CodeBlocks за номером 25. 03. Когда-то давно я возился с только что вышедшей тогда версией 20. 03. С тех пор я давно снёс всё с компьютера и забыл. Теперь. . .
Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .

@BullRush 0 / 0 / 0 Регистрация: 18.11.2012 Сообщений: 34
	17.03.2013, 15:12 [ТС]
	Спасибо, если не сложно можете подсказать с таким заданием :Определить узел с заданным значением какого-либо поля записи. Что то я не понимаю что нужно сделать =( 0

Одиночка 3944 / 1869 / 337 Регистрация: 16.03.2012 Сообщений: 3,880
	17.03.2013, 15:15
	Это относится к этой же задаче? Похоже, что да. Думаю, нужно сделать функцию, на входе которой: имя марка и номер. Она должна пройти по всей цепочке, сравнивая в Info каждого узла соответствующие данные. Если какой-либо из заданных параметров - пустая строка - его не сравнивать. На выход функции выдаётся ссылка на найденный узел или nil - если таковой не найден. 0

@BullRush 0 / 0 / 0 Регистрация: 18.11.2012 Сообщений: 34
	17.03.2013, 18:29 [ТС]
	Что-то не получается у меня такую процедуру написать=( Не могли бы пожалуйста помочь... если можно то с краткими пояснениями. 0

@BullRush 0 / 0 / 0 Регистрация: 18.11.2012 Сообщений: 34
	23.03.2013, 20:22 [ТС]
	Спасибо, вроде все понял, последний вопрос по этой теме остался как процедуру сделать, которая будет удалять узел с указаным номером? 0

Одиночка 3944 / 1869 / 337 Регистрация: 16.03.2012 Сообщений: 3,880
	23.03.2013, 21:33
	Требуется уточнение. Что имеется в виду под "указанным номером"? Номер машины? Или порядковый номер узла в списке? 0