Алгоритм перебора символов.

← →
Nikfel © (2007-06-22 16:42) [0]

Пожалуйста подскажите. Как лудше сделать перебор символов. Вот мой вариант, но может есть по короче и быстрее.
var
ttkd:string;
nmp:integer;
strTURNSL:array[1..999999] of string;

function dwsaq(strq:string):string;
var intX,intY:integer;
strF:string;
begin
intX:=length(strq);
for intY:=1 to intX do
begin
strF:=strF+strTURNSL[nmp];
end;
if strF=strq then begin
strF:="";
for intY:=1 to intX+1 do
begin
strF:=strF+strTURNSL[1];
end;
result:=strF;
end else result:=strq;
end;

function trueWT(strS:string;i:integer):boolean;
var intD:integer;
begin
for intD:=1 to nmp-1 do
begin
if copy(strS,i,1)=strTURNSL[intD] then
begin
ttkd:=copy(strS,1,i-1)+strTURNSL[intD+1]
+copy(strS,i+1,length(strS));
result:=true;
end;
end;
if copy(strS,i,1)=strTURNSL[nmp] then
begin
ttkd:=copy(strS,1,i-1)+strTURNSL[1]
+copy(strS,i+1,length(strS));
result:=false;
end;
end;

function startf(strNS:string):string;
var hndg:integer;
begin
ttkd:=strNS;
ttkd:=dwsaq(ttkd);
if strNS<>ttkd then
begin
result:=ttkd;
exit;
end;
hndg:=length(ttkd);
while hndg>0 do
begin
if trueWT(ttkd,hndg) then
begin
result:=ttkd;
exit;
end else hndg:=hndg-1;
end;
end;

procedure TForm1.KOLForm1FormCreate(Sender: PObj);
var F: TextFile;
S,strS: string;
intI:integer;
begin
AssignFile(F,"111.TXT");\\файл с набором символов
Reset(F);
while Not EOF(F) do
begin
Readln(F, S);
strS:=StrS+S;
end;
CloseFile(F);
nmp:=length(StrS);
for intI:=1 to nmp do
begin
strTURNSL[intI]:=copy(strS,intI,1);
end;
end;

procedure TForm1.Button1Click(Sender: PObj);
begin
EditBox1.Text:=startf(EditBox1.Text);
end;

Как можно проверить пароль к архиву rar и zip, подходит он или нет.

← →
AndreyRus (2007-06-22 17:37) [1]

А причем здесь KOL!

Алгоритм перебора символов. Найти похожие ветки