[Delphi] Sunapse в потоках

Discussion in 'С/С++, C#, Rust, Swift, Go, Java, Perl, Ruby' started by kakeolala, 13 May 2011.

  1. kakeolala

    kakeolala Banned

    Joined:
    13 Jul 2010
    Messages:
    118
    Likes Received:
    2
    Reputations:
    0
    Собственно есть код один.
    Но он почему-то неработает - зависает форма и все(((
    Code:
    unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  HTTPSend, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TNewThread = class(TThread)
  private
    l:string;
    procedure addstr;
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  http:THTTPSend;
  a:integer;
  NewThread1,NewThread2,NewThread3: TNewThread;

implementation

{$R *.dfm}

function WeakPassword(len: integer): string;
var
  c: integer;
  ch: AnsiChar;
  key: array [0 .. 7] of longint;
  a, b: longint;
  x: int64;
 
  procedure morph();
  var
    r: longint;
  begin
    r := -1;
    repeat
      Inc(r);
      Inc(b, a + ((a shl 6) xor (a shr 8)) + (key[r mod 8] + r));
      Inc(r);
      Inc(a, b + ((b shl 6) xor (b shr 8)) + (key[r mod 8] + r));
    until r = 63;
  end;
 
  function RND(): byte;
  begin
    morph();
    Result := (a + b) mod $100;
  end;
 
  function RND32(idx: integer): longint;
  begin
    morph();
    case idx of
      0:
        Result := a;
      1:
        Result := b;
    end;
  end;
 
begin
  Result := '';
  for c := 0 to 7 do
    key[c] := random($FFFFFFFF);
  b := 0;
  a := GetTickCount;
  a := RND32(0);
  if QueryPerformanceCounter(x) then
    b := (x {shr 0}) and $FFFFFF
  else
    b := 0;
  b := RND32(1);
{for c := 0 to $FFFF do Morph();}
  c := 0;
  while c < len do
  begin
    ch := AnsiChar(RND());
    if ch in ['a' .. 'z'] then
    begin
      Result := Result + ch;
      Inc(c);
    end; {else morph();}
  end;
end;

function GetTargetURL(const aHeaders: TStringList): string;
var
  i: integer;
begin
  Result := '';
  if aHeaders = nil then
    Exit;
  for i := 0 to aHeaders.Count - 1 do
  begin
    if pos('location:', LowerCase(aHeaders[i])) > 0 then
    begin
      Result := copy(aHeaders[i], 11, length(aHeaders[i]) - pos('location:', LowerCase(aHeaders[i])));
      break;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 http:=THTTPSend.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 NewThread1:=TNewThread.Create(true);
 NewThread1.FreeOnTerminate:=true;
 NewThread1.Priority:=tpLower;
 NewThread1.Resume;
 NewThread2:=TNewThread.Create(true);
 NewThread2.FreeOnTerminate:=true;
 NewThread2.Priority:=tpLower;
 NewThread2.Resume;
end;

procedure TNewThread.addstr;
var ss:string;
begin
 a:=0;
 repeat
  form1.Label1.Caption:=l;
  ss:='add=Äîáàâèòü&url='+WeakPassword(7)+'.ru';
  HTTP.MimeType := 'application/x-www-form-urlencoded';
  http.Document.Write(Pointer(ss)^, length(ss));
  http.HTTPMethod('POST','http://ufa.urlik.com/add.php');
  form1.label1.Caption:=inttostr(strtoint(form1.label1.Caption)+1);
 until a=1;
end;

procedure TNewThread.execute;
begin
 synchronize(addstr);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 a:=1;
end;

end.
    Не подскажите в чем проблема тут ?
     
    #1 kakeolala, 13 May 2011
  2. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    Честно говоря ща спать хочу, но первое что бросилось в глаза: ты не пробовал экземпляр HTTPsend'а создавать и убивать в потоке?
    Upd: а ты его вообще убивать собираешься?
    Upd2: а как ты думаешь, если HTTP у тя 1, а его юзают 2 потока, это нормально?
    А эта часть кода нам зачем?)))
    Code:
    procedure TForm1.Button2Click(Sender: TObject);
begin
 a:=1;
end;
    ИТОГО:
    поробуй так:
    Code:
    procedure TNewThread.addstr;
var ss:string;
begin
  a:=0;
  Http:=THTTPSend.create;
  try
    repeat
      form1.Label1.Caption:=l;
      ss:='add=Aiaaaeou&url='+WeakPassword(7)+'.ru';
      HTTP.MimeType := 'application/x-www-form-urlencoded';
      http.Document.Write(Pointer(ss)^, length(ss));
      http.HTTPMethod('POST','http://ufa.urlik.com/add.php');
      form1.label1.Caption:=inttostr(strtoint(form1.labe  l1.Caption)+1);
    until a=1;
  finally
    HTtp.free;
  end;
end;
     
    #2 xophet, 13 May 2011
    Last edited: 13 May 2011
  3. kakeolala

    kakeolala Banned

    Joined:
    13 Jul 2010
    Messages:
    118
    Likes Received:
    2
    Reputations:
    0
    Спс - просто в тококах не шарю, прочитал чуток и вот сделал.
    Ну а
    Code:
    procedure TForm1.Button2Click(Sender: TObject);
begin
 a:=1;
end;
    осталось еще после того как я делал просто в цикле =)
     
    #3 kakeolala, 13 May 2011
  4. kakeolala

    kakeolala Banned

    Joined:
    13 Jul 2010
    Messages:
    118
    Likes Received:
    2
    Reputations:
    0
    а как тормазнуть все потоки ?
     
    #4 kakeolala, 13 May 2011
  5. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    Чтобы тормознуть все потоки нужно создать менеджер потоков - еще один поток, который будет следить за состоянием потоков и при необходимости передавать им всем какую-либо команду.
    Я лично использую обертку над стандартным классом TThread - TgsvThread, в ней есть класс TgsvThreadManager, который выполняет эту функцию.
    _______________________________________________
    и еще, если тебе будет интересно, вместо использования вот этого
    Code:
    form1.label1.Caption:=inttostr(strtoint(form1.labe   l1.Caption)+1);
    и Synchronize,
    используй PostMessage и SendMessage; (почитай в инете как это используется, если хочешь небольшой пример скину). И вообще в потоке постарайся избегать взаимодействия с визуальными компонентами.
     
    #5 xophet, 13 May 2011
    Last edited: 13 May 2011
  6. GhostOnline

    GhostOnline Active Member

    Joined:
    20 Dec 2008
    Messages:
    723
    Likes Received:
    110
    Reputations:
    22
    У тебя поток вообще не работает, addstr выполняется в GUI потоке.
    Через синхронайз вызывай только обращение к контролам на форме
    Когда Execute завершится тогдаи закроется поток.
    Обычно в Execute пишут как-то так:

    while not Terminated do
    SomeWork();

    собственно остановить извне так:

    NewThread1.Terminate();

    Вызов этого метода установит Terminated в True

    Незачем запускать еще один поток для этого.
    Достаточно хранить ссылки на потоки в массиве или списке, а потом итерироваться по ним с вызовом Terminate
     
    #6 GhostOnline, 13 May 2011
    Last edited: 13 May 2011
  7. kakeolala

    kakeolala Banned

    Joined:
    13 Jul 2010
    Messages:
    118
    Likes Received:
    2
    Reputations:
    0
    Вот код:
    Code:
    unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  HTTPSend, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

TNewThread = class(TThread)
  private
    procedure addstr;
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  http:THTTPSend;
  a:integer;
  NewThread1,NewThread2: TNewThread;

implementation

{$R *.dfm}

function WeakPassword(len: integer): string;
var
  c: integer;
  ch: AnsiChar;
  key: array [0 .. 7] of longint;
  a, b: longint;
  x: int64;
 
  procedure morph();
  var
    r: longint;
  begin
    r := -1;
    repeat
      Inc(r);
      Inc(b, a + ((a shl 6) xor (a shr 8)) + (key[r mod 8] + r));
      Inc(r);
      Inc(a, b + ((b shl 6) xor (b shr 8)) + (key[r mod 8] + r));
    until r = 63;
  end;
 
  function RND(): byte;
  begin
    morph();
    Result := (a + b) mod $100;
  end;
 
  function RND32(idx: integer): longint;
  begin
    morph();
    case idx of
      0:
        Result := a;
      1:
        Result := b;
    end;
  end;
 
