Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.12.2010, 19:23
MrDiG MrDiG вне форума
Начинающий
 
Регистрация: 05.10.2010
Сообщения: 112
Репутация: 1227
По умолчанию Одна авторизация - много потоков

При работе с потоками меня смущает один момент. Когда мне нужно произвести авторизованное действие, то я в каждом потоке авторизуюсь и произвожу какое-то действие. Естественно - это колоссальное количество ненужных авторизаций. Каким образом можно производить действия с одной авторизации? Для наглядности ниже код, который отправляет публичные сообщения пользователям популярного форумного движка. Каким образом нужно модифицировать этот код, чтобы авторизовывался я только один раз, а постинг происходил в многопоточном режиме. Собственно код:


Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP,
  StdCtrls, ComCtrls, Gauges, SyncObjs, IdCookieManager, ActiveX, VBScript_RegExp_55_TLB;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    UpDown1: TUpDown;
    Button1: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    GoodLabel: TLabel;
    IdHTTP1: TIdHTTP;
    Gauge1: TGauge;
    Button2: TButton;
    Memo1: TMemo;
    IdCookieManager1: TIdCookieManager;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

 TNewThread = class(TThread)
  private
   FAcc : string;
   page:string;
   session,security,u,u2,lastcomment:string;
  protected
    procedure Execute; override;
  public
    procedure Sync;
    constructor Create(CreateSuspended: Boolean);
    function Parse(page:string; pattern:string):string;
  end;

var
  Form1: TForm1;
  Accounts:Tstringlist;
  Thread, Acc:integer;
  Work:boolean;
  CS:TcriticalSection;

implementation

{$R *.dfm}

constructor TNewThread.Create(CreateSuspended: Boolean);
begin
  inherited Create(CreateSuspended);
end;


procedure TForm1.Button1Click(Sender: TObject);       // Подготовка аккаунтов
begin
 OpenDialog1.InitialDir:=ExtractFilePath(Application.ExeName);
 if OpenDialog1.Execute then
  begin
   Accounts.Clear;
   Accounts.LoadFromFile(OpenDialog1.FileName);
   Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
  end;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin
 GoodLabel.Caption:='0';  //Тут будут отправленные
 Gauge1.MaxValue:=Accounts.Count; //Всего - количество для спама
 Gauge1.Progress:=0; //Текущий указатель
 Work:=true; //Запускаем
 for Thread:=1  to strtoint(Edit1.Text) do  //Устанавливаем количество потоков
  TNewThread.Create(false);
  Thread:=strtoint(Edit1.Text);
end;








procedure TNewThread.Execute;
var CurAcc:integer;
    data:Tstringlist;
    HTTP: TIdHTTP;
    CookieManager:TIdCookieManager;
begin
CoInitialize(nil);
 while Work do
  begin
   CS.Enter;
   Inc(Acc);
   if Acc<Accounts.Count then CurAcc:=Acc else Work:=false;
   CS.Leave;

   if Work then
    begin
     FAcc:= Accounts[CurAcc];  //Тут текущий аккаунт

     data:=tstringlist.Create;
HTTP:=tidHTTP.Create();
CookieManager:=tidCookieManager.Create();

HTTP.AllowCookies:=true;
HTTP.CookieManager:=CookieManager;
HTTP.HandleRedirects:=true;
HTTP.Request.UserAgent:='Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13';

page:=HTTP.Get('http://forums.bla-bla-bla.com/index.php');

session:=Parse(page,'name="s" value="(.*)"');
security:=Parse(page,'name="securitytoken" value="(.*)"');

data.Add('vb_login_username=USERNAME');
data.Add('cookieuser=1');
data.Add('vb_login_password=');
data.Add('s='+session);
data.Add('securitytoken='+security);
data.Add('do=login');
data.Add('vb_login_md5password=0945fc9611f55fd0e183fb8b144f1afe');
data.Add('vb_login_md5password_utf=0945fc9611f55fd0e183fb8b144f1afe');
HTTP.Post('http://forums.bla-bla-bla.com/login.php?do=login',data);
data.Clear;

page:=HTTP.Get(trim(Facc));

