Форум «Всё о Паскале» > Удаление строки из текстового файла в БД

Помощь - Поиск - Пользователи - Календарь

Полная версия: Удаление строки из текстового файла в БД

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

hemm

17.12.2011 2:53

База данных. Не могу наладить удаление конкретной записи.
Удаляются данные из массива, но остаются символы, разделяющие колонки.
Получается такая картина:

*Создал две записи. Затем удалил запись №1, но пустые колонки все равно остались.

Буду благодарен за любые советы по улучшению и упрощению кода.
*процедуру проверки на существования текстового файла пока не делал, поэтому для запуска программы в том же каталоге надо создать файл DB.TXT
Проверял на FREEPASCAL.



Program Students;
Uses crt, dos;







Type DataBase=record
                SecondName: string;
                FirstName:  string;
                FatherName: string;
                Group:      string;
                Course:     string;
          End;

Var Massive:array[1..50] of DataBase;
    n:integer;







Procedure menu;
Forward;







{Считывание базы данных}

Procedure ReadAll;
Var f: text;
Begin
n:=0;
Assign(f,'db.txt');

{$I-}
Reset(f);
{$I+}
If IOresult<>0 then
Writeln('Ошибка: невозможно открыть исходный файл. Повторите ввод.');
While not EOF(f) do
      Begin
       inc(n);
       Readln(f,Massive[n].SecondName);
       Readln(f,Massive[n].FirstName);
       Readln(f,Massive[n].FatherName);
       Readln(f,Massive[n].Group);
       Readln(f,Massive[n].Course);
       Readln(f);
      End;
close(f);
End;







{Сохранение отредактированной базы данных в файл}

Procedure SaveAll;
Var i:integer; f:text;
Begin
Assign(f,'db.txt');
ReWrite(f);
For i:=1 To n do
     Begin
      Writeln(f,Massive[i].SecondName);
      Writeln(f,Massive[i].FirstName);
      Writeln(f,Massive[i].FatherName);
      Writeln(f,Massive[i].Group);
      Writeln(f,Massive[i].Course);
      Writeln(f);
     End;
close(f);
End;







{Линия}

Procedure Line;
Var k:integer;
Begin
For k:=1 To 79 do
Begin
    Write('-');
End;
Writeln;
End;







{Оглавление}

Procedure MainTitle;
Var k,m,n:integer;
Begin
Line;
Write('Фамилия            |'); Write(' Имя      |'); Write(' Отчество           |'); Write(' Группа             |');Write(' Курс');
Writeln;
Line;
End;







{Оглавление редактирования}
Procedure MainTitleEdit;
Var k,m,n:integer;
Begin
Line;
Write('№ | Фамилия           |'); Write(' Имя      |'); Write(' Отчество           |'); Write('Группа |');
Writeln;
Line;
End;







{Оглавление процедуры поиска}
Procedure SearchTitle;
Begin
Line;
   Writeln('Поиск...');
Line;
Writeln;
End;







{Добавление записи}
Procedure Add;
Var i:integer;
Begin
Clrscr;
       inc(n);
       Writeln('Добавление новой записи о студенте:');
       Writeln;
Write('Фамилия........: '); Readln(Massive[n].SecondName);
Write('Имя............: '); Readln(Massive[n].FirstName);
Write('Отчество.......: '); Readln(Massive[n].FatherName);
Write('Номер группы...: '); Readln(Massive[n].Group);
Write('Курс...........: '); Readln(Massive[n].Course);

SaveAll;

Writeln;

Write('Запись успешно добавлена в базу данных');

Delay(1000);

Menu;

End;






{Вывод записей базы данных на экран}

Procedure WriteAll;
Var i,j:integer; s1,s2,s3,s4:string;

Begin
clrscr;

MainTitle;

For i:=1 To n do

                      {-------- ВОТ ЗДЕСЬ ПОДСКАЖИТЕ КАК УПРОСТИТЬ}
  Begin

    s1:='';
    s2:='';
    s3:='';
    s4:='';

    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';
    For j:=1 To 18-length(Massive[i].Group) do s4:=s4+' ';

    Writeln(Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group, s4, ' | ', Massive[i].Course);

  End;

Line;

Writeln;
Write('    |Enter|.. Переход в меню');
Readln;

Menu;

End;







{Вывод записей базы данных с сортировкой на экран}

Procedure Sort;

             Procedure Exchange(Var a,b:string);
              Var c:string;
              Begin
                c:=a;
                a:=b;
                b:=c;
              End;

Var i,Letter,nn:integer;
    Swop:boolean;
    SecondName1,SecondName2:string;

Begin

Clrscr;

For Letter:=5 DownTo 1 do
Begin
       nn:=n;

       Repeat

       swop:=false;

       For i:=1 To nn-1 do Begin

       SecondName1:=Massive[i].SecondName;
       SecondName2:=Massive[i+1].SecondName;

       If Ord(SecondName1[Letter])>Ord(SecondName2[Letter]) then

         Begin

          Exchange(Massive[i].SecondName, Massive[i+1].SecondName);
          Exchange(Massive[i].FirstName, Massive[i+1].FirstName);
          Exchange(Massive[i].FatherName, Massive[i+1].FatherName);
          Exchange(Massive[i].Group, Massive[i+1].Group);
          Exchange(Massive[i].Course, Massive[i+1].Course);

       swop:=true;

         End;

       End;

       nn:=nn-1;

       Until not swop;