begin
  Result := '';
  for c := 0 to 7 do
    key[c] := random($FFFFFFFF);
  b := 0;
  a := GetTickCount;
  a := RND32(0);
  if QueryPerformanceCounter(x) then
    b := (x {shr 0}) and $FFFFFF
  else
    b := 0;
  b := RND32(1);
{for c := 0 to $FFFF do Morph();}
  c := 0;
  while c < len do
  begin
    ch := AnsiChar(RND());
    if ch in ['a' .. 'z'] then
    begin
      Result := Result + ch;
      Inc(c);
    end; {else morph();}
  end;
end;

function GetTargetURL(const aHeaders: TStringList): string;
var
  i: integer;
begin
  Result := '';
  if aHeaders = nil then
    Exit;
  for i := 0 to aHeaders.Count - 1 do
  begin
    if pos('location:', LowerCase(aHeaders[i])) > 0 then
    begin
      Result := copy(aHeaders[i], 11, length(aHeaders[i]) - pos('location:', LowerCase(aHeaders[i])));
      break;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 http:=THTTPSend.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 NewThread1:=TNewThread.Create(true);
 NewThread1.FreeOnTerminate:=true;
 NewThread1.Priority:=tpLower;
 NewThread1.Resume;
 NewThread2:=TNewThread.Create(true);
 NewThread2.FreeOnTerminate:=true;
 NewThread2.Priority:=tpLower;
 NewThread2.Resume;
end;

procedure TNewThread.addstr;
var ss:string;
begin
 a:=0;
 repeat
  http:=THTTPSend.Create;
  ss:='add=Äîáàâèòü&url='+WeakPassword(7)+'.ru';
  HTTP.MimeType := 'application/x-www-form-urlencoded';
  http.Document.Write(Pointer(ss)^, length(ss));
  http.HTTPMethod('POST','http://ufa.urlik.com/add.php');
  form1.label1.Caption:=inttostr(strtoint(form1.label1.Caption)+1);
  http.Free;
 until a=1;
end;

procedure TNewThread.execute;
begin
 synchronize(addstr);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 a:=1;
end;

end.
    Тоесть мне надо в execute прописать сам код - убрать из функции addstr. И создать отдельную функцию где будет строка
    Code:
    form1.label1.Caption:=inttostr(strtoint(form1.label1.Caption)+1);
    ?
     
    #7 kakeolala, 13 May 2011
  8. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    На винграде есть классная статейка по поводу работы с потоками (мне она очень помогла):
    http://forum.vingrad.ru/index.php?showtopic=60076&view=findpost&p=480303
     
    #8 xophet, 13 May 2011
  9. xophet

    xophet Member

    Joined:
    16 Apr 2011
    Messages:
    617
    Likes Received:
    49
    Reputations:
    5
    Просто отдельной функцией - не обойтись, она должна выполнятся именно в контексте основного потока (читай статью из предыдущего поста)

    будет выглядеть примерно следующим образом:
    Code:
    unit1;
const
WM_LABEL_ADD = WM_APP+5446; //5446 - любое уникальное число
.......
type
  TForm1 = class(TForm)
  .........
  private
  procedure LAbelAdd(var Message: TMessage); message WM_LABEL_ADD;
  ............
implementation
procedure TForm1.LabelAdd(var Message: TMessage);
begin
  form1.label1.Caption:=inttostr(strtoint(form1.label1.Caption)+1);
end;
    а в потоке делаешь вместо своих Label'ov:
    Code:
    PostMessage(Form1.Handle, WM_LABEL_ADD, 0, 0);
    это простейший случай, а вообще разберись с этим.

    и вот, чтобы эту лажу не делать: inttostr(strtoint(form1.label1.Caption)+1);
    можно использовать свойство label.tag:
    Code:
    label.tag:=label.tag+1;
label.caption:=inttostr(label.tag);
    ______________________________________________
    Все, я поумничал, теперь можете закидывать меня камнями, а я спать :)
    ______________________________________________
    Я выспался, и я прогнал вчера: да, можно все записать в execute, а sunchronize вызывать только для ф-ии изменяющей значение label
     
    #9 xophet, 13 May 2011
    Last edited: 14 May 2011
(You must log in or sign up to post here.)
Language
English (US)
    ANTICHAT ™ © 2001-2027 Antichat Kft.