Авторизация На Форуме (xenforo) Через Delphi.отправляем Запросы В Чат

  • Автор темы Автор темы Lomanu4
  • Дата начала Дата начала

Lomanu4

Команда форума
Администратор
Ofline
Вы наверное видели это видео,как я показывал,метод отправки текста в чат на ///...///

Так вот я сделал видео урок как это делается на самом деле.

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

[HIDE=5]
Код:
type
  tchat = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  code, soob, token: string;
  chat:tchat;
[/HIDE]

Код:
procedure TForm1.Button1Click(Sender: TObject);
begin
  chat:=tchat.Create(False);
end;
сам код потока,описывать я его не буду так как в видео все ясно рассказано...
[HIDE=5]
Код:
procedure tchat.Execute;
var
  stream: TStringList;
  i: Integer;
begin
  try
    stream := TStringList.Create;
    Form1.IdHTTP1.Request.UserAgent :=
      'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Safari/537.36';
    stream.Add('login=petya');
    stream.Add('password=151515');
    stream.Add('register=0');
    stream.Add('redirect=/index.php');
    Stream.Add('__utmt=1; xf_session=e7d0298e75cc93ac74527c2b1a60dc9f; __utma=186748734.430978972.1430646818.1430646818.1430654271.2; __utmb=186748734.7.10.1430654271; __utmc=186748734; __utmz=186748734.1430646818.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)');
    Form1.IdHTTP1.HandleRedirects:=True;
    code:=Form1.IdHTTP1.Post('http://guardianelinks.de/index.php?login/login',stream);

    if Pos('"_xfToken"',code)<> 0then
      begin
        token:=Copy(code,pos('"_xfToken"',code),72);
        Delete(token,1,18);
        Form1.Memo1.Lines.Add('Авторизованы'+#13#10+token) ;
       // Form1.Memo1.Lines.Add(code)
      end else
      begin
        Form1.Memo1.Lines.Add('Не авторизированы');
      end;


  except
    on e:Exception do
    begin
      stream.Free;
      Exit
    end;
  end;

end;
[/HIDE]

Здесь кнопка на отправление в чат
Можно сделать так же через поток.
[HIDE=5]
Код:
procedure TForm1.Button2Click(Sender: TObject);
var
charr:TStringList;
begin
   try
  charr:=TStringList.Create;
  charr.Add('message='+edit1.Text);
  charr.Add('room=1');
  charr.Add('_xfToken='+token);
  IdHTTP1.Post('http://guardianelinks.de/index.php?taigachat/post.json',charr);
   finally
     charr.Free;
   end;
end;
[/HIDE]
Функция для показа загрузки в прогресс бар.
Код:
procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
ProgressBar1.Visible:=True;
ProgressBar1.Position:=AWorkCount;
end;

procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  ProgressBar1.Position:=0;
  ProgressBar1.Position:=AWorkCountMax;
end;


[HIDE=5]
Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ProgressBar1: TProgressBar;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    Edit1: TEdit;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  tchat = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

var
  Form1: TForm1;
  code, soob, token: string;
  chat:tchat;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  chat:=tchat.Create(False);
end;

{ tchat }

procedure tchat.Execute;
var
  stream: TStringList;
  i: Integer;
begin
  try
    stream := TStringList.Create;
    Form1.IdHTTP1.Request.UserAgent :=
      'Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/42.0.2311.135 Safari/537.36';
    stream.Add('login=petya');
    stream.Add('password=151515');
    stream.Add('register=0');
    stream.Add('redirect=/index.php');
    Stream.Add('__utmt=1; xf_session=e7d0298e75cc93ac74527c2b1a60dc9f; __utma=186748734.430978972.1430646818.1430646818.1430654271.2; __utmb=186748734.7.10.1430654271; __utmc=186748734; __utmz=186748734.1430646818.1.1.utmcsr=(direct)|utmccn=(direct)|utmcmd=(none)');
    Form1.IdHTTP1.HandleRedirects:=True;
    code:=Form1.IdHTTP1.Post('http://guardianelinks.de/index.php?login/login',stream);

    if Pos('"_xfToken"',code)<> 0then
      begin
        token:=Copy(code,pos('"_xfToken"',code),72);
        Delete(token,1,18);
        Form1.Memo1.Lines.Add('Авторизованы'+#13#10+token) ;
       // Form1.Memo1.Lines.Add(code)
      end else
      begin
        Form1.Memo1.Lines.Add('Не авторизированы');
      end;


  except
    on e:Exception do
    begin
      stream.Free;
      Exit
    end;
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
charr:TStringList;
begin
   try
  charr:=TStringList.Create;
  charr.Add('message='+edit1.Text);
  charr.Add('room=1');
  charr.Add('_xfToken='+token);
  IdHTTP1.Post('http://guardianelinks.de/index.php?taigachat/post.json',charr);
   finally
     charr.Free;
   end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
if ProgressBar1.Position=100 then
begin
  ProgressBar1.Visible:=false;
end;
end;

procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
ProgressBar1.Visible:=True;
ProgressBar1.Position:=AWorkCount;
end;

procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
  ProgressBar1.Position:=0;
  ProgressBar1.Position:=AWorkCountMax;
end;
[/HIDE]
 
Видео перелезаю,то не видно не черта.
 
Ссылка на Yandex Disc
chat.png
 
Кто знает как решить проблему со звуком при записи видео?
 
если https на форуме - запросы в принципе теже?
 
сообщения в теме пробовали через запросы слать?
 
Назад
Сверху Снизу