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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 13.05.2009, 17:57   #1
Deimossy
 
Аватар для Deimossy
 
Регистрация: 19.11.2007
Сообщений: 6
По умолчанию Хэш-поиск по базе данных

Помогите, пожалуйста, к зачету необходима курсовая, а я не могу понять как 'совместить' имеющиеся у меня части программы.
Есть база данных 'Библиотека'
Код:
//база данных 
program baza;
type
     entry=record
         FIO: string;
         nazvanie: string;
         izdat: string;
         godizdat: string;
         objem: string;
         annotation: string;
     end;
var
base: array [1..10] of entry;
n: integer;

//сохранение
procedure savebase (name: string);
var f: file of entry;
    i: integer;
begin
   assign (f, name);
   rewrite (f);
      for i := 1 to n do
       write (f, base [i]);
   close (f)
end;

//загрузка
procedure loadbase (name: string);
var f: file of entry;
    i: integer;
begin
   assign (f, name);
   reset  (f);
    n:= 0;
    while not eof (f) do
      begin
        n:= n+1;
        read (f, base[n]);
      end;
   close (f)
end;

//печать записи
procedure printrecord (n1: integer );
begin
     writeln (base [n1].FIO: 20,' ', base [n1].nazvanie: 10, ' ',
     base [n1].izdat: 5,' ', base [n1].godizdat:5,' ', base [n1].objem:5,' ', base [n1].annotation:15);
end;

//печать базы
procedure printBase;
var
   i: integer;
begin
      write ('FIO ': 20);
      write ('nazvanie ': 18);
      write ('izdat ': 5);
      write ('godizdat ': 5);
      write ('objem ':5);
      writeln ('annotation ':15);

     for i:= 1 to n do
     printrecord (i);
end;

//поиск по базе
function findnazvanie (nazvanie: string): integer;
var i: integer;
n1: integer;
begin
  n1:= 0;
   for i := 1 to n do
    if base [i].nazvanie = nazvanie then
     begin
       n1:= i;
         break;
     end;
  findnazvanie:= n1;
end;

//ввод данных
procedure enternazvanie ( var a: entry);
begin
     write ('Автор: ');
     readln (a.FIO);
     write  ('Название: ');
     readln (a.nazvanie);
     write  ('Издательство: ');
     readln (a.izdat);
     write  ('Год издания: ');
     readln (a.godizdat);
     write ('Количество страниц: ');
     readln(a.objem);
     write('Краткое содержание: ');
     readln(a.annotation);
end;

//добавление новой записи
procedure addnazvanie;
var
   a: Entry;
begin
     enternazvanie (a);
     n:= n+1;
     base[n]:= a;
end;

//удаление записи
procedure delnazvanie (n1: integer);
var i: integer;
begin
   if (n1 > 0) and (n1 <= n) then
     begin
      n:= n-1;
       for i := n1 to n do
       base [i]:= base [i+1];
     end
end;

//сортировка по автору
procedure sortFIO;
var
   i,j: integer;
   t: entry;
begin
     for i:= 1 to n do
         for j := i+1 to n do
             if base [i].FIO > base [j].FIO then
             begin
                  t:= base [i];
                  base [i]:= base [j];
                  base [j]:= t;
             end
end;

//сортировка по издательству
procedure sortizdat;
var
   i,j: integer;
   t: entry;
begin
  for i := 1 to n do
   for j := i + 1 to n do
       if base [i].izdat > base [j].izdat then
        begin
         t:= base [i];
         base [i] := base [j];
         base [j] := t;
        end
end;

var
   c: char;
   name,nazvanie: string;
   n1: integer;
begin
     n:= 0;
 while true do
  begin
    writeln ('Выберите действие: ');
    writeln ('1 - Добавить книгу' );
    writeln ('2 - Сохранить базу');
    writeln ('3 - Загрузить базу');
    writeln ('4 - Вывести базу на экран');
    writeln ('5 - Найти книгу');
    writeln ('6 - Удалить книгу');
    writeln ('7 - Отсортировать по автору');
    writeln ('8 - Отсортировать по издательству');
    writeln ('9 - Выход');
    readln (c);

     if c= '9' then
      break
          else
     if c= '3' then
       begin
        write ('Введите название базы: ');
        readln (name);
        loadbase (name);
       end
          else
     if c= '2' then
       begin
        write ('Введите название базы: ');
        readln (name);
        savebase (name);
       end
          else
     if c= '4' then
        printbase
          else
     if c= '1' then
        addnazvanie
          else
     if c= '5' then
       begin
        write ('Название книги: ');
        readln (nazvanie);
         n1:= findnazvanie (nazvanie);
          if n1= 0 then
             writeln ( 'Не найдено')
          else
           begin
            printrecord (n1);
            write ('Вы хотите изменить запись (y/n): ');
            readln (c);
               if c = 'y' then
                 enternazvanie (base [n1])
               end
          end
          else
     if c= '7' then
       sortFIO
          else
     if c= '8' then
       sortizdat
          else
     if c= '6' then
       begin
         write ('Введите номер записи: ');
         readln (n1);
         delnazvanie (n1);
       end
          else
     writeln ('Ошибка');
  end
end.
Deimossy вне форума Ответить с цитированием
Старый 13.05.2009, 17:58   #2
Deimossy
 
Аватар для Deimossy
 
Регистрация: 19.11.2007
Сообщений: 6
По умолчанию Продолжение

И есть хэш-поиск, как нам его дали на лекции
Код:
const maxsize = { максимальный размер массива }
type DICTIONARY = record
     last: integer;
     data: array[1..maxsize] of nametype
     end;

//обнуление словаря
procedure MAKENULL ( var A: DICTIONARY );
begin
 A.last:= 0
end; { MAKENULL }

//принадлежит ли слово словарю
function MEMBER ( x: nametype; var A: DICTIONARY ): boolean;
var i: integer;
begin
 for i:= 1 to A.last do
 if A.data[i] = x then return(true);
 return(fale)
end; { MEMBER }

//добавить слово в словарь
procedure INSERT ( x: nametype; var A: DICTIONARY );
begin
 if not MEMBER(x, A) then
 if A.last < maxsize then
 begin
  A.last:= A.last + 1;
  A. data [A. last] -.= x
 end
else error('База данных заполнена')
end; { INSERT }

//удалить слово из словаря
procedure DELETE ( x: nametype; var A: DICTIONARY );
var i:= integer;
begin
 if A.last > 0 then
 begin
  i:= 1;
  while A.data[i] <> x) and (i < A.last) do
  i:= i + 1;
  if A.data[i] = x then
  begin
   A.data[i] = A.data[A.last];
   A.last:= A.last - 1
  end
 end
end; { DELETE }
Несмотря на наличие всего необходимого для выполнения этой работы, как мне сказали, я не могу свести их воедино(((
Нужно осуществить в базе данных процедуры, указанные выше (с помощью хэш-функции) и при помощи хэш-таблицы сделать сортировку базы. Модули и классы использовать нельзя.
Помогите сделать курсовую, пожалуйста!! Или просто объясните как, а я сама допишу)
Deimossy вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поиск в базе данных St-Dyx Microsoft Office Excel 8 19.10.2008 12:13
апят пра поиск в базе данных bmb_66 БД в Delphi 0 14.03.2008 17:38
Поиск по базе данных ERASERROR БД в Delphi 4 14.03.2008 16:34
EXCEL поиск по базе и сопоставление данных lomax Microsoft Office Excel 4 10.02.2007 22:04