Developing.ru

Код: Выделить всё

  Uses Crt;
Var
 F,f1 : Text;
 Ch : Char;
 FIO : String[11];
 Adress:String[16];
 Mark1, Mark2 : 1..2;
 
Procedure CreateFile;
begin
  Assign(F, 'data.dat');
  {$I-}
  ReWrite(F);
  {$I+}
  If IOResult <> 0 Then
     begin
       WriteLn('Ошибка создания файла');
       Halt;
     end
  Else
     begin
       Close(F)
     end;
end;
 
Procedure ReadFile(x:integer);
var s,s1:string;
a:integer;
begin
 createFile;
  Assign(F1, 'vred.txt');
  {$I-}
  Reset(F1);
  {$I+}
  If IOResult <> 0 Then
     begin
       WriteLn('Ошибка открытия файла');
       Halt;
     end
  Else
     begin
       a:=0;
       WriteLn;
       if x=1 then begin
       writeln('Поиск по ФИО');
       writeln('Введите фио');
       readln(s);
       While Not Eof(F1) Do
         begin
          Read(F1, FIO);
           REadLn(F1, adress);
           s1:=copy(fio,1,length(s));
           if s=s1 then begin
              write(Fio);
              Write(' ');
              Writeln(adress);
              append(f);
              write(F,Fio);
              writeln(F,Adress);
              close(f);
              a:=1;
              end;
           end;
        end;
 
       if x=2 then begin
       writeln('Поиск по Адресу');
       writeln('Введите Адрес');
       readln(s);
       While Not Eof(F1) Do
         begin
          Read(F1, FIO);
           REadLn(F1, adress);
           s1:=copy(fio,1,length(s));
           if s=s1 then begin
              write(Fio);
              Write(' ');
              Writeln(adress);
              append(f);
              write(F,Fio);
              writeln(F,Adress);
              close(f);
              a:=1;
              end;
           end;
        end;
       Close(F1);
       If a=0 then Writeln('Ничего не найденно');
       ReadLn;
     end;
end;
 
begin
 ClrScr;
 WriteLn('1.Поиск по ФИО');
 WriteLn('2.Поиск по адресу');
 Write('Ваш выбор');
 Ch := ReadKey;
 Case Ch Of
   '1' : REadFile(1);
   '2' : ReadFile(2);
 End;
end.

Код: Выделить всё

function SmallAlphaa(pis:string):string;
var iii:integer;
begin
for iii:=1 to length(pis) do begin
case pis[iii] of
'A'..'Z','А'..'П': inc(pis[iii],32);
'Р'..'Я' : inc(pis[iii],80);
end;
end;
SmallAlphaa:=pis;
end;