Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
60
Добавлен:
10.05.2014
Размер:
4.46 Кб
Скачать
{$R+}
program qsort;
(*
(c) 2005 Dima Zolotukhin aka 'Zlogic' <zlogic@gmail.com>
Redistributable under GNU GPL license
*)

const
MAX_PATH = 79;
DELETED_STRING = '**********';
TEMP_FILENAME = 'whash.tmp';
STREAM_LENGTH = 5;
type
str_path = string[MAX_PATH];
str_message = string[70];
str_word = string[10];
type_file = file of str_word;
type_index = longint;

function get_string(m:str_message):str_path;
var
temp_str:str_path;
begin
write(m,'> ');
readln(temp_str);
get_string:=temp_str;
end;

function get_word(message:str_message):str_word;
var
response:str_word;
begin
write(message,'> ');
readln(response);
get_word:=response;
end;

function get_int(message:str_message):integer;
var
response:integer;
begin
write(message,'> ');
readln(response);
get_int:=response;
end;

procedure print_menu;
begin
writeln;
writeln('<< Њ…Ќћ •ќ-‘Ћђ’€ђЋ‚Љ€ >>');
writeln('1 „®Ў ўЁвм н«Ґ¬Ґ­в');
writeln('2 Ќ ©вЁ н«Ґ¬Ґ­в');
writeln('3 “¤ «Ёвм н«Ґ¬Ґ­в');
writeln('4 ‘Ўа®бЁвм ¤ ­­лҐ ў д ©«');
writeln('5 ‚л室');
end;

function calc_hash(s:str_word):longint;
var
sum:longint;
i:byte;
first:byte;
hash:longint;
begin
hash:=0;
first:=0;
sum:=0;
for i:=1 to length(s)do{¤«п Є ¦¤®Ј® бЁ¬ў®« }
begin
if(((i -1) mod STREAM_LENGTH)=0)then{Ґб«Ё ўбваҐвЁ«Ё Ј®«®ўг}
begin
hash:=hash+first*sum;{¤®Ў ў«пҐ¬ ени}
sum:=0;{®Ў­г«пҐ¬}
first:=ord(s[i]);{§ ЇЁблў Ґ¬ ЇҐаўл© н«Ґ¬Ґ­в}
end
else{Ё­ зҐ}
begin
sum:=sum+ord(s[i]);{бзЁв Ґ¬ б㬬г}
end;
end;
calc_hash:=hash+first*sum;
end;


function open_file(var f:type_file):boolean;
begin
{$I-}
rewrite(f);
{$I+}
open_file:=ioresult=0;
end;

function get_data(var mfile:type_file;i:type_index):str_word;
var
tmp:str_word;
begin
seek(mfile,i);
if not eof(mfile)then
read(mfile,tmp)
else
tmp:='';
get_data:=tmp;
end;

procedure add_hash(var _hash:type_file;word:str_word);
var
i:type_index;
begin
i:=calc_hash(word);
if(get_data(_hash,i)='')then{Ґб«Ё ¬Ґбв® бў®Ў®¤­®}
seek(_hash,i){§ ЇЁблў Ґ¬}
else{Ё­ зҐ}
begin
repeat{ЁйҐ¬ бў®Ў®¤­®Ґ ¬Ґбв®}
i:=i+1;
until eof(_hash) or (get_data(_hash,i)='');
end;
write(_hash,word);{§ ЇЁблў Ґ¬}
end;

function find_hash(var _hash:type_file;word:str_word):type_index;
var
i:type_index;
begin
i:=calc_hash(word);
while(get_data(_hash,i)<>word)and not eof(_hash)do
i:=i+1;
if(get_data(_hash,i)<>word)and eof(_hash)then
i:=-1;
find_hash:=i;
end;

function delete_hash(var _hash:type_file;word:str_word):boolean;
var
i:integer;
begin
i:=find_hash(_hash,word);
if(i<>-1)then{Ґб«Ё н«Ґ¬Ґ­в ­ ©¤Ґ­}
begin
seek(_hash,i);{г¤ «пҐ¬}
word:=DELETED_STRING;
write(_hash,word);
end;
delete_hash:=i<>-1;
end;

procedure save_hash(var _hash:type_file;file_out_name:str_path);
var
file_out:text;
word:str_word;
begin
assign(file_out,file_out_name);{в®Єалў Ґ¬ д ©« ­  ўлў®¤}
rewrite(file_out);
seek(_hash,0);
while not eof(_hash)do{¤® Є®­ж  ени }
begin
read(_hash,word);{зЁв Ґ¬ бва®Єг}
if(word<>'')and(word<>DELETED_STRING)then{Ґб«Ё нв® б«®ў®}
writeln(file_out,word);{ўлў®¤Ё¬}
end;
close(file_out);
end;

var
_hash:type_file;
response:integer;
exit:boolean;
begin
assign(_hash,temp_filename);{®вЄалў Ґ¬ д ©«}
if(open_file(_hash))then
begin
exit:=false;
while not exit do{Ї®Є  ­Ґ ­г¦­® ўл©вЁ}
begin
print_menu;{Ї®Є §лў Ґ¬ ¬Ґ­о}
response:=get_int('‚лЎҐаЁвҐ ў аЁ ­в');{зЁв Ґ¬ ®вўҐв Ї®«м§®ў вҐ«п}
writeln;
case response of
1:add_hash(_hash,get_word('‚ўҐ¤ЁвҐ, зв® ¤®Ў ўЁвм ў ¬ ббЁў'));{¤®Ў ў«Ґ­ЁҐ н«Ґ¬Ґ­в  ў ¬ ббЁў}

2:if(find_hash(_hash,get_word('‚ўҐ¤ЁвҐ, зв® ­г¦­® ­ ©вЁ'))<>-1)then{Ї®ЁбЄ н«Ґ¬Ґ­в  ў ениҐ}
writeln('<< ќ‹…Њ…Ќ’ ЌЂ‰„Ќ >>')
else
writeln('<< ќ‹…Њ…Ќ’ Ќ… ЌЂ‰„…Ќ >>');
3:if(not delete_hash(_hash,get_word('‚ўҐ¤ЁвҐ, зв® г¤ «Ёвм Ё§ ¬ ббЁў ')))then{г¤ «Ґ­ЁҐ н«Ґ¬Ґ­в  Ё§ ¬ ббЁў }
writeln('<< ќ‹…Њ…Ќ’ Ќ… ЌЂ‰„…Ќ >>');
4:save_hash(_hash,get_string('‚ўҐ¤ЁвҐ Ё¬п д ©« , Єг¤  бЎа®бЁвм бва®ЄЁ'));
5:exit:=true;{ўл室}
end;
end;
close(_hash);
end
else
begin
writeln('<< Ћ€ЃЉЂ: д ©« ­Ґ ®вЄалв >>');
readln;
end;
end.
Соседние файлы в папке 10