Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.05.2016, 10:01   #1
Kamikaze0
 
Регистрация: 22.03.2016
Сообщений: 3
По умолчанию Программа базы данных

имеется следующий код

Код:
Program abc;

type
  ank = record
    FIO: string;
    pol: char;
    Age: string;
    Adr: string;
  end;

var
  stud: array of ank; zap,str:string;

  x,k,n,a,b,i: integer;

procedure zapol(var dmas: array of ank);
var
  i,a,b,p: integer;
  begin
    Writeln('Kol-vo dobavlyaemyx anket');
    readln(p);
    a := length(stud);
    b := length(stud) + p - 1;
    setlength(dmas, length(dmas) + p);
    for i:= a to b do
   begin
      writeln('Vvedite svedeniya o ', (i + 1), '-m student');
      writeln('Zapolnite FIO');
      readln(dmas[i].FIO);
      writeln('Pol');
      readln(dmas[i].pol);
      writeln('Vozrast');
      readln(dmas[i].Age);
      writeln('Adres');
      readln(dmas[i].Adr);
    end; 
  end;

procedure prosmotr(dmas: array of ank);
var
  i: integer;
begin
  for i := 0 to Length(dmas) - 1 do
  begin
    write('Anketa №', (i + 1), ': ');
    write('FIO:', dmas[i].FIO, '; ');
    write('Pol:', dmas[i].pol, '; ');
    write('Vozrast:', dmas[i].Age, '; ');
    write('Adres:', dmas[i].Adr, '; ');
    writeln;
  end;
end;

procedure prosmotr1(dmas: array of ank);
var
  n:integer;
begin
  readln(n);
  n:= n - 1;
  write('FIO:', dmas[n].FIO, '; ');
  write('POL:', dmas[n].pol, '; ');
  write('AGE:', dmas[n].age, '; ');
  write('Adres:', dmas[n].Adr, '; ');
  writeln;
end;

procedure udal(var dmas: array of ank);
var
 i: integer;
begin
  for i :=k to a Do
  begin
    dmas[i]:=dmas[i+1];
   end;
   SetLength(dmas, Length(dmas) - 1);
 End;
  
procedure izmenit(dmas: array of ank);
 var
  y: 1..5;
  i: integer;
begin
  
  repeat
    writeln;
    writeln('1:Zamena FIO');
    writeln('2:Zamena Pola');
    writeln('3:Zamena vozrasta');
    writeln('4:Zamena adresa');
    writeln('5:Vixod v glavnoe menu');
    writeln('Vvedite nomer operacii');
    readln(y);
    case y of
      1:
        begin
          writeln('Vvedite novoe FIO');
          readln(dmas[i].FIO);
        end;
      2: 
        begin
          writeln('Vvedite noviy pol');
          readln(dmas[i].pol);
        end;
      3: 
        begin
          writeln('Vvedite noviy vozrast');
          readln(dmas[i].Age);
        end;
      4: 
        begin
          writeln('Vvedite noviy adres');
          readln(dmas[i].Adr);
        end;
    end;
  until y = 5;
end;

Procedure poisk(var dmas: array of ank);
var i:integer;
Begin
  for i:=0 to Length(dmas)-1 do
  begin
  str:=dmas[i].FIO;
  str:=concat(str,dmas[i].pol);
  str:=concat(str,dmas[i].Age);
  str:=concat(str,dmas[i].Adr);
  if pos(zap,str)>0 then
   writeln(dmas[i]); 
 end;
 end;
  
procedure sort(var dmas: array of ank);
var
  y: 1..4;
  n: 1..2;
  i, j: integer;
begin
  writeln;
  
  readln(n);
  writeln('1:FIO');
  writeln('2:Pol');
  writeln('3:Age');
  writeln('4:Adres');
  writeln('Vvedite nomer kriteriya sortirovki');
  readln(y);
  case y of
    1: 
      begin
        begin
          for j := 1 to length(dmas) - 1 do
            for i := 0 to length(dmas) - j - 1 do
              if dmas[i].FIO > dmas[i + 1].FIO then
                swap(dmas[i], dmas[i + 1]);
        end;
        if n = 1 then reverse(dmas);
      end;
    2: 
      begin
        begin
          for j := 1 to length(dmas) - 1 do
            for i := 0 to length(dmas) - j - 1 do
              if dmas[i].pol > dmas[i + 1].pol then
                swap(dmas[i], dmas[i + 1]);
        end;
        if n = 1 then reverse(dmas);
      end;
    3: 
      begin
        begin
          for j := 1 to length(dmas) - 1 do
            for i := 0 to length(dmas) - j - 1 do
              if dmas[i].Age > dmas[i + 1].Age then
                swap(dmas[i], dmas[i + 1]);
        end;
        if n = 1 then reverse(dmas);
      end;
    4: 
      begin
        begin
          for j := 1 to length(dmas) - 1 do
            for i := 0 to length(dmas) - j - 1 do
              if dmas[i].Adr > dmas[i + 1].Adr then
                swap(dmas[i], dmas[i + 1]);
        end;
        if n = 1 then reverse(dmas);
      end;
  end;