End;

MainTitle;

WriteAll;

Line;

Readln;

Menu;

End;







{Поиск по фамилии}

Procedure SearchSecondName;
Var SN: string;
    i,j: integer;
    s1,s2,s3: string;
    Swop: boolean;
    x: char;

Begin

Clrscr;

SearchTitle;

Write('Введите фамилию студента: ');

Readln(SN);

Writeln;

Swop:=false;

MainTitle;

    For i:=1 To n do

    If Massive[i].SecondName=SN then

    Begin
               {-------- ВОТ ЗДЕСЬ ПОДСКАЖИТЕ КАК УПРОСТИТЬ}

    s1:='';
    s2:='';
    s3:='';

    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';

    Writeln(Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group,' | ',Massive[i].Course);

    Swop:=true;
    End;

Line;


If not Swop then Writeln('Записей с такой фамилией не обнаружено либо имя указано неверно');

Writeln;

Line;

   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');

Line;

Write('Ваш выбор| ');

   Readln(x);

   Case x of
   '1':SearchSecondName;
   '0':halt;

Else Menu;
End;
End;









{Поиск по группе}

Procedure SearchGroup;
Var
   SG:string;
   i,j:integer;
   s1,s2,s3:string;
   Swop:boolean;
   x:char;

Begin

clrscr;

SearchTitle;

Write('Введите номер группы: ');
Readln(SG);
Writeln;

Swop:=false;

MainTitle;

For i:=1 To n do
    If Massive[i].Group=SG then
    Begin

    s1:='';
    s2:='';
    s3:='';

    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';

    Writeln(Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group,' | ',Massive[i].Course);

    Swop:=true;
    End;

Line;

If not Swop then Writeln('Записей с таким номером группы не обнаружено.');

Writeln;

Line;

   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');

Line;

Write('Ваш выбор| ');

   Readln(x);

   Case x of
   '1':SearchGroup;
   '0':halt;
Else
Menu;
End;
End;









{Редактирование}
Procedure Edit;
Var
   i,j:integer;
   s1,s2,s3:string;
   Swop:boolean;

Begin

Clrscr;

Writeln('Редактирование записей базы данных:');
Writeln;

    MainTitleEdit;

For i:=1 To n do

    Begin

    s1:='';
    s2:='';
    s3:='';

    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';

    Writeln(i,'. ',Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group,' | ',Massive[i].Course);

    End;

Writeln;

Write('Введите номер редактируемой записи (укажите [0] для отмены): ');

Readln(i);

If i=0 then

 Begin
  Writeln('Отмена редактирования');
  Delay(500);
  Menu;
 End;

    s1:='';
    s2:='';
    s3:='';

    clrscr;

    Writeln('Изменяем:');
    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';

    MainTitleEdit;

    Writeln(i,'. ',Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group);
    Writeln;
    Writeln('Введите новые данные:');

Write('Фамилия........: '); Readln(Massive[i].SecondName);
Write('Имя............: '); Readln(Massive[i].FirstName);
Write('Отчество.......: '); Readln(Massive[i].FatherName);
Write('Номер группы...: '); Readln(Massive[i].Group);
Write('Курс...........: '); Readln(Massive[i].Course);

SaveAll;
ReadAll;

Writeln;
Write('Запись успешно отредактирована.');
Delay(1000);

Menu;

End;









{Удаление всех записей}

Procedure DeleteAll;
Var f:text; k:char;
Begin
Writeln;
Line;
Writeln;
Writeln('Вы действительно хотите удалить все данные? [указать "Y" для удаления]');
   Write('Ваш выбор| ');
Readln(k);

If (k='Y') or (k='y') then
Begin
Assign(f,'db.txt');
ReWrite(f);
Write('');
close(f);
Writeln;
Write('   Все данные успешно удалены');
Delay(1000);
Menu;
End;
Writeln('   Указан неверный символ');
Delay(500);
Writeln('   Переход в меню');
Delay(500);
Menu;

End;

{---------------------------------------}







{ ---------------------------- НЕКОРРЕКТНО УДАЛЯЕТ ЗАПИСЬ. УДАЛЯЕТ ДАННЫЕ ИЗ МАССИВА, НО В СТРОКЕ ОСТАЮТСЯ СИМВОЛЫ "|" КОТОРЫЕ РАЗДЕЛЯЮТ КОЛОНКИ }

{Удаление записи}

Procedure Deleting;
Var i,j:integer;
begin
Writeln('Удалить запись с номером: ');
readln(i);

Delete(Massive[i].SecondName,1,50);
Delete(Massive[i].FirstName,1,50);
Delete(Massive[i].FatherName,1,50);
Delete(Massive[i].Group,1,50);
Delete(Massive[i].Course,1,50);


