Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

[Pascal]_не работает процедура поиска

3.3K
15 июня 2007 года
Nethead
88 / / 24.11.2006
Сделала в программ епроцедуру поиска, которая ищет определенные данные по поляммм, синим цветом выделил то что добавил в программу(работающую)
Код:
uses crt;
[COLOR="#0000ff"]type
  my_str = string[20];
  Nalogoviyainspekciya=record
    case boolean of
      false: (
        Sname_firmi,Name_firmi,
        vidsob,
        viddeyat,
        telephone,
        faks,
        adres: my_str;
      );
    true: (
      arr: array[1 .. 7] of my_str;
    )
  end;[/COLOR]
var      f:file of Nalogoviyainspekciya;
       zn,filename:string;
                 k:integer;
  label 11;
  {-----------------------------------------------------------}
  procedure Creatfile;
    begin
      writeln('ZADAITE IMIA FAILA KOTORIY BUDET SOZDAVATSYA');
      readln(filename);
      assign(f,filename);
      rewrite(f);
    end;
  {-----------------------------------------------------------}
  procedure Addrecord;
  var rez:integer; ch:char;
  begin
   {while rez<>1 do
    begin }
      writeln('ZADAITE IMIA FAILA, V KOTORIY BUDET DOBOVLIATSA ZAPIS');
      readln(filename);
      assign(f,filename);
      reset(f);
            rez:=IOResult;
            if rez<>0 then
               begin
                 writeln('PROVERTE PRAVILNOST IMENI FAILA!');
                 writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA?(Y/N)');
                 readln(ch);
                 if (ch='n') or (ch='N') then halt (0);
               end;
          {end;}
      seek(f,filesize(f));
    end;
   {==========================================================}
 procedure Inputfile;
     var st:Nalogoviyainspekciya;
         k:char;
     begin
      repeat
         writeln('VVEDITE DANIE O NOVOY FIRME : ');
         write('NAZVANIE FIRMI : ');                readln(st.Sname_firmi);
         write('VID SOBSTVENNOSTI:' );                     readln(st.vidsob);
         write('VID DEYATELNOSTI:');                     readln(st.viddeyat);
         write('TELEPHONE:');                    readln(st.telephone);
         write('FAKS:');                        readln(st.faks);
         write('ADRES: ');                   readln(st.adres);
         write(f,st);
          write('NADO LI VVODIT DANNIE O NOVOY FIRME ? (Y/N)>');readln(k);
          writeln;
      until(k='n') or (k='N');
     close(f);
   end;
    {=========================================================}
    procedure redzap;
var
         st:Nalogoviyainspekciya;
       filename,str:string;
       Sname_firmi2,Name_firmi2:string[15];
           vidsob2:string[20];
           viddeyat2:string[20];
           telephone2:string[20];
           faks2:string[20];
           adres2:string[20];
                  x:integer;
begin
    writeln('ZADAITE IMIA FAILA');
    readln(filename);
    assign(f,filename);
    reset(f);
      with st do
       begin write('VVEDITE NAZVANIE FIRMI: ');readln(str);
       x:=0;
       while not eof(f) do
         begin
           read(f,st);
           if st.Sname_firmi=str then
             begin
         writeln('VVEDITE DANIE O NOVOY FIRME : ');
         write('NAZVANIE FIRMI : ');                readln(st.Sname_firmi);
         write('VID SOBSTVENNOSTI:' );                     readln(st.vidsob);
         write('VID DEYATELNOSTI:');                     readln(st.viddeyat);
         write('TELEPHONE:');                    readln(st.telephone);
         write('FAKS:');                        readln(st.faks);
         write('ADRES: ');                   readln(st.adres);
               Sname_firmi2:=Sname_firmi;      viddeyat2:=viddeyat;
               vidsob2:=vidsob;        telephone2:=telephone;
               faks2:=faks;            adres2:=adres;

         seek(f,filepos(f)-1);
         write(f,st); x:=1;
       end; end;
       close(f);
    end;
   if x=0 then  begin writeln('zapisi s takoy firmoy net!');readln end;
end;
  {==============================================================}
   function Openfile: Boolean;
var
  rez: integer;
  ch: char;

begin
Openfile:=False;
repeat
  writeln('ZADAITE IMIA FAILA');
  readln(filename);
  assign(f,filename);
  reset(f);
  rez:=IOResult;
  if rez<>0 then
  begin
    writeln('PROVERTE PRAVILNOST IMENI FAILA!');
    writeln('BUDET LI POVTORNOE ZADANIE IMENI FAILA ? (Y/N)');
    readln(ch);
    if UpCase(ch)='N' then halt (0);
  end
  else
    Openfile:=True;
