Delphi массовая отправка сообщений в VK

Хотел написать небольшого спам бота,вводим диапазон ID,и по нему будут рассылаться сообщения,например:
начальный ID 1 , а конечный 10: в этом интервале от 1 до 10 будут рассылаться сообщения.

Как я понял,то без доп потока здесь не обойтись,т.к без него программа намертво виснет.Но с потоком вообще ничего не происходит.Или я его не правильно сделал,или не знаю...

Это исходник с кнопкой(при нажатии должна начаться рассылка)

Это исходник с самим потоком

 

А где куки?

 

На форме,в которой происходит авторизация,лежит компонент IdcookieManager.
Сообщение отправляется,но без потока всё виснет,а с потоком вообще не хочет работать.

 

IdAntiFreeze

 

Кинул,прога не виснет,но и ничего не отравляется...Ничего не происходит.

 

Ну сначала нужно залогиниться в Vk под свой учеткой, а затем рассылать сообщения. Но в коде твоего потока этого нету.

 

А толку? Вк лимит сообщений 20 , нужно много аккаунтов.

 

Ты такой наивный, думаешь, что просто так без авторизации можно отправить сообщение?

 

Да вы что?А то я не знал что нужно залогиниться!Авторизация есть.
Тема всё еще актуальна.

 

Выложи сорцы в теме в теге code, а то качать не хочется, да и на работе linux, в делфи всё равно не залезть, только так же в gedit-е читать.

 

Там качать ничего не надо,а просто ссылку открыть)
Вот:

PHP:

unit Unit3;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
     
    type
      TForm3 = class(TForm)
        Button1: TButton;
        GroupBox2: TGroupBox;
        IDNumber: TEdit;
        toIDNumber: TEdit;
        Label1: TLabel;
        Label2: TLabel;
        GroupBox1: TGroupBox;
        Memo1: TMemo;
        procedure Button1Click(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;
     
    var
      Form3: TForm3;
     
    implementation
     
    uses Unit1,Unit4;
     
    {$R *.dfm}
    function UrlEncode(const s: AnsiString): string;
    var
      I: integer;
    begin
      Result := '';
      for i := 1 to Length(S) do
        case S[i] of
          '%', ' ', '&', '=', '@', '.', #13, #10, #128..#255: Result := Result + '%'
            + IntToHex(Ord(S[i]), 2);
        else
          Result := Result + S[i];
        end;
    end;
     
    procedure TForm3.Button1Click(Sender: TObject);
    var
      NewThread: TNewThread;
    begin
      NewThread:=TNewThread.Create(true);
      NewThread.FreeOnTerminate:=true;
      NewThread.Priority:=tpLower;
      NewThread.Resume;
    end;
     
     
    end.


Теперь сам поток

PHP:


unit Unit4;
     
    interface
     
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ExtCtrls;
     
    type
      TNewThread = class(TThread)
      private
        { Private declarations }
      protected
        procedure Execute; override;
      end;
     
     
    implementation
     
    uses Unit1,Unit3;
     
     
     function UrlEncode(const s: AnsiString): string;
    var
      I: integer;
    begin
      Result := '';
      for i := 1 to Length(S) do
        case S[i] of
          '%', ' ', '&', '=', '@', '.', #13, #10, #128..#255: Result := Result + '%'
            + IntToHex(Ord(S[i]), 2);
        else
          Result := Result + S[i];
        end;
    end;
     
     
    procedure TNewThread.Execute;
    var
    Memo1:TMemo;
    IDNumber,toIDNumber:Tedit;
    s,hash,ConnectToGroup:string;
    LengthID,IDNumber1,toIDNumber1:integer;
      begin
        //IDNumber1:=StrToInt(IDNumber.Text);//начальное ID юзера
        //toIDNumber1:=StrToInt(toIDNumber.Text);//конечное ID юзера
         form1.Memo1.Clear;
       while IDNumber1 <= toIDNumber1 do
        begin
        IDNumber1:=StrToInt(IDNumber.Text);//начальное ID юзера
        toIDNumber1:=StrToInt(toIDNumber.Text);//конечное ID юзера
        LengthID:=Length(IDNumber.Text);//длина ID - необходим,чтобы спрасить hash
        S:=form1.IdHTTP1.get('http://vk.com/im?sel='+IntToStr(IDNumber1) );
        hash:=Copy(S, Pos('IM.deleteDialog('+IntToStr(IDNumber1), S)+16+LengthID+3, 18);//получаем hash
         if Pos('Отправить',S)<>0 then
        begin
         form1.IdHTTP1.get('http://vk.com/im?sel='+IntToStr(IDNumber1)+'&act=a_send&al=1&hash='+hash+'&media=&msg='+UrlEncode(ansitoutf8(Memo1.Text))+'&title=&to='+IntToStr(IDNumber1));
         form1.Memo1.Lines.Add('Сообщение отправленно юзеру'+IntToStr(IDNumber1));
         IDNumber1:=IDNumber1+1;
        end
         else
         begin
          form1.Memo1.Lines.Add('Ошбика!Сообщение не отправленно юзеру'+IntToStr(IDNumber1));
         IDNumber1:=IDNumber1+1;
     
         end;
     
        end;
      try
      form1.IdHTTP1.Disconnect;
    except
    end;
    end;
     
     
    end.








 

я нашел ошибку в твоем коде!

Code:

Ошбика!Сообщение не отправленно юзеру

исправь

Code:

Ошибка! Сообщение не отправлено юзеру

вот в чем борода!!11

 

Хватит уже троллить((

 

убери поток наxуй, оформи все нормально в виде процедур.

 

Не помогло...что я не так сделал?Поток убрал,когда жму на кнопку запуска спама,то ничего не происходит.

PHP:

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze;

type
  TForm3 = class(TForm)
    Button1: TButton;
    GroupBox2: TGroupBox;
    IDNumber: TEdit;
    toIDNumber: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    IdAntiFreeze1: TIdAntiFreeze;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form3: TForm3;
s,hash,ConnectToGroup:string;
LengthID,IDNumber1,toIDNumber1:integer;
Memo1: TMemo;
IDNumber,toIDNumber: TEdit;

implementation

uses Unit1;

{$R *.dfm}
function UrlEncode(const s: AnsiString): string;
var
  I: integer;
begin
  Result := '';
  for i := 1 to Length(S) do
    case S[i] of
      '%', ' ', '&', '=', '@', '.', #13, #10, #128..#255: Result := Result + '%'
        + IntToHex(Ord(S[i]), 2);
    else
      Result := Result + S[i];
    end;
end;
procedure send;
begin
form1.IdHTTP1.get('http://vk.com/im?sel='+IntToStr(IDNumber1)+'&act=a_send&al=1&hash='+hash+'&media=&msg='+UrlEncode(ansitoutf8(Memo1.Text))+'&title=&to='+IntToStr(IDNumber1));
form1.Memo1.Lines.Add('Сообщение отправленно юзеру'+IntToStr(IDNumber1));
IDNumber1:=IDNumber1+1;
 sleep(5000);
end;

procedure get_hash;
begin
LengthID:=Length(IDNumber.Text);//длина ID - необходим,чтобы спрасить hash
S:=form1.IdHTTP1.get('http://vk.com/im?sel='+IntToStr(IDNumber1) );
hash:=Copy(S, Pos('IM.deleteDialog('+IntToStr(IDNumber1), S)+16+LengthID+3, 18);
 end;

procedure send_Err;
begin
form1.Memo1.Lines.Add('Ошбика!Сообщение не отправленно юзеру'+IntToStr(IDNumber1));
IDNumber1:=IDNumber1+1;
sleep(5000);
end;

procedure TForm3.Button1Click(Sender: TObject);
begin
     IDNumber1:=StrToInt(IDNumber.Text);//начальное ID юзера
    toIDNumber1:=StrToInt(toIDNumber.Text);//конечное ID юзера
     form1.Memo1.Clear;
   while IDNumber1 <= toIDNumber1 do
    get_hash;
     if Pos('Отправить',S)<>0 then send
     else
      send_Err;

  try
  form1.IdHTTP1.Disconnect;
except
end;
end;







 

Amd64, иди учи циклы:

Code:

	while IDNumber1 <= toIDNumber1 do get_hash;
	if Pos('Отправить',S)<>0 then send else send_Err;

 

А что там с циклом не так?

 

Code:

procedure TForm3.Button1Click(Sender: TObject);
begin
	....
	// вызываем в цикле процу get_hash n раз
	while IDNumber1 <= toIDNumber1 do get_hash;
	
	// после цикла ищем "Отправить" в переменной S
	if Pos('Отправить', S)<>0 then 
		// и если находим делаем send
		send else send_Err;
	...
end; 

 

Ну блин приведи хоть кусок кода, где она происходит, а то сколько смотрю не могу найти.

 

Так у меня же тоже самое было,почти...Сделал как ты показал-ничего не изменилось.

Авторизация.Находится на форме unit1.

PHP:

procedure TForm1.AuthAllClick(Sender: TObject);
var
 PageProfile:string;
 begin
   if login.Text='' then messagebox(0,'Введите ваш E-mail','Vk_Infromer',MB_OK or MB_ICONINFORMATION)
   else
      if pass.Text='' then messagebox(0,'Введите пароль!','Vk_Infromer',MB_OK or MB_ICONINFORMATION)
      else
 begin
  TidCookieManager.Create(IdHTTP1);
   IdHTTP1.Request.Host:='http://vk.com';
   IdHTTP1.Request.UserAgent:='Mozila/5.0 (Windows; U; Windows NT 5.1; com; rv:1.9.0.10) Gecko/2009042316 Firefox/3.0.10';
   IdHTTP1.Request.Accept:='text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
   IdHTTP1.Request.AcceptLanguage:='ru,en-us;q=0.7,en;q=0.3';
   IdHTTP1.Request.AcceptCharSet:='windows-1251,utf-8;q=0.7,*;q=0.7';
   IdHTTP1.AllowCookies:=true;
   IdHTTP1.HandleRedirects:=true;
try
  PageProfile:=IdHTTP1.get('http://vkontakte.ru/login.php?email='+login.Text+'&pass='+pass.Text);
except
end;
 if Pos('logout', PageProfile)<>0 then
     begin
      messagebox(0,'Авторизация прошла успешно!','Vk_Spamer',MB_OK or MB_ICONINFORMATION);
     end
 else
   begin
    messagebox(0,'Авторизация не удалась!Попробуйте снова.','Vk_Spamer|Ошибка!',MB_OK or MB_ICONERROR);
   end;
 end;
   end;






Все Unit я подключил между собой.