SaveAll;
ReadAll;

Writeln;
Write('Запись успешно удалена.');
Delay(1000);

Menu;
End;









Procedure Password;
Var i,s:integer;
Begin
n:=5;
For i:= 1 To n  do  Begin
clrscr;
             Writeln('Количество попыток ввода правильного пароля: ', n);
             Write( 'Введите пароль: ' );
             Readln(S);
             n:=n-1;
             If S = 1234 then  Break
             Else  If   i <> 5 then continue;
              clrscr;
              goToxy(1,1);
              Writeln('Количество попыток ввода правильного пароля: 0');
              Delay(1000);
              Writeln( 'Доступ запрещен!');
              Delay(2000);
              Writeln( 'Завершение работы программы...');
              Delay(1000);
              Halt;
End;                                                                                                 
End;









{Меню}

Procedure Menu;

Var option:char;

Begin

clrscr;

ReadAll;
   Writeln('База данных "Студенты"');
   Line;
   Writeln(' Меню');
Line;
   Writeln('    |1| Добавление новой записи');
   Writeln('    |2| Просмотр записей');
   Writeln('    |3| Просмотр записей с сортировкой');
   Writeln('    |4| Редактирование записи');
   Writeln('    |5| Удаление записи');
   Writeln('    |6| Очистить базу данных');
Line;
   Writeln(' Поиск');
Line;
   Writeln('    |7| Поиск по фамилии');
   Writeln('    |8| Поиск по группе');
Line;
   Writeln('    |0| Выход из программы');
Line;
   Write('Ваш выбор| ');
 Readln(option);
   Case option of
   '1':Add;
   '2':WriteAll;
   '3':Sort;
   '4':Edit;
   '5':Deleting;
   '6':DeleteAll;
   '7':SearchSecondName;
   '8':SearchGroup;
   '0':halt;

   Else Menu;
   End;

End;



Begin

{Password;}

Menu;

End.

IUnknown

17.12.2011 3:45

Удалять надо не строки из содержимого ячейки массива, а собственно саму ячейку (сдвигать все содержимое массива на одну позицию влево, начиная от i-той) :

Procedure Deleting;
Var i, j:integer;
begin
   Writeln('Удалить запись с номером: ');
   readln(i);
   if i <= n then
   begin
      Move(Massive[i+1], Massive[i], Sizeof(Database) * (n - i));
      dec(n);
      SaveAll;
      // ReadAll;
      Writeln;
      Write('Запись успешно удалена.');
   end
   else write('Ошибка: неверный номер записи...');
   Delay(1000);
   // Menu; { <--- }
End;

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

Как видишь, я внес еще пару изменений в код: для начала - не надо пересчитывать содержимое файла в массив, зачем? Ты ж только что его записал туда... Добавлена так же проверка на ошибку в номере записи (можешь добавить еще проверку на i > 0, чтоб нельзя было ввести нулевых или отрицательных номеров).

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

Ошибки при организации меню (здесь я собрал часто встречающиеся ошибки. Так вот, ошибка №2 - это твой случай)

hemm

17.12.2011 4:29

Большое спасибо, Владимир.
Но вот насчет:

Цитата

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

Если убираю допустим после Добавления новой записи (Procedure Add) процедуру Menu, по завершению ввода данных программа завершает свою работу, а не переходит обратно в меню.

И вот если я буду из меню открывать процедуру, а затем опять же возвращаться в меню, в конечном итоге это забьет стек?

IUnknown

17.12.2011 5:04

Ах, так у тебя и сама процедура Menu неверно написана:

Procedure Menu;
Var option: char;
Begin
   ReadAll;

   repeat
      clrscr;
      Writeln('База данных "Студенты"');
      Line;
      Writeln(' Меню');
      Line;
      Writeln('    |1| Добавление новой записи');
      Writeln('    |2| Просмотр записей');
      Writeln('    |3| Просмотр записей с сортировкой');
      Writeln('    |4| Редактирование записи');
      Writeln('    |5| Удаление записи');
      Writeln('    |6| Очистить базу данных');
      Line;
      Writeln(' Поиск');
      Line;
      Writeln('    |7| Поиск по фамилии');
      Writeln('    |8| Поиск по группе');
      Line;
      Writeln('    |0| Выход из программы');
      Line;
      Write('Ваш выбор| ');

      Readln(option);
      Case option of
         '1':Add;
         '2':WriteAll;
         '3':Sort;
         '4':Edit;
         '5':Deleting;
         '6':DeleteAll;
         '7':SearchSecondName;
         '8':SearchGroup;
      end;
   until option = '0';
End;

Перед тем, как запускать - убедись, что больше нигде Menu рекурсивно не вызывается. Иначе по первому нажатию "0" не выйдешь изменю, придется нажимать столько раз, сколько было рекурсивных вызовов.

Цитата

И вот если я буду из меню открывать процедуру, а затем опять же возвращаться в меню, в конечном итоге это забьет стек?

