writeln ('--------------------');

P1(a,b,XH,N);

for U:=1 to N do writeln('',masx[u]:10:7,' ',masy[u]:10:7);readln;

end.

Раздел: Файлы

1.Описание: Решает простейшие арифметические примеры записанные в файл.

program pn12;

var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;

begin m:=['1','2','3','4','5','6','7','8','9','0'];

op:=['+','-','*','/'];

assign(f,'file.txt');reset(f);

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

writeln(s);

for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;

sa:='';

while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;

j:=j+1 end;

j:=1;

sb:='';

while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];

j:=j+1 end;

val(sa,a,code);val(sb,b,code);

case s[i] of '+':O:=a+b;

'-':O:=a-b;

'*':O:=a*b;

'/':O:=a div b; end;

writeln(a,s[i],b,'=',O,' ')

end;end; close(f);

readln;

end.

2.Описание: Работа с текстовыми файлами предусматривает собой: создание, редактирование, добавление, удаление.

Program one;

uses Dos,Crt;

var f :text;

FileName :string[9];

st :string; ch :char; vibor :byte;

procedure Head;

begin Writeln('esli vy otkazyvaetes ot deistviya,to naberite v nazvanii faila simvola""');

Write('vvedite imya faila:>');

Readln(FileName);

if FileName='~' then halt(1) else Assign(f,FileName); end;

procedure TextEdit;

begin Writeln('Seichas vy smojetedobavlyat informaciyu v file.');

Writeln('esli vyzahotite prekratit vvod, to naberite sleduschuyu posledovatelnost:"~~"');

repeat Write('>');Readln(st);

if st<>'~~' then Writeln(f,st);

until st='~~'; end;

procedure WriteToFile;

begin Head;

ReWrite(f);

TextEdit;

Close(f);

Writeln('Vy okonchili vvodit info v file.Najmite lubuyu knopku...');

ReadKey; end;

procedure ReadFromFile;

Head;

Reset(f);

if IOresult<>0 then begin Writeln('file ',FExpand(filename),' ne sushestvuet.');

