Antichat снова доступен.
Форум Antichat (Античат) возвращается и снова открыт для пользователей.
Здесь обсуждаются безопасность, программирование, технологии и многое другое.
Сообщество снова собирается вместе.
Новый адрес: forum.antichat.xyz
 |
|

14.12.2008, 03:05
|
|
Новичок
Регистрация: 02.09.2007
Сообщений: 17
Провел на форуме: 874730
Репутация:
77
|
|
Блок-схема программы =(
Помогите пожалуйста сделать блок-схему программы на Паскале... да я тормоз , но сдавать уже в понедельник(((
program sortfile; { Сортировка текстового файла по страницам }
uses
DOS, { для pаботы функции FileExists }
s_text; { содежит пpоцедуpу sort_text }
var
fi, fo: Text; { входной и выходной файл }
s: String;
c, p: Integer; { счетчик стpок и стpаниц }
{ возвpащает False - если файл S не существует и True - если существует }
function FileExists(S: String): Boolean;
var SR: SearchRec;
begin
FindFirst(S, AnyFile - VolumeID - Directory, SR);
FileExists := (DosError = 0);
end;
{ осуществляет посимвольный пеpевоpот стpоки (asdf -> fdsa) }
function RS(s: String): String;
var i: Integer;
v: String;
begin
v[0] := s[0];
for i := 1 to Length(s) do
v[length(s) - i + 1] := s[i];
RS := v;
end;
BEGIN
{ пpовеpяем наличие исходного файла (его имя задаем в командной стpоке) }
if FileExists(ParamStr(1)) = False then
begin
WriteLn(’Файл ‘, ParamStr(1), ‘ не существует!’);
Halt; { заканчиваем pаботу пpогpаммы }
end;
{ откpываем исходный файл для чтения }
Assign(fi, ParamStr(1));
{$I-}
Reset(fi);
{$I+}
if IOResult <> 0 then
begin
WriteLn(’Ошибка пpи откpытии файла’, ParamStr(1), ‘ для чтения!’);
Halt;
end;
{ откpываем вpеменный файл для записи }
Assign(fo, ‘temp.$$$’);
{$I-}
Rewrite(fo);
{$I+}
if IOResult <> 0 then
begin
WriteLn(’Ошибка пpи откpытии файла temp.$$$ для записи!’);
Halt;
end;
while not EOF(fi) do { в цикле пока не достигнут конец исходного файла }
begin
ReadLn(fi, s); { считываем стpоки из исходного файла }
WriteLn(fo, RS(s)); { пеpевоpачиваем стpоки и записываем вo вpеменный файл }
end;
{ закpываем исходный и вpеменный файлы }
Close(fi);
Close(fo);
{ соpтиpуем вpеменный файл (в нем сейчас пеpевеpнутые стpоки) }
sort_file(fo,true);
{ откpываем вpеменный файл для чтения }
Assign(fi, ‘temp.$$$’);
{$I-}
Reset(fi);
{$I+}
if IOResult <> 0 then
begin
WriteLn(’Ошибка пpи откpытии файла temp.$$$ для чтения!’);
Halt;
end;
{ откpываем исходный файл для записи }
Assign(fo, ParamStr(1));
{$I-}
Rewrite(fo);
{$I+}
if IOResult <> 0 then
begin
WriteLn(’Ошибка пpи откpытии файла ‘, ParamStr(1), ‘для записи!’);
Halt;
end;
c := 0;
p := 0;
{ пеpевоpачиваем стpоки из вpеменного файла и выводим постpанично
в исходный файл }
while not EOF(fi) do { пока не достигнут конец файла temp.$$$ }
begin
ReadLn(fi, s); { считываем стpоку из файла temp.$$$ }
if c = 40 then { длина стpаницы - 40 стpок }
begin
c := 0; { обнуляем счетчик стpок }
Inc(p); { увеличиваем нa единицу счетчик стpаниц }
WriteLn(fo, ‘-’,p,’-'); { выводим в исходный файл номеp стpаницы }
end;
WriteLn(fo, RS(s)); { записываем стpоку в исходный файл }
Inc(c);
end;
{ закpываем файлы }
Close(fi);
Close(fo);
{ стиpаем вpеменный файл temp.$$$}
Erase(fi);
END.
UNIT s_text; {Модуль-процедура sort_file}
interface
procedure sort_file(var f:text;r:Boolean);
implementation
procedure sort_file; {Сортировка текстового файла}
{r=false - по убыванию, true - по возрастанию}
var f1,f2:text;
b,b1,b2:string;
i,i1,i2,p:Boolean;
k:integer;
function more_less(x,y:string;ord:Boolean):Boolean;
begin if ord then more_less:=(x else more_less:=(x>=y)
end { more_less};
procedure read_str(var t:text;var buf:string;var big:Boolean);
var s:string;
begin
s:=buf;
readln(t,buf);
if (buf=s) then big:=false
else big:=more_less(buf,s,r);
end { read_str};
procedure write_str(var t:text;buf:string;var int:Boolean);
begin
if not int then writeln(f,buf);
if eof(t) then int:=true
end { write_str};
BEGIN {sort_file}
assign(f1,’F1?);
assign(f2,’F2?);
repeat {разделение нa 2 файла}
reset(f);
rewrite(f1);
rewrite(f2);
k:=1;
readln(f,b);
writeln(f1,b);
while not eof(f) do
begin
read_str(f,b,i);
if i then k:=k+1;
if odd(k) then writeln(f1,b) else writeln(f2,b)
end;{конец разделения}
p:=r;
i1:=false;
i2:=false;
if k>1 then
begin {слияние файлов}
rewrite(f);
reset(f1);
reset(f2);
readln(f1,b1);
readln(f2,b2);
if more_less(b1,b2,p) then write_str(f1,b1,i1)
else write_str(f2,b2,i2);
repeat
if more_less(b1,b2,p) then
if not eof(f1) then
begin
read_str(f1,b1,i1);
if i1 then p:=not p;
i1:=false
end
else p:=not p
else if not eof(f2) then
begin
read_str(f2,b2,i2);
if i2 then p:=not p;
i2:=false
end
else p:=not p;
if more_less(b1,b2,p) then write_str(f1,b1,i1)
else write_str(f2,b2,i2);
until (i1 and i2);
end{конец слияния файлов};
until(k<=2);
close(f);
close(f1);
close(f2);
erase(f1);
erase(f2);
END{sort_file};
END{s_text}.
|
|
|

14.12.2008, 14:55
|
|
Новичок
Регистрация: 02.09.2007
Сообщений: 17
Провел на форуме: 874730
Репутация:
77
|
|
Готов заплатить...
|
|
|

14.12.2008, 16:02
|
|
Pagan Heart
Регистрация: 12.08.2004
Сообщений: 3,791
Провел на форуме: 6490435
Репутация:
2290
|
|
цена вопроса?
|
|
|

14.12.2008, 16:22
|
|
Members of Antichat - Level 5
Регистрация: 01.04.2007
Сообщений: 1,268
Провел на форуме: 10046345
Репутация:
4589
|
|
http://rghost.ru/68078
|
|
|

14.12.2008, 17:38
|
|
Познающий
Регистрация: 27.03.2007
Сообщений: 36
Провел на форуме: 1147600
Репутация:
86
|
|
есть прога которая по коду блок-схему выдает - FCEditor
|
|
|

14.12.2008, 17:44
|
|
Новичок
Регистрация: 02.09.2007
Сообщений: 17
Провел на форуме: 874730
Репутация:
77
|
|
Разве эта блок-схема...? в некоторых ячейках каракули...
|
|
|

14.12.2008, 18:17
|
|
Новичок
Регистрация: 02.09.2007
Сообщений: 17
Провел на форуме: 874730
Репутация:
77
|
|
FCEditor не пашет
|
|
|

14.12.2008, 18:17
|
|
Members of Antichat - Level 5
Регистрация: 01.04.2007
Сообщений: 1,268
Провел на форуме: 10046345
Репутация:
4589
|
|
Сообщение от AL Capone
есть прога которая по коду блок-схему выдает - FCEditor
Кряк: http://rghost.ru/68154
(перезалил)
Сообщение от StocKeR
FCEditor не пашет
Ты свои сорцы вначале исправь, запашет
Последний раз редактировалось BlackSun; 14.12.2008 в 18:22..
|
|
|

14.12.2008, 18:22
|
|
Новичок
Регистрация: 02.09.2007
Сообщений: 17
Провел на форуме: 874730
Репутация:
77
|
|
FCEditor выдает постоянно ошибки(
Последний раз редактировалось StocKeR; 14.12.2008 в 18:46..
|
|
|

14.12.2008, 19:34
|
|
Постоянный
Регистрация: 15.06.2008
Сообщений: 509
Провел на форуме: 2417172
Репутация:
761
|
|
FCEditor выдает постоянно ошибки(
Все должно быть норм!
|
|
|
|
 |
|
|
Здесь присутствуют: 1 (пользователей: 0 , гостей: 1)
|
|
|
|