Если будешь из Menu вызывать процедуру, а затем, в ее конце - опять вызывать Menu - то да, стек будет заполняться. Если даже не забьешь полностью - то займешь какое-то пространство, которое может пригодиться: стека много не бывает...

Я надеюсь, программа отлаживается в контролем стека? (Options->Compiler->Generated code->Stack checking включено?)

hemm

17.12.2011 5:31

Фантастика! Благодарю!

Нашел еще одну проблему. Если ввести очень длинную фамилию, то она смещает все данные и таблица нарушается.


{Вывод записей базы данных на экран}

Procedure WriteAll;
Var i,j:integer; s1,s2,s3,s4:string;

Begin
clrscr;

MainTitle;

For i:=1 To n do

                      {-------- ВОТ ЗДЕСЬ ПОДСКАЖИТЕ КАК УПРОСТИТЬ}
  Begin

    s1:='';
    s2:='';
    s3:='';
    s4:='';

    For j:=1 To 18-length(Massive[i].SecondName) do s1:=s1+' ';
    For j:=1 To 8-length(Massive[i].FirstName) do s2:=s2+' ';
    For j:=1 To 18-length(Massive[i].FatherName) do s3:=s3+' ';
    For j:=1 To 18-length(Massive[i].Group) do s4:=s4+' ';

    Writeln(Massive[i].SecondName,s1,' | ',Massive[i].FirstName,s2,' | ',Massive[i].FatherName,s3,' | ',Massive[i].Group, s4, ' | ', Massive[i].Course); 

{ ----------- МОЖНО ЛИ ЗДЕСЬ ОГРАНИЧИТЬ КОЛИЧЕСТВО ВЫВОДИМЫХ СИМВОЛОВ? ПОПЫТАЛСЯ УКАЗАТЬ Massive[i].SecondName: 5, НО ВИДИМО ЭТО ЛИШЬ ДЛЯ ЧИСЕЛ ПОДХОДИТ }

  End;

Line;

Writeln;
Write('    |Enter|.. Переход в меню');
Readln;

IUnknown

17.12.2011 6:39

Procedure WriteAll;
var
   i : integer;
Begin
   clrscr;
   MainTitle;
   For i:=1 To n do
      with Massive[i] do
      begin
         Writeln(
            copy(SecondName, 1, 16):18, ' | ',
            copy(FirstName, 1, 6):8,' | ',
            copy(FatherName, 1, 16):18, ' | ',
            copy(Group, 1, 16):18, ' | ',
            Course
         );
      end;
   Line;
   Writeln;
   Write('    |Enter|.. Переход в меню');
   Readln;
End;

Теперь какая бы не была фамилия - отобразятся только первые её 16 символов.

Цитата

МОЖНО ЛИ ЗДЕСЬ ОГРАНИЧИТЬ КОЛИЧЕСТВО ВЫВОДИМЫХ СИМВОЛОВ? ПОПЫТАЛСЯ УКАЗАТЬ Massive[i].SecondName: 5, НО ВИДИМО ЭТО ЛИШЬ ДЛЯ ЧИСЕЛ ПОДХОДИТ

Это и для чисел не подходит. Нельзя задать ширину поля меньше, чем нужно для вывода числа:

var i : integer;
begin
   i := 10241;
   writeln(i:4);
end.

не напечатает 1024, будет выведено число полностью.

IUnknown

17.12.2011 18:02

Итак, от изначальных 715 строк исходного файла в результате нехитрых действий осталось чуть больше 420:

Много кода, поэтому под спойлером (Показать/Скрыть)

Program Students;
Uses crt, dos;
type
   DataBase=
   record
      SecondName: string;
      FirstName:  string;
      FatherName: string;
      Group:      string;
      Course:     string;
   end;

const
   maxRecords = 50;
   dbFilename = 'db.txt';

var
   massive : array[1 .. maxRecords] of DataBase;
   n : integer;

{Считывание базы данных}
procedure ReadAll;
var f : text;
begin
   n := 0;
   Assign(f, dbFilename);
   {$I-} Reset(f); {$I+}

   if IOResult <> 0 then
      Writeln('Ошибка: невозможно открыть исходный файл. Повторите ввод.')
   else
   begin
      while not EOF(f) do
      begin
         inc(n);
         Readln(f, Massive[n].SecondName);
         Readln(f, Massive[n].FirstName);
         Readln(f, Massive[n].FatherName);
         Readln(f, Massive[n].Group);
         Readln(f, Massive[n].Course);
         Readln(f);
      end;
      close(f);
   end;
end;

{Сохранение отредактированной базы данных в файл}
procedure SaveAll;
var
   i : integer;
   f : text;
Begin
   Assign(f, dbFilename);
   Rewrite(f);
   for i := 1 To n do
   begin
      Writeln(f, Massive[i].SecondName);
      Writeln(f, Massive[i].FirstName);
      Writeln(f, Massive[i].FatherName);
      Writeln(f, Massive[i].Group);
      Writeln(f, Massive[i].Course);
      Writeln(f);
   end;
   close(f);
end;

