Много табличные базы данных Опции

[klem4]

Вот значит решил написать программу для работы с 2-х табличной базой данных.

1 таблица банков
2 таблица клиентов

Связь таблиц заключается в том, что у одного банка могут быть несколько клиентов, а у каждого клиента могут быть вклады в разных банках.

Программа еще далека от оптимальной, модернизация ей еще предстоит, но вроде работает без сбоетв, если кто-то обнаружит серьзезный недочет или ошибку прошу сообщить, в дальнейшем планирую оптимизировать макимально эту программу, написать лайт-версию без динамических структур, и на их основе сделать материал для FAQ.

Если будут вопросы по программе, спрашивайте.

Код: (Показать/Скрыть)

{$r-}
uses crt;
const

  mb1 = 'Введите имя банка : ';
  mb2 = 'Сколько клиентов у данного банка : ';
  mb3 = 'Имя клиента : ';

  mc1 = 'Ввдите имя клиента : ';
  mc2 = 'В скольки банках у данного клиенита есть вкалады : ';
  mc3 = 'Имя банка : ';

  msgb = 'Выберете банк, для посмотра списка его вкладчиков и нажмите <Enter>,либо';
  msgc = 'Выберете клиента, для посмотра списка банков, в которых есть его вклад нажмите <Enter>,либо';

type

   TType = string;

   PArr = record
      p  : ^TArr;
      size : LongInt;
   end;

   TArr = array [1..1] of TType;

   PStruct = record
      s  : ^TStruct;
      size : LongInt;
   end;

   TStruct = array [1..1] of record
      name : TType;
      arr  : PArr;
   end;

procedure AddEl(var a : PArr; el : TType);
var
   newArr : ^TArr;
begin

   GetMem(newArr, a.size + sizeof(TType));

   if a.p <> nil then begin
     move(a.p^[1], newArr^[1], a.size);
     FreeMem(a.p, a.size);
   end;


   inc(a.size, sizeof(TType));

   a.p := newArr;

   a.p^[a.size div sizeof(TType)] := el;

end;

procedure AddStruct(var struct : PStruct);
var
   newStruct : ^TStruct;
begin

   GetMem(newStruct, struct.size + sizeof(TStruct));

   if struct.s <> nil then begin
      move(struct.s^[1], newStruct^[1], struct.size);
      FreeMem(struct.s, struct.size);
   end;

   inc(struct.size, sizeof(TStruct));
   struct.s := newStruct;

   struct.s := newStruct;
end;

function Find(struct : PStruct; el : TType) : word;
var
   fnd : boolean;
   n,i : word;
begin
   find := 0;
   fnd := false;
   n := struct.size div sizeof(TStruct);
   i := 1;
   while (i <= n) and not(fnd) do begin
      fnd := (struct.s^[i].name = el);
      if not(fnd) then inc(i);
   end;

   if fnd then
    find := i
end;

procedure Show(struct : PStruct; msg : TType);
var
   n,i,j,x,y,ch : word;
begin

   n := struct.size div sizeof(TStruct);

   repeat

      clrscr;

      for i := 1 to n do writeln(i,'). ',struct.s^[i].name);

      writeln('Выберете банк, для посмотра списка его вкладчиков и нажмите <Enter>,либо');
      writeln('0 для выхода в основное меню');

      x := WhereX; y := WhereY;

      repeat
         readln(ch);
         GotoXY(x,y); ClrEOL;
      until ch in [0..n];

      if ch <> 0 then begin
         clrscr;
         for j := 1 to struct.s^[ch].arr.size div sizeof(TType) do
          writeln(struct.s^[ch].arr.p^[j]);
      end;
      writeln('Нажмите любую клавишу'); readln;
   until ch = 0;
end;

procedure Work(var main : PStruct; var sub : PStruct; msg1,msg2,msg3 : TType);
var
   n,i,id : word;
   namem, names : TType;
   ch : char;

begin

   clrscr;

   writeln('Вы уверены что хотите ввести новую структуру [Enter - yes, Esc - no] ?');
   repeat ch := readkey until ch in [#13,#27];

   if ch = #27 then exit;

   clrscr;

   write(msg1); readln(namem);

   if (Find(main, namem)) <> 0 then exit;

   AddStruct(main);

   main.s^[main.size div sizeof(TType)].name := namem;
   main.s^[main.size div sizeof(TType)].arr.size := 0;

   write(msg2); readln(n);

   if n > 0 then
    for i := 1 to n do begin
       write(msg3); readln(names);
       AddEl(main.s^[main.size div sizeof(TType)].arr, names);
       id := Find(sub, names);
       if id = 0 then begin
          AddStruct(sub);
          sub.s^[sub.size div sizeof(TStruct)].name := names;
          sub.s^[sub.size div sizeof(TStruct)].arr.size := 0;
          AddEl(sub.s^[sub.size div sizeof(TType)].arr, namem);
       end
        else AddEl(sub.s^[sub.size div sizeof(TType)].arr, namem);
    end;

end;

function Menu(var b : PStruct; var c : PStruct; var q : boolean) : boolean;
var
  ch : char;
  n,i,id : word;
  cname,bname : TType;
begin

   clrscr;

   writeln('1 -> Добавить банк ');
   writeln('2 -> Добавить клиента');
   writeln('3 -> Вывести и-ю по банкам');
   writeln('4 -> Вывести и-ю по клиентам');
   writeln('----------------------------');
   writeln('0 -> Выход');

   repeat
      ch := readkey;
   until ch in ['0'..'4'];

   case ch of

     '1' : Work(b, c, mb1, mb2, mb3);

     '2' : Work(c, b, mc1, mc2, mc3);

     '3' : Show(b, msgb);

     '4' : Show(c, msgc);

     '0' : q := true;

   end;
end;

var
   bank, client : PStruct;
   quit : boolean;

begin

   clrscr;

   bank.size := 0;
   client.size := 0;

   quit := false;

   while not(quit) do menu(bank, client, quit);

   FreeMem(bank.s, bank.size);
   FreeMem(client.s ,client.size);

end.

.

[volvo]

в дальнейшем планирую оптимизировать макимально эту программу, написать лайт-версию без динамических структур, и на их основе сделать материал для FAQ.

Вопрос на засыпку, а зачем в FAQ давать реализацию БЕЗ динамики там, где подразумевается именно использование динамических структур? Ты что, будешь напрямую с файлом работать? Или опишешь статические массивы (как многие делают) максимально допустимого размера? Этому тем более не место в FAQ-е, ибо это неправильно...

Если уж делать - то делай именно с динамикой... Только попробуй пересмотреть добавление элементов в массив, при таком как у тебя сейчас методе легко заблокировать кучу - она сильно фрагментируется, ведь каждый последующий запрашиваемый тобой кусок памяти больше, чем предыдущий освобожденный, и в "куче" остаются бреши...

Еще одно... Первой же строкой программы ты делаешь {$R-}... Это тоже не совсем корректно... Тем более не для FAQ... Лучше не отключать Range-Checking, а описывать тип TArr вот так:

TArr = array [1 .. pred(maxint div sizeof(TType))] of TType;

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