freepascal.ru

Аномалию какую та нашёл, при многократном использовании insert(?,z,8); и Delete(z,8,1); ,после многократного использования z: string;
в процедуре 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 ЦП, может чёто добавить надо в начале программы?

RENXFIL писал(а):А можно сделать так чтоб нагрузка ложилась на 4 ЦП, может чёто добавить надо в начале программы?

Нужно писать многопоточные приложения, т.е. распараллеливать сам алгоритм. Основные сложности с самим алгоритмом, а потоки создаются просто см. Thread