function PrintRec(const Rec : Database) : boolean;
begin
   with Rec do
      Writeln(
         Copy(SecondName, 1, 16):18, ' | ',
         Copy(FirstName, 1, 6):8,' | ',
         Copy(FatherName, 1, 16):18, ' | ',
         Copy(Group, 1, 16):18, ' | ',
         Course
      );
   PrintRec := true;
end;

procedure InputRec(var Rec : Database);
begin
   with Rec do
   begin
      Write('Фамилия........: '); Readln(SecondName);
      Write('Имя............: '); Readln(FirstName);
      Write('Отчество.......: '); Readln(FatherName);
      Write('Номер группы...: '); Readln(Group);
      Write('Курс...........: '); Readln(Course);
   end;
end;

{Линия}
procedure Line;
var k : integer;
Begin
   for k := 1 to 79 do write('-');
   Writeln;
End;

{Оглавление}
procedure MainTitle;
begin
   Line;
   Write('Фамилия            |'); Write(' Имя      |');
   Write(' Отчество           |'); Write(' Группа             |');
   Write(' Курс');
   Writeln;
   Line;
End;

{Оглавление редактирования}
procedure MainTitleEdit;
begin
   Line;
   Write('№ | Фамили            |'); Write(' Имя      |');
   Write(' Отчество           |'); Write(' Группа             |');
   Writeln;
   Line;
end;

{Оглавление процедуры поиска}
procedure SearchTitle;
begin
   Line;
   Writeln('Поиск...');
   Line;
   Writeln;
end;

{Добавление записи}
procedure Add;
begin
   Clrscr;
   inc(n);
   Writeln('Добавление новой записи о студенте:');
   Writeln;
   InputRec(Massive[n]);
   SaveAll;
   Writeln;
   Write('Запись успешно добавлена в базу данных');
   Delay(1000);
end;

{Вывод записей базы данных на экран}
procedure WriteAll;
var i : integer;
begin
   ClrScr;
   MainTitle;
   For i := 1 To n do
      PrintRec(Massive[i]);
   Line;
   Writeln;
   Write('    |Enter|.. Переход в меню');
   Readln;
end;

{Вывод записей базы данных с сортировкой на экран}
procedure Sort;

   function Exchange(Var A, B : Database) : boolean;
   var T : Database;
   begin
      T := A; A := B; B := T;
      Exchange := true;
   end;

var
   i, nn : integer;
   Xchanged : boolean;
begin
   ClrScr;

   nn := n;
   repeat
      Xchanged := false;
      for i := 1 to nn - 1 do
      begin
         if Massive[i].SecondName > Massive[i+1].SecondName then
            Xchanged := Exchange(Massive[i], Massive[i+1]);
      end;
      nn := nn-1;
   until not Xchanged;
   MainTitle;
   WriteAll;
   Line;
End;

{Поиск по фамилии}
procedure SearchSecondName;
var
   SN : string;
   i : integer;
   Found : boolean;
   x : char;
begin
   Clrscr;
   SearchTitle;
   Write('Введите фамилию студента: ');
   Readln(SN);
   Writeln;
   Found := false;
   MainTitle;

   for i := 1 to n do
      if Massive[i].SecondName = SN then
         Found := PrintRec(Massive[i]);

   Line;
   if not Found then Writeln('Записей с такой фамилией не обнаружено либо имя указано неверно');
   Writeln;
   Line;
   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');
   Line;
   Write('Ваш выбор| ');
   Readln(x);
   case x of
      '1' : SearchSecondName;
      '0' : Halt;
   end;
end;

{Поиск по группе}
procedure SearchGroup;
var
   SG : string;
   i : integer;
   Found : boolean;
   x : char;
begin
   ClrScr;
   SearchTitle;
   Write('Введите номер группы: ');
   Readln(SG);
   Writeln;
   Found := false;
   MainTitle;

   for i := 1 to n do
      if Massive[i].Group = SG then
         Found := PrintRec(Massive[i]);

   Line;
   if not Found then Writeln('Записей с таким номером группы не обнаружено.');
   Writeln;
   Line;
   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');
   Line;
   Write('Ваш выбор| ');
   Readln(x);
   case x of
      '1' : SearchGroup;
      '0' : Halt;
   end;
end;

{Редактирование}
procedure Edit;
var
   i : integer;
begin
   Clrscr;
   Writeln('Редактирование записей базы данных:');
   Writeln;
   MainTitleEdit;
   for i := 1 to n do
   begin
      Write(i:2, '.'); PrintRec(Massive[i]);
   end;

   Writeln;
   Write('Введите номер редактируемой записи (укажите [0] для отмены): ');
   Readln(i);
   if i = 0 then
   begin
      Writeln('Отмена редактирования');
      Delay(500);
   end
   else
   begin
      clrscr;
      Writeln('Изменяем:');
      MainTitleEdit;
      Write(i:2, '.'); PrintRec(Massive[i]);
      Writeln;
      Writeln('Введите новые данные:');
      InputRec(Massive[i]);

      SaveAll;
      ReadAll;
      Writeln;
      Write('Запись успешно отредактирована.');
      Delay(1000);
   end;
end;

