в процедуре procedure RenPoisc_xfil(f: string; var c: string);
- Код: Выделить всё
program ren_name;
{$mode objfpc}{$H+}
uses DOS,CRT,Windows,renxfiltrus;
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
var format,a: string;
ch: char;
q: byte;
name: string;
procedure RenxWin(e: byte; texfon,colfon: byte);
var lin: string;
z,x: char;
q,w: byte;
begin
q:=0; w:=1;
z:=chr(205); x:=chr(186);
textcolor(texfon);
textbackground(colfon);
while q<24 do
begin
insert(z,lin,q);
inc(q);
if q=24 then
begin
write(chr(201),lin,'::(RENXFILSYSTEMSKIBERDAIMS)::',lin,chr(187));
for q:=2 to 23 do
begin
if q<>e then
begin
gotoxy(w,q); write(x);
w:=w+79;
gotoxy(w,q); write(x);
w:=w-79;
end;
if q=e then
begin
write(chr(204),lin,lin,z,z,z,z,z,z,lin,chr(185));
e:=0;
end;
end;
q:=24;
end;
end;
write(chr(200),lin,lin,z,z,z,z,z,z,lin,chr(188));
textcolor(12);
normvideo;
textcolor(10);
end;
procedure RenPoisc_xfil(f: string; var c: string);
var
Buf: array[0..58] of char;
q,w,e: byte;
d: byte;
z: string;
zz: text;
begin
clrscr;
RenxWin(3,11,1); {Размер окна, Цвет линии, Цвет фона}
xfiltrlazlaz:='Определение имени документа в корневой папке';
xfil_ruslazdos;
gotoxy(18,2); write(xfiltrlazdos);
{Система распределения символов в параметре Buf}
q:=97; w:=0;
while q<=242 do
begin
Buf[w]:=chr(q);
if q=122 then q:=159;
if q=175 then q:=223;
if q=239 then q:=240;
inc(w);
inc(q);
end;
{Системный фильтр перевода символов в WINDOWS TEXT}
for q:=26 to 58 do
begin
xfiltrDosDos:=Buf[q];
xfil_rusDosTxt;
Buf[q]:=xfiltrDosTxt[1];
end;
{Соединение параметров}
z:='c:zal';
z:=z+f;
q:=0; w:=0; e:=0;
d:=1;
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
while e<=58 do
begin
while w<=58 do
begin
while q<=58 do
begin
assign(zz,z);
{$I-}
reset(zz);
{$I+}
if IOResult=0 then
begin
c:=z;
Exit;
end;
inc(q);
end;
q:=0;
if w>=d then Delete(z,8,1);
gotoxy(3,11); write('1 ',z);
readln;
insert(Buf[w],z,8);
gotoxy(3,12); write('2 ',z);
readln;
inc(w);
end;
w:=0;
d:=0;
if e>=1 then
begin
Delete(z,8,2);
if e=1 then insert(Buf[e],z,8);
gotoxy(3,16); write('4 ',z);
end;
gotoxy(3,17); write('5 ',z);
readln;
if e<>1 then insert(Buf[e],z,8);
gotoxy(3,18); write('6 ',z);
readln;
inc(e);
end;
end;
begin
repeat
repeat
clrscr;
RenxWin(3,11,1); {Razmer okna, Color linii, Color fona}
xfiltrlazlaz:='Определение имени документа в корневой папке';
xfil_ruslazdos;
gotoxy(18,2); write(xfiltrlazdos);
xfiltrlazlaz:='Введите формат, пример -> .txt';
xfil_ruslazdos;
gotoxy(3,5); write(xfiltrlazdos);
xfiltrlazlaz:='ВЫХОД -> 0';
xfil_ruslazdos;
gotoxy(35,22); write(xfiltrlazdos);
gotoxy(3,6); readln(format);
if format='0' then Halt;
q:=pos('.',format);
if q=1 then
begin
textcolor(12);
xfiltrlazlaz:='СТАРТ!!!';
xfil_ruslazdos;
gotoxy(35,7); write(xfiltrlazdos);
readln;
RenPoisc_Xfil(format,name); {<FILTERS}
ch:='1';
end
else
if q=0 then
begin
xfiltrlazlaz:='В формате отсутствует точка [.]';
xfil_ruslazdos;
gotoxy(3,9); write(xfiltrlazdos);
gotoxy(35,22); write(' <ENTER> ');
gotoxy(3,23); readln;
ch:='0';
end
else
begin
xfiltrlazlaz:='Точка находится не в начале, пример: -> [.txt]';
xfil_ruslazdos;
gotoxy(3,9); write(xfiltrlazdos);
gotoxy(35,22); write(' <ENTER> ');
gotoxy(3,23); readln;
ch:='0';
end;
until ch='1';
xfiltrlazlaz:='Имя файла ->';
xfil_ruslazdos;
gotoxy(3,19); write(xfiltrlazdos);
xfiltrTxtTxt:=name;
xfil_rusTxtDos;
gotoxy(16,19); write(xfiltrTxtDos);
{=============}
xfiltrlazlaz:='Для окончания работы введите <0> -> ';
xfil_ruslazdos;
gotoxy(3,22); textcolor(10); write(xfiltrlazdos);
gotoxy(39,22); readln(ch);
if ch='0' then break;
until false;
end.
Во общем происходит следующее, z = c:zal(здесь два символа chr(256)).txt
пошёл Delete(z,8,2); и после него insert(Buf[e],z,8); insert(Buf[e],z,8);
и почему то получается такое z = c:zal(здесь chr(98)).txtt (и откуда та появляется символ t) ????
хотя insert(Buf[e],z,8); восьмое место показывает.renxfiltrus; - это личный фильтр, он переводит формат с DOS-а в формат Windows text, и многое другое, работает нормально
фильтр от сюда - http://www.cyberforum.ru/free-pascal/th ... page4.html
Добавлено спустя 6 часов 47 минут 6 секунд:
Переписал снова, это нормально работает, другим методом, по моему даже быстрее =)
- Код: Выделить всё
{XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}
insert(' ',z,8);
while r<=59 do
begin
while e<=59 do
begin
while w<=59 do
begin
while q<=59 do
begin
z[8]:=Buf[q];
assign(zz,z);
{$I-}
reset(zz);
{$I+}
if IOResult=0 then
begin
a:=0; s:=0;
a:=pos('\nul.txt',z);
s:=s+a;
a:=pos('\con.txt',z);
s:=s+a;
a:=pos('\aux.txt',z);
s:=s+a;
if s=0 then
begin
c:=z;
Exit;
end;
end;
inc(q);
end; {=======V=======}
q:=1;
inc(w);
if d=0 then
begin
insert(' ',z,9);
d:=1;
end;
z[9]:=Buf[w];
end; {=======V=======}
w:=0;
inc(e);
if d=1 then
begin
insert(' ',z,10);
d:=2;
end;
z[10]:=Buf[e];
gotoxy(3,9); write(z,' w=',w);
end; {=======V=======}
e:=0;
gotoxy(3,12); write(z,' w=',w);
readln;
inc(r);
if d=2 then
begin
insert(' ',z,11);
d:=3;
end;
z[11]:=Buf[r];
gotoxy(3,13); write(z,' w=',w);
end;
А можно сделать так чтоб нагрузка ложилась на 4 ЦП, может чёто добавить надо в начале программы?