security:=Parse(page,'name="securitytoken" value="(.*)"');
u:=Parse(page,'name="u" value="(.*)"');
u2:=Parse(page,'name="u2" value="(.*)"');
lastcomment:=Parse(page,'name="lastcomment" value="(.*)"');

data.Add('ajax=1');
data.Add('wysiwyg=0');
data.Add('styleid=0');
data.Add('fromquickcomment=1');
data.Add('s=');
data.Add('securitytoken='+security);
data.Add('do=message');
data.Add('u='+u);
data.Add('u2='+u2);
data.Add('loggedinuser='+u);
data.Add('parseurl=1');
data.Add('lastcomment='+lastcomment);
data.Add('allow_ajax_qc=1');
data.Add('fromconverse=');
data.Add('message=MESSAGE');

try

HTTP.Post('http://forums.bla-bla-bla.com/visitormessage.php?do=message',data);
data.Clear;
finally
data.Free;
HTTP.Free;
CookieManager.Free;

end;


 Synchronize(Sync);
 end;

  end;

 dec(Thread);
 if Thread=0 then ShowMessage('OK');
end;







function TNewThread.Parse(page, pattern: string): string;
var
  Reg: TRegExp;
  mc: MatchCollection;
  m: Match;
  sm: SubMatches;
  i:Integer;
  s,r:string;


begin

  Reg := TRegExp.Create(Form1);
  try
    //Reg.Pattern := 'name="s" value="(.*)"';
    s:=page;
    Reg.Pattern:=pattern;
    Reg.IgnoreCase:=true;
    Reg.Global:=true;
    Reg.Multiline:=true;
    mc:=Reg.Execute(s) as MatchCollection;
    for I := 0 to mc.Count - 1 do  begin
      //ShowMessage(inttostr(mc.Count));
      m:=mc[i] as Match;
      sm:=m.SubMatches as SubMatches;
      r:=trim(VarToStr(sm[0]));
      Result:=r;
      end;

  finally
    m:=nil;
    sm:=nil;
    mc:=nil;
    Reg.Free;
  end;
end;

procedure TNewThread.Sync;
begin

      Form1.GoodLabel.Caption:=IntToStr(StrToInt(Form1.GoodLabel.Caption)+1);
      Form1.Gauge1.Progress:=Form1.Gauge1.Progress+1;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Accounts.Free;
 CS.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Accounts:=Tstringlist.create;
 CS:=TcriticalSection.create;
end;

end.
Ответить с цитированием
  #2  
Старый 15.12.2010, 20:02
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

ну так после авторизации запоминай глобально securitytoken и куки и используй их в потоках для постинга.
__________________
Пишу программы за еду.
__________________
Ответить с цитированием
  #3  
Старый 15.12.2010, 20:08
MrDiG MrDiG вне форума
Начинающий
 
Регистрация: 05.10.2010
Сообщения: 112
Репутация: 1227
По умолчанию

Я в каждом потоке сначала создаю HTTP потом освобождаю. Если не буду освобождать то ведь будет ошибка? А если буду - то ничего не останется.
Ответить с цитированием
  #4  
Старый 15.12.2010, 21:59
Аватар для Bargest
Bargest Bargest вне форума
Профессионал
 
Регистрация: 19.10.2010
Адрес: Москва
Сообщения: 2,390
Версия Delphi: XE3/VS12/FASM
Репутация: 14665
По умолчанию

Создай один раз глобально и не освобождай
__________________
jmp $ ; Happy End!
The Cake Is A Lie.
Ответить с цитированием
  #5  
Старый 16.12.2010, 00:03
MrDiG MrDiG вне форума
Начинающий
 
Регистрация: 05.10.2010
Сообщения: 112
Репутация: 1227
По умолчанию

Хм. Попробую. Только что-то туплю. Ну не буду я его освобождать... И получиться что в моём HTTP одновременно два десятка разных действий возможно? Или его создавать в private класса? Совсем запутался...
Ответить с цитированием
  #6  
Старый 16.12.2010, 10:04
Аватар для NumLock
NumLock NumLock вне форума
Let Me Show You
 
Регистрация: 30.04.2010
Адрес: Северодвинск
Сообщения: 5,426
Версия Delphi: 7, XE5
Репутация: 59586
По умолчанию