{Удаление всех записей}
procedure DeleteAll;
var
   f : text;
   k : char;
begin
   Writeln;
   Line;
   Writeln;
   Writeln('Вы действительно хотите удалить все данные? [указать "Y" для удаления]');
   Write('Ваш выбор| ');
   Readln(k);
   If k in ['Y', 'y'] then
   begin
      Assign(f, dbFilename);
      ReWrite(f);
      Write(''); // o_O
      close(f);
      Writeln;
      Write('   Все данные успешно удалены');
      Delay(1000);
   end
   else
   begin
      Writeln('   Указан неверный символ');
      Delay(500);
      Writeln('   Переход в меню');
      Delay(500);
   end;
end;

{Удаление записи}
procedure Deleting;
var i : integer;
begin
   Writeln('Удалить запись с номером: ');
   Readln(i);
   if i <= n then
   begin
      Move(Massive[i+1], Massive[i], Sizeof(Database) * (n - i));
      dec(n);
      SaveAll;
      Writeln;
      Write('Запись успешно удалена.');
   end
   else write('Ошибка: неверный номер записи...');
   Delay(1000);
end;

procedure Password;
var
   i, s : integer;
   Attempts : Integer;
begin
   Attempts := 5;
   for i := 1 to Attempts do
   begin
      clrscr;
      Writeln('Количество попыток ввода правильного пароля: ', n);
      Write( 'Введите пароль: ' );
      Readln(S);
      if S = 1234 then break
      else
         if i <> Attempts then continue;

      clrscr;
      goToxy(1,1);
      Writeln('Количество попыток ввода правильного пароля: 0');
      Delay(1000);
      Writeln( 'Доступ запрещен!');
      Delay(2000);
      Writeln( 'Завершение работы программы...');
      Delay(1000);
      Halt;
   end;
end;

{Меню}
procedure Menu;
var option: char;
begin
   ReadAll;

   repeat
      clrscr;
      Writeln('База данных "Студенты"');
      Line;
      Writeln(' Меню');
      Line;
      Writeln('    |1| Добавление новой записи');
      Writeln('    |2| Просмотр записей');
      Writeln('    |3| Просмотр записей с сортировкой');
      Writeln('    |4| Редактирование записи');
      Writeln('    |5| Удаление записи');
      Writeln('    |6| Очистить базу данных');
      Line;
      Writeln(' Поиск');
      Line;
      Writeln('    |7| Поиск по фамилии');
      Writeln('    |8| Поиск по группе');
      Line;
      Writeln('    |0| Выход из программы');
      Line;
      Write('Ваш выбор| ');

      Readln(option);
      case option of
         '1':Add;
         '2':WriteAll;
         '3':Sort;
         '4':Edit;
         '5':Deleting;
         '6':DeleteAll;
         '7':SearchSecondName;
         '8':SearchGroup;
      end;
   until option = '0';
end;

begin
   Password;
   Menu;
end.

Можно еще покумекать над объединением двух процедур поиска в одну (я где-то на форуме выкладывал пример, если не ошибаюсь, надо будет поискать). Также стоит подумать над вынесением часто повторяющихся

Write('bla-bla-bla');
Delay(...);

в отдельную процедуру. В общем, заготовка у тебя есть, допиливай

-TarasBer-

17.12.2011 18:13

Спойлер (Показать/Скрыть)

IUnknown

17.12.2011 18:48

Спойлер (Показать/Скрыть)

hemm

18.12.2011 2:57

Допилил. Все работает как надо.

Единственное, что при редактировании (если в базе больше 10 записей) нельзя прокрутить и посмотреть первые.

Получается такая штука:

Спойлер (Показать/Скрыть)

Program Students;
Uses crt, dos;
type
   DataBase=
   record
      SecondName: string;
      FirstName:  string;
      FatherName: string;
      Group:      string;
      Faculty:    string;
      Number:     string;
   End;

const
   maxRecords = 999;
   dbFilename = 'db.txt';

Var
   massive : array[1 .. maxRecords] of DataBase;
   n : integer;

{Считывание базы данных}
Procedure ReadAll;
Var f : text;
Begin
   n := 0;
   Assign(f, dbFilename);
   {$I-} Reset(f); {$I+}

   if IOResult <> 0 then
      Writeln('Ошибка: невозможно открыть исходный файл. Повторите ввод.')
   else
   Begin
      while not EOF(f) do
      Begin
         inc(n);
         Readln(f, Massive[n].SecondName);
         Readln(f, Massive[n].FirstName);
         Readln(f, Massive[n].FatherName);
         Readln(f, Massive[n].Group);
         Readln(f, Massive[n].Faculty);
         Readln(f, Massive[n].Number);
         Readln(f);
      End;
      close(f);
   End;
End;


{Линия}
Procedure Line;
Var k : integer;
Begin
   for k := 1 to 79 do write('-');
   Writeln;
End;

{Сохранение отредактированной базы данных в файл}
Procedure SaveAll;
Var
   i : integer;
   f : text;