until (rez=0) or (UpCase(ch)='N');
end;
     {============================================================}
     procedure Outputfile;
       var st:Nalogoviyainspekciya;k:char;
       begin
         writeln('HOTITE POSMOTRET DANNIE O FIRMAH? (Y/N)');
         readln(k);
          if (k='y') or (k='Y') then
            while not eof(f) do
              begin
                read(f,st);
         writeln('NAZVANIE FIRMI :',st.Sname_firmi);
         writeln('VID SOBSTVENNOSTI:',st.vidsob);
         writeln('VID DEYATELNOSTI:',st.viddeyat);
         writeln('TELEPHONE:',st.telephone);
         writeln('FAKS:',st.faks);
         writeln('ADRES:',st.adres);

         writeln('DLYA PRODOLGENIA NAGMITE (enter)');
         readln;
              end;
           close(f);
       end;
       {========================================================}
       procedure Clearfile;
    var st:Nalogoviyainspekciya;
            studtoout:string[20];
        fo:file of Nalogoviyainspekciya;
        begin
             writeln('ZADAYTE IMIA FAILA IZ KOTOROGO UDALIUTSA ELEMENTI');
             readln(filename);
         assign(f,filename);reset(f);
             assign(fo,'newfile.dat');rewrite(fo);
             writeln('Zadayte nazvanie firmi zapis kotoroy udalietsa');
             readln(studtoout);
              while not eof(f) do
               begin
                read(f,st);
                if st.Sname_firmi<>studtoout then write(fo,st);
               end;
              close(f);close(fo);
              erase(f);
              rename(fo,filename);
         end;
[COLOR="#0000ff"]procedure search(i: integer);
var
  s: string;
  st: Nalogoviyainspekciya;
begin
  readln(s); { строка, которую будем искать }
  reset(f); { <--- Допустим, что файл уже связан, и его надо только открыть... }

  while not eof(f) do begin
    read(f, st);
    if st.arr = s then Print(st); { <--- Это - процедура, выводящая на экран запись St, ибо Writeln(st) не сработает !!! }
  end;
  close(f);
end;[/COLOR]
       {INIIAIA? ?ANOU I?IA?AIIU}
     Begin  11:
        writeln('     MENU:');
        writeln('1:SOZDAT FILE');
        writeln('2:DOBAVLENIE ZAPISI V FAIL');
        writeln('3:KORREKTIROVKA ZAPISI');
        writeln('4:PROSMOTR FAILA');
        writeln('5:UDALENIE ZAPISI IS FAILA');
        writeln('6:VIHOD IZ PROGRAMMI');
       [COLOR="#0000ff"] writeln('7:Search');[/COLOR]
       
        readln(k);
         case k of
  1: begin Creatfile; Inputfile end;
  2: begin Addrecord; Inputfile end;
  3: redzap;
  4: if Openfile then Outputfile;
  5: Clearfile;
  6: Halt;
 [COLOR="Blue"] 7: search;[/COLOR]
[COLOR="#0000ff"]begin
    writeln('по какому полю будем искать? (выберите номер поля)');
    write('1) Sname_firmi; 2) Name_firmi; 3) vidsob; 4) viddeyat; 5) telephone; 6) faks; 7) adres'); readln(choice);
    search(choice); { <--- Будет искать данные только по заданному полю }
  end;
end;[/COLOR]
else
  writeln('OSHIBKA POVTORITE NOMER REGIMA.')
end; goto 11;
End.
242
15 июня 2007 года
Оlga
2.2K / / 04.02.2006
Цитата:
Сделала в программ епроцедуру поиска, которая ищет определенные данные по поляммм, синим цветом выделил то что добавил в программу(работающую)

[COLOR=Red]Из написанного вами нельзя понять, в чем суть вашего вопроса. Вопрос надо писать не только в заголовке темы, но и в самой теме. И вообще, выражайте пожалуйста ваши мысли/вопросы более конкретно, а не как ребусы... И зачем приводить весь код? надо было привести только необходимую информацию для проверки процедуры поиска (я так понимаю выделенное синим цветом) и саму процедуру.
[/COLOR]

3.3K
15 июня 2007 года
Nethead
88 / / 24.11.2006
Цитата: OlgaKr
[COLOR=Red]Из написанного вами нельзя понять, в чем суть вашего вопроса. Вопрос надо писать не только в заголовке темы, но и в самой теме. И вообще, выражайте пожалуйста ваши мысли/вопросы более конкретно, а не как ребусы... И зачем приводить весь код? надо было привести только необходимую информацию для проверки процедуры поиска (я так понимаю выделенное синим цветом) и саму процедуру.
[/COLOR]



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

Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог