begin_time:=minutes*60*100+seconds*100+seconds100;

if (paramstr(1)<>'') then begin read_file:=paramstr(1);

search_value_string:=paramstr(2);

val(search_value_string,search_value,k);

write_file:=paramstr(3);

result:=search(read_file,search_value);

writing_to_file(write_file,result,begin_time);

end else begin files_names_query(read_file,error,search_value if (error='')

then begin result:=search(read_file,search_value);

writing(result,begin_time);

end else begin writeln(error);

writeln('нажмите Enter для продолжения.');

readln; end; end;

end.

9.Описание: Вывести таблично результаты расчета функции y=sin(x)/x на указанном диапазоне в файл.

Program one;

Const M=24;

Var FName: Text; AB,H,X: Real;

Function F(X:Real):Real;

Begin F:=Abs(Sin(X)/X);

End;

Begin Write ('vvedite na4alo diapazona: ');

ReadLn (A);

Write ('vvedite konec diapazona: ');

ReadLn (B);

WriteLn('sozdayu LA-BA.TAB');

H:=(B-A)/M;

X:=A;

Assign(FName,'LA-BA.TAB');

ReWrite(FName);

WriteLn (FName,'X | F(X)');

While (X<=B) Do Begin WriteLn (FName,X,' | ',F(X));

X:=X+H;

End;

Close (FName);

End.

10.Описание: Дан файл, содержащий текст. Сколько слов в тексте? Сколько цифр в тексте?

program one;

Const mn=['0'..'9'];

Var f3:text; i,j,ch,sl:integer; name:string; s:char; wrd :string;

Begin writeln('vvedite imya faila');

readln(name);

assign(f3,name);

reset(f3);

s:=' '; sl:=0; ch:=0;

while not eof(f3) do begin readln(f3,wrd);

i:=1;

While i<=length(wrd) do begin if wrd[i]<>' ' then sl:=sl+1;

while (wrd[i]<>' ') and (i<=length(wrd)) do inc(i);

inc(i) end; end;

close(f3);

reset(f3);

while not eof(f3) do begin while not eoln(f3) do begin read(f3,s);

if (s in mn) then ch:=ch+1;

end; readln(f3); end;

writeln('4islo slov: ',sl,' 4islo cifr: ',ch);

close(f3);

End.

11.Описание: Заменить синонимами слова в файле

program ;

var f1,f2,f3:text; i,n,k,l:integer; s,sout,ss,slovoT,slovo,sinonim:string;

begin assign(f1,'text1.txt');

assign(f2,'text2.txt'); assign(f3,'text3.txt');

rewrite(f1);

writeln('‚ўҐ¤ЁвҐ ⥪бв:');

repeat readln(s);

writeln(f1,s)

until s='';

close(f1); reset(f1);

rewrite(f3);

while not(eof(f1)) do begin readln(f1,s);

s:=s+' ';

sout:='';

while length(s)>0 do begin l:=pos(' ',s);

slovoT:=copy(s,1,l-1);

delete(s,1,l);

reset(f2);

while not(eof(f2)) do begin readln(f2,ss);

k:=pos(',',ss);sinonim:=copy(ss,1,k-1);

if sinonim=slovoT then slovoT:=copy(ss,k+1,length(ss)-k) end;

close(f2);

sout:=sout+slovot+' ' end;

writeln(s);

writeln(f3,sout) end;

close(f3); reset(f3);

while not(eof(f3)) do begin readln(f3,s);

writeln(s) end;

close(f3); readln

end.

12.Описание: Очистить файл, оставив лишь первую строку.

program one;

uses crt;

var fl1:text;a:string;i,l,poz:longint;label m;

begin clrscr;

assign(fl1,'input.txt');

reset(fl1); readln(fl1,a); close(fl1);

l:=length(a);

rewrite(fl1);

for i:=1 to l do if a[i]='.'then begin poz:=i;goto m; end;

m:for i:=1 to poz do write(fl1,a[i]); close(fl1);

writeln('complete!!!');

readkey;

end.

13.Описание: Вывод статистики по файлу

program one; uses crt; var infile:text;file_name,s:string;i, commas, points, blanks,lines:integer; begin clrscr; commas:=0;points:=0;blanks:=0;lines:=0; write('vvedite imya faila'); readln(file_name); assign(infile,file_name);reset(infile); while not eof(infile) do begin readln(infile,s); for i:=1 to length(s) do begin case s[i] of ',' :inc(commas); '.' :inc(points); ' ' :inc(blanks); end; end; inc(lines); end; close(infile); gotoxy(1,3); writeln('zapyatih: ',commas); writeln('predlogenii: ',points); writeln(' probelov: ',blanks); writeln(' strok: ',lines); readln; end.

14 Задан файл F, компонентами которого являются целые числа. Переписать в файл G вначале все отрицательные, затем все нулевые, а затем все положительные числа, упорядочив их по возрастанию модуля величины. Файл G - текстовый. Program Pascal; Const fname='num.txt'; fname2='num2.txt'; Var f,g:text; stroka:string; k,code,i,j,tmp:integer; a:array[1..20] of integer; begin Assign(F, fName); ReSet(F); k:=0; While Not Eof(F) Do Begin ReadLn(F, Stroka); k:=k+1; val(Stroka,tmp,code); a[k]:=tmp; writeln(a[k]); End; close(f); writeln; writeln(k); writeln; for i:=2 to k do for j:= k downto 2 do if a[j-1] > a[j] then begin tmp := a[j-1]; a[j-1] := a[j]; a[j] := tmp; end; for i:=1 to k do write(a[i],' '); Assign(g, fName2); rewrite(g); for i:=1 to k do begin writeln(g,a[i]); end; close(g); writeln; readln; end.

15 Задан тектовый файл, содержащий текст. Определить сколько раз встречается в нем самое длинное слово.

program tp7; const razd=[' ','.',',','?','!',':',')','(']; var f:text; s,slo,slovo,name:string; k,i:integer; begin write('Введите имя файла:'); readln(Name); assign(f,name); reset(f); slovo:='';k:=0; while not(EOF(F)) do begin readln(f,s);slo:=''; for i:=1 to length(s) do begin if s[i] in razd then begin if (i>1)and not(s[i-1]in razd) then begin if (length(slo)=length(slovo))and (slo=slovo) then k:=k+1; if length(slo)>length(slovo) then begin slovo:=slo; k:=1 end; end; slo:='' end else begin slo:=slo+s[i] end; end; if (length(slo)=length(slovo))and (slo=slovo) then k:=k+1; if length(slo)>length(slovo) then slovo:=slo; end; writeln('слово ',slovo,' встречается ',k,' раз'); close(f); readln end.

Раздел: Записи

1.Описание: В файл вводятся имена, пол и рост человека. Программа считывает данные из файла и выдает совпадения, если в нем есть мужчины одного роста.

program one;

const n=2;

type group=record

ser:string[30]; p:string[1]; h:100..250;

end;

var person:array[1..n] of group; f:text; r:boolean; ar:array[1..n] of integer; i,j,z,obr:integer;

begin assign(f,'AAAAAAA.txt');

rewrite(f);

for i:=1 to n do with person[i] do begin writeln('person ',i);

writeln(f,'person ',i);

writeln('sername');

readln(ser);

writeln(f,'sername: ',ser,' ');

writeln('pol');

readln(p);

writeln(f,'pol: ',p,' ');

writeln('rost');

readln(h);

writeln(f,'rost: ',h,' ');

writeln(f);

writeln; end;

close(f);

reset(f);

append(f);

writeln(f,'poisk dvuh men s odinakovim rostom');

j:=1; for i:=1 to n do begin with person[i] do begin if (p='m') or (p='M') then begin ar[j]:=h;

j:=j+1; z:=j-1; end; end; end;

r:=false;

for j:=1 to z do begin obr:=ar[j]; i:=j;

repeat if ar[i+1]=obr then r:=true else i:=i+1;

until (i>z) or (r); end;

if r=true then writeln(f,'sovpadenie naydeno');

if r=false then writeln(f,'sovpadenie ne naydeno');

close(f);

readln;

end.

2.Описание: Телефонный справочник

program one; type Zapis=record fam:string; tel:string;

 end; var out: file of Zapis; nam:Zapis; kon:char; begin assign(out,'nomera'); rewrite(out); repeat write('fam?'); readln(nam.fam); write('nomer?'); readln(nam.tel); write(out,nam); writeln('prodolgim? y/N'); readln(kon); until kon <>'y'; reset(out); while not eof(out) do begin read(out,nam); writeln(nam.fam,'-',nam.tel); end; close(out); end.

3.Описание: Программа, которая создает файл с описанием студентов:

program one;

type TStudentInfo=record name:string[30]; kurs:string[20]; ekz:array[1..5] of byte; end; var f:file of TStudentInfo; st:TStudentInfo; p:byte; begin assign(f,'students.dat'); reset(f); {Откроем файл. Позиция на данный момент в самом начале} if ioresult<>0 then rewrite(f); {Если ошибка, занчит файла нет, и значит откоем его подругому} seek(f,filesize(f));

with st do repeat write('Введите имя студента (пустую строку для выхода): '); readln(name); if name='' then break; write('Введите курс:'); readln(kurs); for p:=low(ekz) to high(ekz) do begin write('Введите оценку по экзамену №',p,': '); readln(ekz[p]); end; write(f,st); {Вот эта строка и записывает информацию о студенте в файл} until false; close(f); {Эту команду мы ещё не рассматривали, но об этом я расскажу в конце} end.

4.Описание: Производится ввод даты последовательно: число, месяц, год. Программа проверяет наличие ошибок при вводе.

program lab4;

uses crt;

type day=1..31; mon=1..12; year=1..3000;

var data:record

d:day; m:mon; y:year; end; s:boolean;

function vernaydat:boolean;

begin with data do begin write('chslo: ');

readln(d);

write('mesyc: ');

readln(m);

write('god: ');

readln(y);

s:=true;

if y>3000 then s:=false;

if m>12 then s:=false;

case m of 1,3,5,7,8,10,12:begin if d>31 then s:=false; end;

4,6,9,11:begin if d>30 then s:=false; end;

2:begin if (y mod 4)<>0 then if d>28 then s:=false;

if (y mod 4)=0 then if d>29 then s:=false;

end; end;

if s=true then write('OK');

if s=false then write('ERROR');end;end;

begin clrscr;

writeln('Vvedite datu');

Vernaydat; readln;

end.

5.Описание: Формирование базы данных информации о студентах. Вывод из таблицы список студентов:-получивших оценку 4;-получивших оценки 4 и 5;-фамилия которых начинается на 'А'.

Program Laba6;

Uses Crt;

Type Exam = Record

Name: String[20]; Year: Integer; Lesson: String[10]; Prise: Integer;

End;

Mass = Array [1..30] Of Exam;

Var Student: Mass; Prise1, Prise2, Num, I: Integer; Letter: Char;

Procedure InputStudent (Var InpNum: Integer);

Var I:Integer;

Begin ClrScr;

Write ('4islo studentov: ');

ReadLn (InpNum);

For I:=1 To InpNum Do Begin Write ('vvvedite familiyu stud nomer ',I,' [20] : '); ReadLn (Student[I].Name);

Write ('god rojden stud nomer',I,': '); ReadLn (Student[I].Year);

Write ('predmet studenta nomer ',I,' [10] : '); ReadLn (Student[I].Lesson);

Write ('ocenka stud nomer ',I,': '); ReadLn (Student[I].Prise);

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10