Begin
   Assign(f, dbFilename);
   Rewrite(f);
   for i := 1 To n do
   Begin
      Writeln(f, Massive[i].SecondName);
      Writeln(f, Massive[i].FirstName);
      Writeln(f, Massive[i].FatherName);
      Writeln(f, Massive[i].Group);
      Writeln(f, Massive[i].Faculty);
      Writeln(f, Massive[i].Number);
      Writeln(f);
   End;
   close(f);
End;

{Ограничение на количество выводимых символов в таблице}
Function PrintRec(const Rec : Database) : boolean;
Begin
   With Rec do
      Writeln(
         Copy(SecondName, 1, 15):16, '|',
         Copy(FirstName, 1, 13):14,'|',
         Copy(FatherName, 1, 13):14, '|',
         Copy(Group, 1, 7):8, '|',
         Copy(Faculty, 1,8):9, '|',
         Copy(Number, 1,7):8
      );
Line;
   PrintRec := true;

End;

Procedure InputRec(Var Rec : Database);
Begin
   with Rec do
   Begin
      Write('Фамилия........: '); Readln(SecondName);
      Write('Имя............: '); Readln(FirstName);
      Write('Отчество.......: '); Readln(FatherName);
      Write('Номер группы...: '); Readln(Group);
      Write('Факультет......: '); Readln(Faculty);
      Write('Номер билета...: '); Readln(Number);
   End;
End;

{Оглавление процедуры поиска}
Procedure SearchTitle;
Begin
   Writeln('Поиск');
   Writeln;
End;

{Добавление записи}
Procedure Add;
Begin
   Clrscr;
   inc(n);
   Writeln('Добавление записи');
   Writeln;
   InputRec(Massive[n]);
   SaveAll;
   Writeln;
   Write('Запись добавлена!');
   Delay(500);
End;

{Оглавление}
Procedure MainTitle;
Begin
   Line;
   Write('    Фамилия     |'); Write('      Имя     |');
   Write('   Отчество   |'); write(' Группа |'); Write(' Фак-тет |');
   Write(' Билет ');
   Writeln;
   Line;

End;


{Вывод записей базы данных на экран}
Procedure WriteAll;
Var i : integer;
Begin
   ClrScr;
   MainTitle;
   For i := 1 To n do
      PrintRec(Massive[i]);

   Writeln;
   Write('    |Enter|.. Переход в меню');
   Readln;
End;

{Вывод записей базы данных с сортировкой на экран}
Procedure Sort;

   function Exchange(Var A, B : Database) : boolean;
   Var T : Database;
   Begin
      T := A; A := B; B := T;
      Exchange := true;
   End;

Var
   i, nn : integer;
   Xchanged : boolean;
Begin
   ClrScr;

   nn := n;
   repeat
      Xchanged := false;
      for i := 1 to nn - 1 do
      Begin
         if Massive[i].SecondName > Massive[i+1].SecondName then
            Xchanged := Exchange(Massive[i], Massive[i+1]);
      End;
      nn := nn-1;
   until not Xchanged;
   MainTitle;
   WriteAll;
End;

{Поиск по фамилии}
Procedure SearchSecondName;
Var
   SSN : string;
   i : integer;
   Found : boolean;
   x : char;
Begin
   Clrscr;
   SearchTitle;
   Write('Введите фамилию студента: ');
   Readln(SSN);
   Writeln;
   Found := false;
   MainTitle;

   for i := 1 to n do
      if Massive[i].SecondName = SSN then
         Found := PrintRec(Massive[i]);
   if not Found then Writeln('Записей с такой фамилией не обнаружено.');
   Writeln;
   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');
   Writeln;
   Write('Ваш выбор| ');
   Readln(x);
   case x of
      '1' : SearchSecondName;
      '0' : Halt;
   End;
End;

{Поиск по группе}
Procedure SearchGroup;
Var
   SG : string;
   i : integer;
   Found : boolean;
   x : char;
Begin
   ClrScr;
   SearchTitle;
   Write('Введите номер группы: ');
   Readln(SG);
   Writeln;
   Found := false;
   MainTitle;

   for i := 1 to n do
      if Massive[i].Group = SG then
         Found := PrintRec(Massive[i]);
   if not Found then Writeln('Записей с таким номером группы не обнаружено.');
   Writeln;
   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');
   Writeln;
   Write('Ваш выбор| ');
   Readln(x);
   case x of
      '1' : SearchGroup;
      '0' : Halt;
   End;
End;




{Поиск по номеру билета}
Procedure SearchNumber;

Var
   SN : string;
   i : integer;
   Found : boolean;
   x : char;
Begin
   Clrscr;
   SearchTitle;
   Write('Введите номер билета: ');
   Readln(SN);
   Writeln;
   Found := false;
   MainTitle;

   for i := 1 to n do
      if Massive[i].Number = SN then
         Found := PrintRec(Massive[i]);
   if not Found then Writeln('Записей с таким номером билета не обнаружено');
   Writeln;
   Writeln('    |1|...... Повторный поиск');
   Writeln('    |0|...... Выход из программы');
   Writeln('    |Enter|.. Переход в меню');
   Writeln;
   Write('Ваш выбор| ');
   Readln(x);
   case x of
      '1' : SearchNumber;
      '0' : Halt;
   End;
End;





{Оглавление редактирования}
Procedure MainTitleEdit;
Begin

   Line;
   write('  # |'); Write('    Фамилия     |'); Write('      Имя     |');
   Write('   Отчество   |'); write(' Группа |'); Write(' Фак-тет |');
   Write(' Билет ');
   Writeln;
   Line;
End;


{Редактирование}
Procedure Edit;
Var
   i : integer;
Begin
   Clrscr;
   Writeln('Редактирование');
   Writeln;
   MainTitleEdit;
   for i := 1 to n do
   Begin
      Write(i:4, '.'); PrintRec(Massive[i]);
   End;

   Writeln;
   Write('Введите номер редактируемой записи (укажите [0] для отмены / выхода в меню): ');
   Readln(i);
   if i = 0 then
   Begin
   End
   else
   Begin
      clrscr;
      Writeln('Изменяем:');
      MainTitle;
      PrintRec(Massive[i]);
      Writeln;
      Writeln('Введите новые данные:');
      InputRec(Massive[i]);

      SaveAll;
      ReadAll;
      Writeln;
      Write('Запись успешно отредактирована.');
      Delay(1000);
   Edit;
   End;
End;

{Удаление записи}
Procedure DeleteRecord;
Var i : integer;

Begin
   Clrscr;
   Writeln('Удаление');
   Writeln;

   MainTitleEdit;
   for i := 1 to n do
   Begin
      Write(i:4, '.'); PrintRec(Massive[i]);
   End;

   Writeln;

   Write('Удалить запись с номером (укажите [0] для отмены / выхода в меню): ');
   Readln(i);
   if i=0 then
   Begin
   end
   else if i <= n then
   Begin
      Move(Massive[i+1], Massive[i], Sizeof(Database) * (n - i));
      dec(n);
      SaveAll;
      Writeln;
      Write('Запись успешно удалена!');
   DeleteRecord;
   End
   else write('Ошибка: неверный номер записи...');
   Delay(500);
End;

Procedure Password;
Var
   i: integer;
   User, Pass: string;
   Attempts : Integer;
Begin
   Attempts := 1;
   for i := 5 downto Attempts do
   Begin

      clrscr;
      textbackground(7); textcolor(0);
      Write('Количество попыток ввода правильного пароля:');
      textbackground(8); textcolor(15);
      write(' ', i);

      Writeln;
      textbackground(7); textcolor(0);
      Write( 'Введите фамилию пользователя:');
      textbackground(8); textcolor(15);
      write(' ');
      Readln(User);
      textbackground(7); textcolor(0);
      Write( 'Введите пароль:');
      textbackground(8); textcolor(15);
      write(' ');
      Readln(Pass);

      if (User = 'Дроздов') And (Pass='АСОИ') then break
      else
         if i <> Attempts then continue;
      clrscr;
      textbackground(7); textcolor(4);
      Delay(500);
      Writeln( 'Доступ запрещен!');
      Delay(500);
      Write( 'Завершение работы программы!');
      Delay(1000);
      textbackground(8); textcolor(15);
      Halt;
   End;
End;


{Меню}
Procedure Menu;
Var option: char;
Begin
   ReadAll;
   repeat
      clrscr;
      textbackground(7); textcolor(0);
      Writeln('   База данных "Студенты"   ');
      textbackground(8); textcolor(15);

      textbackground(7); textcolor(0);
      Writeln;
      Writeln(' Меню ');
      Writeln;
      textbackground(8); textcolor(15);
      Writeln('    |1| Добавление новой записи');
      Writeln('    |2| Просмотр записей');
      Writeln('    |3| Просмотр записей с сортировкой по фамилии');
      Writeln('    |4| Редактирование записи');
      Writeln('    |5| Удаление записи');
      Writeln;
      textbackground(7); textcolor(0);
      Writeln(' Поиск ');
      textbackground(8); textcolor(15);
      Writeln;
      Writeln('    |6| Поиск по фамилии');
      Writeln('    |7| Поиск по группе');
      Writeln('    |8| Поиск по номеру билета');
      Writeln;
      textbackground(7); textcolor(0);
      Writeln(' Выход ');
      textbackground(8); textcolor(15);
      Writeln;
      Writeln('    |9| Выход к меню ввода пароля');
      Writeln('    |0| Выход из программы');
      Writeln;
      textbackground(7); textcolor(0);
      Write('Ваш выбор |');
      textbackground(8); textcolor(15);
      write(' ');
      Readln(option);
      case option of
         '1':Add;
         '2':WriteAll;
         '3':Sort;
         '4':Edit;
         '5':DeleteRecord;
         '6':SearchSecondName;
         '7':SearchGroup;
         '8':SearchNumber;
         '9':Password;
         End;
   until option = '0';
End;
Begin
Password;
   Menu;
End.

IUnknown

18.12.2011 3:02

Прокрутку я тоже как-то показывал на форуме, поищи.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.