end;



    
begin
  setlength(stud, 0);
  
repeat   
    writeln;
    writeln('MENU');
    writeln('1:Dobavlenie anketi');
    writeln('2:Delete');
    writeln('3:Izmenenie anketi');
    writeln('4:Prosmotr K-oi anketi');
    writeln('5:Vivod vseh anket');
    writeln('6:Sort');
    writeln('7:Search');
    writeln('8:Exit');
    writeln('Vvedite number operaci');
    readln(x);
    case x of
      1: 
       zapol(stud);
      2:
       Begin
       Writeln('Vvedite number udalyaemoi anketi');
       readln(n);
       k := n - 1;
       a := Length(stud) - 2;
       udal(stud);
       End;
      3: 
        Begin
        
        Writeln('Vvedite nomer anketi');
        readln(i);
        izmenit(stud);
        End;
      4: 
         Begin
         Writeln('Vvedite number anketi');
         prosmotr1(stud);
         End;
      5: prosmotr(stud);
      6:
         Begin
         writeln('Najmite 1 dlya sortirovki po ubivaniy, 2 - po vozrastaniy');
         sort(stud);
         End;
      7:
        Begin
        Writeln('Vvedite poiskovoi zapros');
        Readln(zap);
        poisk(stud);
        end;
      
    end;

  until x=8;
  End.


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

_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

Последний раз редактировалось Serge_Bliznykov; 12.05.2016 в 10:12.
Kamikaze0 вне форума Ответить с цитированием
Старый 12.05.2016, 10:14   #2
Dvoishnik
Форумчанин
 
Регистрация: 12.02.2011
Сообщений: 808
По умолчанию

что за неуважение к людям?
1 оформите код правильно
а) для оформления кода на форуме используются теги [CODE][ /CODE]
б)где комментарии к коду?
в)табуляцию хотелось бы видеть.
2 не БД а файловая система вас интересует?? будьте добры задание показать как вам его преподаватель дал.
Терпение!Дежурный экстрасенс скоро свяжется с вами!
Dvoishnik вне форума Ответить с цитированием
Старый 12.05.2016, 10:26   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
т.е. при создании одной анкеты создается текстовый файл.
а почему именно текстовый? С ним крайне неудобно работать (чтобы загружать его в массив, нужно разбирать строки, возможны аварийные ситуации и т.д.).
Текстовый файл удобно делать для вывода информации (читай - отчёт),
а данные хранить либо в типизированных файлах (тогда в описании записи нужно string заменить на string[xxx] - где xxx - максимальная длина этой строки),
либо вообще в файле своей собственной структуры.
Если бы это была не учебная программа, я бы предложил хранить данные в "настоящей" БД (да хоть тот же mdb формат).
Это раз.

