Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
57
Добавлен:
10.05.2014
Размер:
3.54 Кб
Скачать
program sortwordz;
const
WORDZ_MAX = 1000;
WORD_LENGTH_MAX = 150;
VALID_LETTERS = 'qwertyuiopasdfghjklzxcvbnm' +
'QWERTYUIOPASDFGHJKLZXCVBNM' +
'©жгЄҐ­Јий§едлў Їа®«¤¦нпзб¬ЁвмЎок' +
'‰–“Љ…Ќѓ™‡•”›‚ЂЏђЋ‹„†ќџ—‘Њ€’њЃћљ';
type
str_message = string[40];
str_filename = string[128];
type_word = string[WORD_LENGTH_MAX];
type_word_pointer = ^type_word;
str_array = array[1..WORDZ_MAX]of type_word_pointer;
str1 = string[1];

function get_string(message:str_message):str_filename;
var
response:str_filename;
begin
write(message,': ');
readln(response);
get_string:=response;
end;

function open_files(file_in_name,file_out_name:str_filename;var file_in,file_out:text):boolean;
begin
assign(file_in,file_in_name);
assign(file_out,file_out_name);
{$I-}
rewrite(file_out);
reset(file_in);
{$I+}
open_files:=ioresult=0;
end;

function is_letter(symbol:str1):boolean;
begin
is_letter:=pos(symbol,VALID_LETTERS)<>0;
end;
procedure read_line(var file_in:text;var wordz:str_array;var N:integer);
var
current_symbol:str1;
current_word:type_word;
begin
current_word:='';
while not eoln(file_in)do{¤® Є®­ж  бва®ЄЁ}
begin
read(file_in,current_symbol);{зЁв Ґ¬ бЁ¬ў®«}
if is_letter(current_symbol)then{Ґб«Ё нв® ЎгЄў }
current_word:=current_word+current_symbol{¤®Ў ў«пҐ¬ Є ⥪г饩 бва®ЄҐ}
else{Ё­ зҐ}
begin
if length(current_word)<>0 then{Ґб«Ё бва®Є  ­Ґ Їгбв п}
begin
N:=N+1;
new(wordz[N]);{ ««®жЁа㥬 Ї ¬пвм}
wordz[N]^:=current_word;{¤®Ў ў«пҐ¬ ҐҐ Є ¬ ббЁўг}
current_word:='';{®Ў­г«пҐ¬ б«®ў®}
end;
end;
end;
end;
procedure read_wordz(var file_in:text;var wordz:str_array;var N:integer);
begin
while not eof(file_in)do{¤® Є®­ж  д ©« }
begin
read_line(file_in,wordz,N);{зЁв Ґ¬ бва®Єг}
readln(file_in);{ЇҐаҐе®¤Ё¬ ­  б«Ґ¤гойго бва®Єг}
end;
end;
procedure find_min(wordz:str_array;N,start:integer;var min:integer);
var
i:integer;
begin
min:=start;
for i:=start+1 to N do
begin
if wordz[i]^<wordz[min]^ then
min:=i;
end;
end;
procedure swap(var x,y:type_word_pointer);
var
temp:type_word_pointer;
begin
temp:=x;
x:=y;
y:=temp;
end;
procedure sort_wordz(var wordz:str_array;N:integer);
var
i:integer;
min:integer;
begin
for i:=1 to N do{¤«п Є ¦¤®© Ї®§ЁжЁЁ}
begin
find_min(wordz,N,i,min);{ЁйҐ¬ ¬Ё­Ё¬г¬ ®бв ўиЁебп б«®ў}
swap(wordz[min],wordz[i]);{¬Ґ­пҐ¬ ⥪г饥 б«®ў® ¬Ґбв ¬Ё б ¬Ё­Ё¬ «м­л¬}
end;
end;
procedure write_wordz(var file_out:text;wordz:str_array;N:integer);
var
i:integer;
begin
for i:=1 to N do
writeln(file_out,wordz[i]^);
end;

var
file_in_name,file_out_name:str_filename;
file_in,file_out:text;
wordz:str_array;
N:integer;

begin
N:=0;
file_in_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п ўе®¤­®Ј® д ©« ');{Ї®«гз Ґ¬ Ё¬Ґ­  д ©«®ў}
file_out_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п д ©«  ¤«п ўлў®¤ ');
if(open_files(file_in_name,file_out_name,file_in,file_out))then{®вЄалў Ґ¬ д ©«л}
begin{Ґб«Ё ®вЄал«Ёбм}
read_wordz(file_in,wordz,N);{зЁв Ґ¬ б«®ў  Ё§ д ©«  ў ¬ ббЁў}
sort_wordz(wordz,N);{б®авЁа㥬 ¬ ббЁў}
write_wordz(file_out,wordz,N);{ўлў®¤Ё¬ ®вб®авЁа®ў ­­л© ¬ ббЁў ў д ©«}
close(file_in);{§ Єалў Ґ¬ д ©«л}
close(file_out);
end
else{Ё­ зҐ}
writeln('ЌҐў®§¬®¦­® ®вЄалвм д ©«л!');{ўлў®¤Ё¬ б®®ЎйҐ­ЁҐ}
writeln('Ќ ¦¬ЁвҐ RETURN ¤«п ўл室 .');
readln;
end.