когда-то я так это дело писал. отправляет сообщения в чат форума (не этого!!!). при нажатии на кнопку с начала логинимся (можно тожа в потоке ), потом создаем потоки TPostThread для каждого сообщения из мемы1. в мему2 добавляются отправленые сообщения для контроля.
Код:
unit Unit1;

interface

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

type
  TPostThread = class(TThread)
  private
    FMsg: String;
    FSleep: Cardinal;
    procedure Updt;
  protected
    procedure Execute; override;
  public
    constructor Create(AMsg: String; ASleep: Cardinal);
  end;

  TForm1 = class(TForm)
    EditUser: TEdit;
    EditPass: TEdit;
    IdHTTP: TIdHTTP;
    Button1: TButton;
    IdCookieManager: TIdCookieManager;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  
  FSecuritytoken: String = '';
  FCookie: String = '';

implementation

{$R *.dfm}

function StringToHex(s: String): String;
var
  i: Integer;
begin
  Result:='';
  for i:=1 to Length(s) do Result:=Result+'%'+IntToHex(Ord(s[i]), 2);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  stringstream: TStringStream;
  s: String;
  i: Integer;
begin
  stringstream:=TStringStream.Create('vb_login_username='+StringToHex(EditUser.Text)+'&vb_login_password='+StringToHex(EditPass.Text)+'&cookieuser=1&s=&securitytoken=guest&do=login&vb_login_md5password=&vb_login_md5password_utf=');
  try
    IdHTTP.Request.ContentType:='application/x-www-form-urlencoded';
    IdHTTP.Request.ContentLength:=stringstream.Size;
    IdHTTP.Post('http://forum.ru/login.php?do=login', stringstream);
    IdHTTP.Request.ContentType:='';
    IdHTTP.Request.ContentLength:=-1;
    s:=IdHTTP.Get('http://forum.ru/index.php');
    i:=Pos('<input type="hidden" name="securitytoken" value="', s);
    if i>0 then
    begin
      s:=Copy(s, i+49, Length(s));
      s:=Copy(s, 1, Pos('"', s)-1);
      if (s<>'') and (s<>'guest') then
      begin
        FSecuritytoken:=s;
        FCookie:='';
        for i:=0 to IdCookieManager.CookieCollection.Count-1 do
          FCookie:=FCookie+IdCookieManager.CookieCollection.Items[i].CookieName+'='+IdCookieManager.CookieCollection.Items[i].Value+'; ';
        FCookie:=Trim(FCookie);
        for i:=0 to Memo1.Lines.Count-1 do TPostThread.Create(Memo1.Lines[i], i*5000);
      end;
    end;
  finally
    stringstream.Free;
  end;
end;

{ TPostThread }

constructor TPostThread.Create(AMsg: String; ASleep: Cardinal);
begin
  inherited Create(True);
  FreeOnTerminate:=True;
  FMsg:=AMsg;
  FSleep:=ASleep;
  Resume;
end;

procedure TPostThread.Execute;
var
  IdHTTP: TIdHTTP;
  stringstream: TStringStream;
begin
  Sleep(FSleep);
  try
    IdHTTP:=TIdHTTP.Create(nil);
    IdHTTP.Request.CustomHeaders.Text:='Cookie: '+FCookie;
    IdHTTP.HandleRedirects:=True;
    IdHTTP.Request.ContentType:='application/x-www-form-urlencoded';
    IdHTTP.Request.ContentLength:=stringstream.Size;
    stringstream:=TStringStream.Create('do=shout&message='+StringToHex(FMsg)+'&securitytoken='+FSecuritytoken);
    try
      IdHTTP.Post('http://forum.ru/infernoshout.php', stringstream);
    finally
      stringstream.Free;
      IdHTTP.Free;
    end;
  except
  end;
  Synchronize(Updt);
end;

procedure TPostThread.Updt;
begin
  Form1.Memo2.Lines.Add(FMsg);
end;

end.
http://data.cod.ru/80218
__________________
Пишу программы за еду.
__________________

Последний раз редактировалось NumLock, 16.12.2010 в 10:06.
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Комбинированный вид Комбинированный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 05:28.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025