alm.*z

{
Нахождение в заданном словаре слов,
содержащих только буквы заданного слова
(например дано слово "программа", 
и из него можно составить слова пар,паром,грамм,рог...)
основное слово вводиться с клавиатуры,
вывод результатов по желанию на экран или файл.
 
Словарь храниться в текст. файле - каждое слово на отдельной строке:
содержит примерно 20000 слов; 
должна быть представлена возможность добавления слов в словарь,
причем,если вводимое с клавиатуры слово уже есть в словаре,
оно не должно добавляться повторно.
}
 
uses crt;  {использовать модуль псевдорафики}
 
var 
	f	:text; {указатель на файл}
        adres	:string; {адрес файла-словаря}
        slovar	:string; {словарь}
        slovo	:string; {для слова}
	k	:integer; {счетчик}
	i	:longint; {счетчик}
	l	:boolean; {нашли или нет}
	ch	:char; {символ}
 
 
{проверяет наличие слов содержащих буквы заданного слова}
function proverka(slovo, slovar :string) :boolean;  
var  {секция бъявления переменных}
	flag	:boolean; {нашли или нет}
        ch	:char; {}
begin {начало тела функции}
	flag := true; {установка флага в ИСТИНУ}
	repeat {начало тела цикла}
		if pos(slovar[1], slovo) = 0 then  {есть ли в слове первая буква соваря?}
			flag := false {установить флаг в ЛОЖЬ}
		else {иначе}
		begin
			delete(slovo, pos(slovar[1], slovo),1); {удалить первую букву словаря из слова}
			delete(slovar, 1, 1); {удалить 1й символ из словаря}
		end;
	until(flag = false) or (slovar = ''); {до тех пор, пока флаг истенен и словарь не пуст}
	proverka := flag; {вернут ьрезультатом флаг}
end; {конец функции}
 
 
begin {начало тела прогарммы}
	l := false; {уатановить l в ЛОЖЬ}
	clrscr; {очистить экран}
	writeln('Dobavit slovo v slovar : 1 '); {вывести меню}
	writeln('Nayti v slovare slova  : 2 '); {вывести меню}
	ch := readkey; {прочитать символ с клавиатуры в ch}
 
	if ch = '1' then {если введено 1 то}
	begin
		clrscr; {очистить экран}
		writeln('Vvedite adres slovarya '); 
		readln(adres); {прочитать адрес}
		writeln('Vvedite slovo kotoroe nado dobavit '); 
		readln(slovo); {прочитать слово}
 
		assign(f, adres); {прикрепитьуказатель на файл}
		reset(f); {перемотать файл}
		repeat {начало тела цикла}
			readln(f, slovar); {прочитать строку из файла в словарь}
			if slovo = slovar then  {если слово равно со строкой}
				l := true; {установить L в истину}
		until(eof(f)) or (l); {повторять до тех пор, пока не кончится файл или не найдем такое же слово}
		close(f); {закрыть файл}
 
		if l then {если l истинен}
			writeln('Takoe slovo est ')
		else {иначе}
		begin
			append(f); {добавить к файлу}
			writeln(f, slovo); {вывести слово в файл}
			close(f); {закрыт ьфайл}
			writeln('Slovo dobavleno ');
		end;
	end;
 
	if ch = '2' then {если введено 2}
	begin
		clrscr; {очистить экран}
		writeln('Vvedite adres slovarya '); 
		readln(adres); {прочитать адрес}
		writeln('Vvedite slovo ');
		readln(slovo); {прочитать слово}
 
		assign(f, adres); {прочитать адрес}
		reset(f); {перемотать}
		k := 0; {обнулить k}
		i := 0; {обнулить i}
		repeat {начало цикла}
			readln(f, slovar); {прочитать из файла строкув словарь}
			if length(slovar) <= length(slovo) then {если словарь меньше или равен слову}
				if proverka(slovo, slovar) = true then {слово есть в словаре словарю}
				begin
					l := true; 
					writeln(slovar); 
					k := k+1; 
					i := i+1; 
				end;
			if k = 20 then 
			begin
				readln; {прочиатть строку}
				k := 0; {обнулить k}
			end;
		until(eof(f)); {до конца файла}
 
 
		if l = false then  {если L ложно}
			writeln('Net')
		else  {иначе}
			writeln('Naydeno ', i, ' slov');
 
	end;
 
	readln; {прочитать строку}
end. {конец прогарммы}