Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
55
Добавлен:
10.05.2014
Размер:
4.56 Кб
Скачать
{$M 64000,0,600000}
program wordz2;
uses dos;
(*
(c) 2005 Dima Zolotukhin aka 'Zlogic' <zlogic@gmail.com>
Redistributable under GNU GPL license
*)
const
MAX_LENGTH = 100;
type
str_filename = string[79];
str_message = string[70];
str_word = string[MAX_LENGTH];
str1 = string[1];
pword = ^tword;
tword = record
data:str_word;
count:integer;
next:pword;
end;
type_time = record
h,m,s,s100:word;
end;

function get_string(m:str_message):str_filename;
var
temp_str:str_filename;
begin
write(m,'> ');
readln(temp_str);
get_string:=temp_str;
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;

procedure find_min(wordz,to_add:pword;var min:pword);
var
previous:pword;
begin
min:=wordz;
previous:=NIL;
while(wordz<>NIL)and(wordz^.data<to_add^.data)do
begin
previous:=wordz;
wordz:=wordz^.next;
end;
min:=previous;
end;

function find_element(root:pword;data_to_find:str_word):pword;
begin
while(root<>NIL)and(root^.data<>data_to_find)do
root:=root^.next;
find_element:=root;
end;

procedure add_element_sorted(var wordz:pword;const current_word:str_word);
var
new_pword:pword;
add_after:pword;
begin
add_after:=find_element(wordz,current_word);
if(add_after=NIL)then{Ґб«Ё н«-в ­Ґ Ґбвм}
begin
new(new_pword);{ ««®жЁа㥬 Ї ¬пвм}
new_pword^.data:=current_word;
new_pword^.next:=NIL;
new_pword^.count:=1;
find_min(wordz,new_pword,add_after);{ЁйҐ¬, Єг¤  ¤®Ў ўЁвм}
if(add_after=NIL)then{Ґб«Ё н«Ґ¬Ґ­в ¤®Ў ў«пҐвбп ў ­ з «®}
begin
new_pword^.next:=wordz;{б®е࠭塞 ббл«ЄЁ}
wordz:=new_pword;
end
else{Ґб«Ё н«Ґ¬Ґ­в ¤®Ў ў«пҐвбп ў бҐаҐ¤Ё­г}
begin
new_pword^.next:=add_after^.next;{б®е࠭塞 ббл«ЄЁ}
add_after^.next:=new_pword;
end;
end
else{Ё­ зҐ}
add_after^.count:=add_after^.count+1;{бзЁв Ґ¬}
end;

procedure read_line(var file_in:text;var wordz:pword);
var
current_symbol:str1;
current_word:str_word;
new_pword:pword;
begin
current_word:='';
while not eoln(file_in)do{¤® Є®­ж  бва®ЄЁ}
begin
read(file_in,current_symbol);{зЁв Ґ¬ бЁ¬ў®«}
if(current_symbol<>' ')then{Ґб«Ё нв® ЎгЄў }
current_word:=current_word+current_symbol;{¤®Ў ў«пҐ¬ Є ⥪г饩 бва®ЄҐ}
if(current_symbol=' ')or eoln(file_in) or(length(current_word)=MAX_LENGTH)then{Ё­ зҐ}
begin
if length(current_word)<>0 then{Ґб«Ё бва®Є  ­Ґ Їгбв п}
begin
add_element_sorted(wordz,current_word);{¤®Ў ў«пҐ¬ н«Ґ¬Ґ­в}
current_word:='';{®Ў­г«пҐ¬ б«®ў®}
end;
end;
end;
end;

procedure read_wordz(var file_in:text;var wordz:pword);
begin
while not eof(file_in)do{¤® Є®­ж  д ©« }
begin
read_line(file_in,wordz);{зЁв Ґ¬ бва®Єг}
readln(file_in);{ЇҐаҐе®¤Ё¬ ­  б«Ґ¤гойго бва®Єг}
end;
end;

procedure write_wordz(var file_out:text;wordz:pword);
begin
while(wordz<>NIL)do
begin
writeln(file_out,wordz^.data,' ',wordz^.count);
wordz:=wordz^.next;
end;
end;

procedure get_time(var clock:type_time);
begin
with clock do
gettime(h,m,s,s100);
end;

function timespan(start_time:type_time):real;
var
current_time:type_time;
delta:real;
begin
get_time(current_time);
timespan:=(current_time.h-start_time.h)*3600+(current_time.m-start_time.m)*60+
(current_time.s-start_time.s)+(current_time.s100-start_time.s100)*0.01;
end;

var
file_in_name,file_out_name:str_filename;
file_in,file_out:text;
wordz:pword;
start_time:type_time;
begin
wordz:=NIL;
file_in_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п ўе®¤­®Ј® д ©« ');{Ї®«гз Ґ¬ Ё¬Ґ­  д ©«®ў}
file_out_name:=get_string('‚ўҐ¤ЁвҐ Ё¬п д ©«  ¤«п ўлў®¤ ');
get_time(start_time);
if(open_files(file_in_name,file_out_name,file_in,file_out))then{®вЄалў Ґ¬ д ©«л}
begin{Ґб«Ё ®вЄал«Ёбм}
read_wordz(file_in,wordz);{зЁв Ґ¬ б«®ў  Ё§ д ©«  ў ¬ ббЁў}
write_wordz(file_out,wordz);{ўлў®¤Ё¬ ®вб®авЁа®ў ­­л© ¬ ббЁў ў д ©«}
close(file_in);{§ Єалў Ґ¬ д ©«л}
close(file_out);
end
else{Ё­ зҐ}
writeln('ЌҐў®§¬®¦­® ®вЄалвм д ©«л!');{ўлў®¤Ё¬ б®®ЎйҐ­ЁҐ}
writeln('ЋЎа Ў®вЄ  ўҐ« бм ',timespan(start_time):0:2,' ᥪ㭤');
writeln('Ќ ¦¬ЁвҐ RETURN ¤«п ўл室 .');
readln;
end.
Соседние файлы в папке 08