второе. удобнее поступать так: загружать данные в массив, там их редактировать, сортировать, добавлять, удалять и всё такое прочее.
И потом, по требованию пользователя - выполнять сохранение в указанный файл. (нужно добавить два пункта:
прочитать анкету из файла
сохранить анкету в файл
А собственно работа с массивом у Вас уже есть.

третье.
Вы какую помощь ожидаете?
Добавить чтение из файла и запись в файл - не очень сложно.
Начните делать, выложите свои попытки, думаю, что Вам помогут.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 16.05.2016, 22:07   #4
Kamikaze0
 
Регистрация: 22.03.2016
Сообщений: 3
По умолчанию

Код:
Program abc; 

type 
ank = record 
FIO: string; 
pol: string; 
Age: string; 
Adr: string; 
end; 

var 
stud: array of ank; zap,str:string; 
u,u1: string;
t: text;
x,n,i,r,r1,r2: integer; 
bol:boolean;



procedure zapol(var dmas: array of ank);//процедура заполнения анкеты
var 
i,j,a,b,p,k: integer; 
begin 
readln(p); 
a :=1; 
k:=length(dmas);
b := length(stud) + p; 
i:=a;
for j:=1 to length(dmas) do //определение пустых ячеек и расширение массива в случае необходимости
begin
assignfile(t,i+'.txt');
    reset (t);
        read (t, u);
    closefile(t);
    if u='' then p:=p-1;
    end;
while i<=b do 
begin
if i<=length(dmas) then
begin
assignfile(t,i+'.txt');
    reset (t);
        read (t, u);
    closefile(t);
    end;
    if i>length(dmas) then
    begin
     if p>0 then
     begin
    setlength(dmas, length(dmas) + p);
    end;
    end;
    if (u='') or (i>k) then begin
writeln('Vvedite svedeniya o ', (i), '-m student'); 
writeln('Zapolnite FIO'); 
readln(dmas[i-1].FIO); 
writeln('Pol'); 
readln(dmas[i-1].pol); 
writeln('Vozrast'); 
readln(dmas[i-1].Age); 
writeln('Adres'); 
readln(dmas[i-1].Adr); 
assignfile (t,i+'.txt');
rewrite (t);
write(t,'Anketa №', (i), ': '); 
write(t,'FIO:', dmas[i-1].FIO, '; '); 
write(t,'Pol:', dmas[i-1].pol, '; '); 
write(t,'Vozrast:', dmas[i-1].Age, '; '); 
write(t,'Adres:', dmas[i-1].Adr, '; ');
close(t);
i:=i+1;
end
else
i:=i+1;
end;
end; 

procedure prosmotr(dmas: array of ank);//процедура вывода на экран всех анкет 
var 
i: integer;
u: string; 
begin 
for i := 0 to Length(dmas) - 1 do 
begin 
assignfile(t,i+1+'.txt');
    reset (t);
    while not eof (t) do begin
        read (t, u);
        writeln (u);
    end;
    closefile(t);
writeln; 
if not fileexists(i+1+'.txt') then
writeln ('Файл ',i+1+'.txt' ,' не найден, либо не существует');
end;
end; 

procedure prosmotr1(dmas: array of ank);//процедура вывода на экран одной анкеты 
var 
n:integer; 
begin 
readln(n); 
if n<=length(dmas) then 
begin 
assignfile(t,n+'.txt');
    reset (t);
    while not eof (t) do begin
        read (t, u);
        writeln (u);
    end;
    closefile(t);
writeln; 
end
else
if not fileexists(n+'.txt') then
writeln ('Файл ',n+'.txt' ,' не найден, либо не существует');
end; 

procedure udal(var n: integer; dmas: array of ank);//процедура удаления выбраной анкеты 
var 
i: integer; 
begin 
if n<=length(dmas) then 
begin 
assignfile(t,n+'.txt');
    rewrite (t);
    closefile(t);
writeln
end else
if not fileexists(i+1+'.txt') then
writeln ('Файл ',i+1+'.txt' ,' не найден, либо не существует'); 
end; 

procedure izmenit(dmas: array of ank);//процедура изменения анкеты
var 
y: 1..5; 
i: integer; 
begin 

if i<=length(dmas) then 
begin 

repeat 
writeln; 
writeln('1:Zamena FIO'); 
writeln('2:Zamena Pola'); 
writeln('3:Zamena vozrasta'); 
writeln('4:Zamena adresa'); 
writeln('5:Vixod v glavnoe menu'); 
writeln('Vvedite nomer operacii'); 
readln(y); 
case y of 
1: 
begin 
writeln('Vvedite novoe FIO'); 
readln(dmas[i].FIO); 
end; 
2: 
begin 
writeln('Vvedite noviy pol'); 
readln(dmas[i].pol); 
end; 
3: 
begin 
writeln('Vvedite noviy vozrast'); 
readln(dmas[i].Age); 
end; 
4: 
begin 
writeln('Vvedite noviy adres'); 
readln(dmas[i].Adr); 
end; 
end; 
until y = 5; 
end ;//else writeln('Dannaya anketa otsutstviet');
assignfile (t,y+'.txt');
rewrite (t);
write(t,'Anketa №', (y), ': '); 
write(t,'FIO:', dmas[i].FIO, '; '); 
write(t,'Pol:', dmas[i].pol, '; '); 
write(t,'Vozrast:', dmas[i].Age, '; '); 
write(t,'Adres:', dmas[i].Adr, '; ');
close(t); 
END; 

Procedure poisk(var dmas: array of ank);//процедура поиска выражения по анкетам 
var i:integer; 
Begin 
for i:=0 to Length(dmas)-1 do 
begin 
str:=dmas[i].FIO; 
str:=concat(str,dmas[i].pol); 
str:=concat(str,dmas[i].Age); 
str:=concat(str,dmas[i].Adr); 
if pos(zap,str)>0 then 
writeln(dmas[i]); 
end; 
end; 

procedure sort(var dmas: array of ank);//процедура сортировки анкет 
var 
y: 1..4; 
n: 1..2; 
i, j: integer; 
begin 
writeln; 

readln(n); 
writeln('1:FIO'); 
writeln('2:Pol'); 
writeln('3:Age'); 
writeln('4:Adres'); 
writeln('Vvedite nomer kriteriya sortirovki'); 
readln(y); 
case y of 
1: 
begin 
begin 
for j := 1 to length(dmas) - 1 do 
for i := 0 to length(dmas) - j - 1 do 
if dmas[i].FIO > dmas[i + 1].FIO then 
swap(dmas[i], dmas[i + 1]); 
end; 
if n = 1 then reverse(dmas); 
end; 
2: 
begin 
begin 
for j := 1 to length(dmas) - 1 do 
for i := 0 to length(dmas) - j - 1 do 
if dmas[i].pol > dmas[i + 1].pol then 
swap(dmas[i], dmas[i + 1]); 
end; 
if n = 1 then reverse(dmas); 
end; 
3: 
begin 
begin 
for j := 1 to length(dmas) - 1 do 
for i := 0 to length(dmas) - j - 1 do 
if dmas[i].Age > dmas[i + 1].Age then 
swap(dmas[i], dmas[i + 1]); 
end; 
if n = 1 then reverse(dmas); 
end; 
4: 
begin 
begin 
for j := 1 to length(dmas) - 1 do 
for i := 0 to length(dmas) - j - 1 do 
if dmas[i].Adr > dmas[i + 1].Adr then 
swap(dmas[i], dmas[i + 1]); 
end; 
if n = 1 then reverse(dmas); 
end; 
end; 
end; 




begin	 
i:=0;
if fileexists(i+1+'.txt') then bol:=false else bol:=true;
while bol=false do
begin
//сброс данных из всех файлов в массив dmas 
assignfile(t,i+1+'.txt');
    reset (t);
    while not eof (t) do begin
        read (t,u);
    end;
    close(t);
    setlength(stud,length(stud)+1) ;
    r1:=0;
    for r:=1 to length(u) do
    if u[r]=':' then
    begin
    r2:=1; 
    r1:=r1+1;
    if r1=2 then
    begin
    while u[r+r2]<>';' do
    begin
    u1:=u1+u[r+r2];
    r2:=r2+1;
    end;
stud[i].FIO:=u1;
u1:='';
end; 

    if r1=3 then
    begin
    while u[r+r2]<>';' do
    begin
    u1:=u1+u[r+r2];
    r2:=r2+1;
    end;
stud[i].pol:=u1;
u1:='';
end; 
    if r1=4 then
    begin
    while u[r+r2]<>';' do
    begin
    u1:=u1+u[r+r2];
    r2:=r2+1;
    end;
stud[i].Age:=u1;
u1:='';
end;

    if r1=5 then
    begin
    while u[r+r2]<>';' do
    begin
    u1:=u1+u[r+r2];
    r2:=r2+1;
    end;
stud[i].Adr:=u1;
u1:='';
end;
end;
    i:=i+1;
    if fileexists(i+1+'.txt') then bol:=false else bol:=true;
end;
repeat 
writeln; 
writeln('MENU'); 
writeln('1:Dobavlenie anketi'); 
writeln('2:Delete'); 
writeln('3:Izmenenie anketi'); 
writeln('4:Prosmotr K-oi anketi'); 
writeln('5:Vivod vseh anket'); 
writeln('6:Sort'); 
writeln('7:Search'); 
writeln('8:Exit'); 
writeln('Vvedite number operaci'); 
readln(x); 
case x of 
1: 
Begin 
Writeln('Kol-vo dobavlyaemyx anket'); 
zapol(stud); 
end; 
2: 
Begin 
Writeln('Vvedite number udalyaemoi anketi'); 
readln(n); 
udal(n,stud);
End; 
3: 
Begin 
Writeln('Vvedite nomer anketi'); 
readln(i); 
izmenit(stud); 
End; 
4: 
Begin 
Writeln('Vvedite number anketi'); 
prosmotr1(stud); 
End; 
5: prosmotr(stud); 
6: 
Begin 
writeln('Najmite 1 dlya sortirovki po ubivaniy, 2 - po vozrastaniy'); 
sort(stud); 
End; 
7: 
Begin 
Writeln('Vvedite poiskovoi zapros'); 
Readln(zap); 
poisk(stud); 
end; 

end; 

until x=8; 
End.

получается так, что программа при добавлении анкет всегда выбегает за пределы и выскакивает ошибка, не могу понять в чем проблема?
Kamikaze0 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Создание новой базы данных с использованием данных из старой Ruslan VDK Помощь студентам 0 19.04.2015 15:25
Проектирование базы данных в Postgres: выбор типа данных между TEXT и VARCHAR Blondy Общие вопросы по программированию, компьютерный форум 6 06.03.2014 02:09
Программа-тест с использованием базы данных Egor1 Помощь студентам 0 26.01.2011 01:56
ПРОГРАММА БАЗЫ ДАННЫХ ПРЕЗЕНТАЦИЙ Dr.Swat Общие вопросы Delphi 2 13.06.2010 15:34