Writeln((Y/N).');

ch:=ReadKey;

if (ch='Y') or (ch='y') then ReadFromFile;

end else begin Writeln('Soderjimoe faila:');Writeln;

while not eof(f) do begin Readln(f,st);

Writeln('>',st); end;

Close(f);

Writeln;

Writeln('Najmite lubuyu knopku');

ReadKey; end;end;

procedure AddToFile;

begin Head;

Append(f);

if IOresult<>0 then begin

Writeln('faila ',FExpand(filename),' ne sushestvuet.');

Writeln('hotite vvesti drugoe imya faila?(Y/N).');

ch:=ReadKey;

if (ch='Y') or (ch='y') then AddToFile; end else begin TextEdit; Close(f);

Writeln('Vy okon4ili vvodit info v file.Najmite lubuyu knopku...');

ReadKey; end; end;

procedure DelFile;

begin Head;

Reset(f);

if IOresult<>0 then begin Writeln('file ',FExpand(filename),' ne sushestvuet.');

Writeln('hotite vvesti drugoe imya file??(Y/N).');

ch:=ReadKey; if (ch='Y') or (ch='y') then DelFile; end else begin Writeln('vy uvereny 4to hotite udalit etot file?(Y/N)');

ch:=ReadKey; if (ch='Y') or (ch='y') then Erase(f);

Writeln('vy tolko 4to udalili file.Najmite lubuyu klavishu..');

Readkey; end; end;

procedure Menu;

begin repeat repeat ClrScr;

Writeln('1. record file / sozdanie faila');

Writeln('2. read file');

Writeln('3. Dobavlenie info v file');

Writeln('4. delet file');

Writeln('5. Exit');

Write('Vash vybor:>');Readln(vibor);

until (vibor>0) and (vibor<6);

Writeln;

Write('‚л ўлЎа «Ё : ');

case vibor of 1:begin Writeln(' record file / sozdanie faila');

WriteToFile; end;

2:begin Writeln('read file');

ReadFromFile; end;

3:begin Writeln(' Dobavlenie info v file');

AddToFile; end;

4:begin Writeln('delet file');

DelFile; end; end;

until vibor=5; end;

begin Menu;

end.

3.Описание: Дан файл, содержащий текст и арифметические выражения вида, а*в, где * - один из знаков +, -, *, /.Выписать все арифметические выражения и вычислить их значения

program pn12;

var f:text; s,sa,sb:string; c:char; i,a,b,o,j,code:integer; m,op:set of char;

begin m:=['1','2','3','4','5','6','7','8','9','0'];

op:=['+','-','*','/'];

assign(f,'e:\tp\tp6\Arif.dat');reset(f);

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

writeln(s);

for i:=2 to length(s)-1 do if (s[i] in op)and (s[i-1]in m) and (s[i+1]in m) then begin j:=1;

sa:='';

while (s[i-j] in m) and (i-j>0) do begin sa:=s[i-j]+sa;

j:=j+1 end;

j:=1; sb:='';

while (s[i+j] in m) and (i+j<=length(s)) do begin sb:=sb+s[i+j];

j:=j+1 end;

val(sa,a,code);val(sb,b,code);

case s[i] of '+':O:=a+b;

'-':O:=a-b; '*':O:=a*b; '/':O:=a div b; end;

writeln(a,s[i],b,'=',O,' ')

end; end;

close(f);

end.

4.Описание: Вывести максимальное число из файла in.txt

Program one;

var t:text; i,p,code:integer; s:string; m:array[1..100] of real; max:real;

begin assign(t,'in.txt'); reset(t);

read(t,s);

i:=0;

repeat p:=pos(' ',s);

inc(i);

val(copy(s,1,p-1),m[i],code);

delete(s,1,p);

until p=0;

max:=m[1];

for p:=2 to i do if m[p]>max then max:=m[p];

writeln('MAX= ',max);

close(t);

readln;

end.

5.Описание: Перекодирование файла из формата DOS в формат Windows.

Program one;

var f,g:text; i,p,n:integer; m:array [1..100] of string; s:string;

begin assign(f,'in.txt'); reset(f);

assign(g,'out.txt'); rewrite(g);

while not eof(f) do begin readln(f,s); {считываем очередную строку}

i:=0; {ставим счётчик слов на 0}

repeat inc(i); {увеличиваем счётчик текущего ПРЕДЛОЖЕНИЯ}

p:=pos(' ',s); {смотрим где находится пробел}

m[i]:=copy(s,1,p-1); {записываем текущее слово в массив}

delete(s,1,p); {то слово, которое заприсали в массив - удаляем}

until p=0; {****************}

n:=i+1; {конец массива}

if s[length(s)]='.' then begin m[n]:=copy(s,1,length(s)-1); m[1]:=m[1]+'.' {то эту точку перемещаем на 1 слово}

end else m[n]:=s; {а если нет точки - то просто его записываем в массив}

writeln(g);;

for i:=n downto 1 do write(g,m[i],' '); {идём с конца массива в начало и записываем слова в обратном порядке}end;

writeln('PEREZAPISANO...');readln;

close(f); close(g);

end.

6.Описание: Удаление следующих друг за другом нескольких пробелов из файла.

Program one;

const

FileName: String = 'Strings.txt';

VAR f: Text; S: String;

BEGIN Assign(f, FileName); {$I-}Reset(f); {$I+}

if IOResult = 0 then begin ReadLn(f, S); Close(f) end;

WriteLn('input string: ',S);

while (POS(' ', S) > 0) do delete(S, POS(' ',S), 1);

if ( length(S) > 1) and (S[1] = ' ') then Delete(S, 1, 1);

if (length(S)>1) and (S[length(S)] = ' ') then Delete(S, length(S), 1);

writeln('output string: ',s);

readln;

END.

7.Описание: Вывести содержимое файла в обратном порядке в новый файл.

program one;

uses crt;

var fl1,fl2:text;a,b:string; i,l:longint;

begin clrscr;

assign(fl1,'input.txt');

assign(fl2,'output.txt'); reset(fl1); readln(fl1,a);

close(fl1);

l:=length(a);

for i:=l downto 1 do b:=b+a[i];

rewrite(fl2); write(fl2,b);

close(fl2);

write(b); readln;

end.

8.Описание: Бинарный поиск элемента в типизрованном longint файле.

program searches;

uses crt,dos;

type longint_file=file of longint;

procedure files_names_query(var read_file,error:string; var search_value:longint);

var f:text;

begin error:='';

write('`считываемый файл: ');

readln(read_file);

assign(f,read_file);

reset(f);

if (ioresult=0) then begin close(f);

write('находимое значение=');

readln(search_value);

end else begin error:='ошибка:файл не существует'; end; end;

function bin_search(left,right,search_value:longint;var f:longint_file):boolean;

var center,value,new_left,new_right,right_value,center_value:longint;

begin if (left=right) then begin seek(f,left);

read(f,value);

if (value=search_value) then begin bin_search:=TRUE;

end else begin bin_search:=FALSE; end;

end else begin center:=((left+right) div 2)+1;

seek(f,right);

read(f,right_value);

seek(f,center);

read(f,center_value);

if ((search_value>=center_value)and(search_value<=right_value)) then begin new_left:=center;

bin_search:=bin_search(new_left,right,search_value,f);

end else begin new_right:=center-1;

bin_search:=bin_search(left,new_right,search_value,f); end; end; end;

function search(read_file:string; search_value:longint):boolean;

var f:longint_file;

finded:boolean;

elements_count:longint;

begin assign(f,read_file);

reset(f);

finded:=FALSE;

elements_count:=filesize(f);

finded:=bin_search(0,elements_count-1,search_value,f);

close(f);

search:=finded; end;

procedure writing_to_file(write_file:string;finded:boolean;begin_time:longint);

var f:text; hour,minutes,seconds,seconds100:word; end_time:longint; time:real;

begin gettime(hour,minutes,seconds,seconds100);

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

time:=(end_time-begin_time)/100;

assign(f,write_file);

rewrite(f);

if (finded) then writeln(f,'ok') else writeln(f,'error');

writeln(f,time:4:2);

close(f); end;

procedure writing(finded:boolean; begin_time:longint);

begin if (finded) then begin writeln('Element finded complete');

end else begin writeln('Element not finded'); end;

readln; end;

var read_file,write_file,error,search_value_string:string; hour,minutes,seconds,seconds100:word;

begin_time,search_value:longint; k:integer; result:boolean;

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