Поиск информации по БД в Delphi(консоль)

Тема в разделе "Delphi - Базы данных", создана пользователем -, 4 фев 2010.

  1. Гость

    Здравствуйте! Мне нужна помощь!
    Задача:
    Создать файл данных. Выбрать одно из полей как ключ поиска.
    1. На основе файла создать словарь, состоящий из пар: КЛЮЧ- № записи.
    2. Упорядочить словарь по возрастанию ключей.
    3. Реализовать поиск данных в файле по ключу с использованием словаря, используя прямой доступ к записям файла
    Проблема:
    Не могли бы вы, уважаемые форумчане, проверить написанный код, и исправить ошибку, чтобы программа стала работоспособной. Если не сможете по каким-либо обстоятельствам исправить сам код, то, пожалуйста, дайте мне совет по исправлению этой ошибки.

    Заранее благодарен!!!

    <div class="sp-wrap"><div class="sp-head-wrap"><div class="sp-head folded clickable">"Неработоспособный код"</div></div><div class="sp-body"><div class="sp-content">program FindMind;

    {$APPTYPE CONSOLE}

    uses
    SysUtils;

    type
    address = record
    name: string[30];
    street: string[40];
    sity: string[20];
    end;
    str80 = string[80];
    DataItem = address;
    DataArray = array [1..80] of DataItem;
    recfil = file of DataItem;

    var
    test: DataItem;
    t:integer;
    testfile: recfil;

    { найти запись в файле }
    function Find(var fp:recfil; i:integer): str80;
    var
    t:address;
    begin
    i := i-1;
    Seek(fp,i);
    Read(fp,t);
    Find := t.name;
    end;

    procedure QsRand(var fp:recfil; count:integer);
    procedure Qs(l, r:integer);
    var
    i, j, s:integer;
    x, y, z:DataItem;
    begin
    i := l; j := r;
    s := (l+r) div 2;
    Seek(fp,s-1); { получить запись }
    Read(fp,x);
    repeat
    while Find(fp,i) < x.name do i := i+1;
    while x.name < Find(fp, j) do j := j-1;
    if i<=j then
    begin
    Seek(fp,i-1); Read(fp,y);
    Seek(fp,j-1); Read(fp,z);
    Seek(fp,j-1); Write(fp,y);
    Seek(fp,i-1); Write(fp,z);
    i := i+1; j := j-1;
    end;
    until r>l;
    if l<j then qs(l, j);
    if l<r then qs(i, r);
    end;
    begin
    qs(1,count);
    end; { конец быстрой сортировки файла произвольного
    доступа }
    begin
    AssignFile(testfile, 'D:\file.txt');
    Reset(testfile);
    t := 1;
    while not EOF(testfile) do begin
    Read(testfile,test); { подсчет числа записей в
    файле}
    t := t+1;
    end;
    t := t-1;

    QsRand(testfile,t)
    end.
     
  2. SNike

    SNike Гость

    Код смотреть, честно говоря, лениво. А чего за ошибка выходит? Что и как не работает?
     
  3. Гость

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

    <!--shcode--><pre><code class='grey'>program Search;
    uses crt;
    label 10;
    type
    address = record
    year: string[4];
    surname: string[20];
    summa: integer;
    end;
    str80 = string[80];
    DataItem = address;
    DataArray = array [1..80] of DataItem;
    recfil = file of DataItem;
    var
    test: DataItem;
    t, t2, z:integer;
    testfile,fp: recfil;
    key: string;

    Procedure Sozd (var fp:recfil);
    Var i,j:integer;
    zk:address;
    begin
    rewrite (fp);
    j:=1;
    while j<>0 do
    begin
    write ('vvedite god: ');
    readln (zk.year);
    write ('Vvedite familiyu: ');
    readln (zk.surname);
    write ('Vvedite summu: ');
    readln (zk.summa);
    write (fp,zk);
    writeln ('Esli konec zapisi to nazhmite 0 ');
    readln (j);
    end;
    close (fp);
    end;

    Procedure vyvod (var fp:recfil);
    Var i:integer;
    zk:address;
    begin
    reset (fp);
    writeln ('=========================');
    writeln ('| god | familiya | summa');
    writeln ('=========================');
    while not eof(fp) do
    begin
    read (fp,zk);
    write ('|',zk.year:6);
    write (' |',zk.surname:13);
    write (' |',zk.summa:6);
    writeln;
    writeln ('-------------------------');
    end;
    close (fp);
    end;

    Procedure poisk_lineyniy (var fp:recfil);
    var i:integer;
    zk:address;
    begin
    reset (fp);
    write ('Vvedite god dlja poiska: ');
    readln (key);
    writeln ('spisok s zadannym godom ');
    writeln ('=========================');
    writeln ('| god | familiya | summa');
    writeln ('=========================');
    while not eof(fp) do
    begin
    read (fp,zk);
    if zk.year = key then
    begin
    write ('|',zk.year:6);
    write (' |',zk.surname:13);
    write (' |',zk.summa:6);
    writeln;
    writeln ('--------------------------');
    end;
    end;
    close(fp);
    end;

    function Find(var fp:recfil; i:integer): str80;
    var
    t:address;
    begin
    i := i-1;
    Seek(fp, i);
    Read(fp, t);
    Find := t.year;
    end;

    procedure bin(n,k:integer);
    Var mid:integer;
    zk:address;
    Begin
    mid:=(k+n) div 2;
    seek(fp,mid);
    Read(fp,zk);
    If k > n Then
    begin
    if key > zk.year then bin(mid,k);
    if key < zk.year then bin(n,mid)
    else
    begin
    write ('|',zk.year:6);
    write (' |',zk.surname:13);
    write (' |',zk.summa:6);
    writeln;
    writeln ('--------------------------');
    exit;
    end
    end
    else writeln('takoy zapisi net!');
    end;

    procedure QsRand(var fp:recfil; count:integer);
    procedure Qs(l, r:integer);
    var
    i, j, s:integer;
    x, y, z:DataItem;
    begin
    i := l; j := r;
    s := (l+r) div 2;
    Seek(fp,s-1);
    Read(fp,x);
    repeat
    while Find(fp, i) < x.year do i := i+1;
    while x.year < Find(fp, j) do j := j-1;
    if i<=j then
    begin
    Seek(fp,i-1); Read(fp,y);
    Seek(fp,j-1); Read(fp,z);
    Seek(fp,j-1); Write(fp,y);
    Seek(fp,i-1); Write(fp,z);
    i := i+1; j := j-1;
    end;
    until i>j;
    if l<j then qs(l, j);
    if l<r then qs(i, r);
    end;
    begin
    qs(1,count);
    bin(1,count);
    end;

    BEGIN
    clrscr;
    10:
    assign(fp,'spisok_klientov.txt');
    writeln (' BAZA DANNIH ');
    writeln ('1:sozdanie');
    writeln ('2:vivod');
    writeln ('3:poisk lineyniy');
    writeln ('4:poisk binarniy');
    writeln ('5:vyhod');
    writeln;
    write ('Vvedite komandu: ');
    readln (z);
    case z of
    1:sozd(fp);
    2:vyvod (fp);
    3:poisk_lineyniy (fp);
    4:begin
    write ('Vvedite god dlja poiska: ');
    readln (key);
    writeln ('spisok s zadannym godom ');
    writeln ('=========================');
    writeln ('| god | familiya | summa');
    writeln ('=========================');
    t := 0;
    reset(fp);
    while not EOF(fp) do
    begin
    Read(fp,test);
    t := t+1;
    end;
    QsRand(fp,t)
    end;
    5:exit;
    end; goto 10;
    readln
    END.[/CODE]
    До скорой встречи!!!
     
  4. SNike

    SNike Гость

    Молодца! А то я только твой прежний код стал уже пересматривать :RTFM:
    Приятно иметь дело с людьми которые сами что-то стараются сделать!
     
Загрузка...

Поделиться этой страницей