Форум программистов [Powered by Invision Power Board]

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, IWVCLBaseControl, IWBaseControl, IWBaseHTMLControl, IWControl,
  IWTreeview, OleCtrls, SHDocVw, IdCookieManager;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    IdHTTP1: TIdHTTP;
    WebBrowser1: TWebBrowser;
    IdCookieManager1: TIdCookieManager;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
WebBrowser1.Navigate('http://forum.trktvs.ru/index.php?t=index&') ;
memo1.lines.savetofile('c:\test.html');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('http://forum.trktvs.ru/index.php?t=index&') ;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
S: TStringList;
begin
S:= TStringList.Create;
S.Add('login=eViper');
S.Add('password=xxx');
S.Add('SQ=0');
S.Add('adm=');
memo1.Text:=IdHTTP1.Post('http://forum.trktvs.ru/index.php?t=login&', S);
memo1.lines.savetofile('c:\test.html');
end;

end.

Код


uses
   Registry;

 function GetDirectory: string;
 var
   reg : TRegistry;
 begin
   reg := TRegistry.Create;
   try
     reg.RootKey := HKEY_LOCAL_MACHINE;
     reg.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Internet Settings\Cache\Special Paths\Cookies',
       False);
     Result := reg.ReadString('Directory');
   finally
     reg.Free;
   end;
 end;


 procedure TForm1.Button1Click(Sender : TObject);
 var
   s : string;
 begin
   S := GetDirectory;
   ShowMessage(GetDirectory);
 end;

Код


procedure TForm1.IdCookieManager1NewCookie(ASender: TObject;
  ACookie: TIdCookieRFC2109; var VAccept: Boolean);
begin

end;

Код


procedure Auth;
var RequestHeader: TStringList;
var ResponseHeader: TStringList;
var Location: string;
var S: string;
var TCP: TIdTCPClient;
var Cookies: TstringList;
var Browser: TstringList
var Login,Domain,Nick,Password,Room: string;
begin

Login:=Edit3.Text;
Domain:=ComboBox1.Text;
Nick:=Edit4.Text;
Password:=Edit5.Text;
Room:=Edit6.Text;

TCP:=TIdTCPClient.Create(nil);
RequestHeader:=TStringList.Create;
ResponseHeader:=TStringList.Create;
Cookies:=TStringList.Create;
Browser:=TStringList.Create;

TCP.Port:=80;

Cookies.Clear;

Browser.Clear;
Browser.Append('User-Agent=Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 5.5; en) Opera 12.50');
Browser.Append('Cookie2=$Version=1');

// Первый запрос на сервер

ResponseHeader.Clear;
RequestHeader.Clear;
RequestHeader.AddStrings(Browser);
RequestHeader.Append('Content-Type=application/x-www-form-urlencoded');
RequestHeader.Append('Host=my.chat.mail.ru');
RequestHeader.Append('Referer=http://chat.mail.ru/');
S:='page=http%3A%2F%2Fchat.mail.ru%2F&FailPage=http%3A%2F%2Fchat.mail.ru%2Fdata-xml%2Ferlogin.html &enter=1812&mra=&mra_status=&Login='+Login+'&Domain='+Domain+'&Password='+ Password+'&nick='+Nick+'&nickcolor=0&textcolor=0&roomleft=&room='+Room+'&';
RequestHeader.Append('Content-Length='+IntTostr(Length(S)));
RequestHeader.AddStrings(Cookies);

TCP.Host:='my.chat.mail.ru';
TCP.Connect;
TCP.WriteLn('POST /cgi-bin/auth HTTP/1.0');
TCP.WriteHeader(RequestHeader);
TCP.WriteLn(S);

TCP.ReadStrings(TStrings(ResponseHeader));

// Проверка куков и идентификация на сервере.

RequestHeader.Clear;
RequestHeader.AddStrings(Browser);
RequestHeader.Append('Referer=http://my.chat.mail.ru/cgi-bin/auth');
RequestHeader.Append('Content-Type=text/html');

ExtractHeader(ResponseHeader,Cookies,Location);
ResponseHeader.Clear;
RequestHeader.AddStrings(Cookies);

TCP.Connect;
TCP.WriteLn('GET '+Location+' HTTP/1.0');
TCP.WriteHeader(RequestHeader);

TCP.ReadStrings(TStrings(ResponseHeader));

Cookies.Append('Cookie=Login='+Login+'; Domain='+Domain+'; nick='+Nick+'; nickcolor=0; textcolor=0; room='+Room+'; silent=0; signore=0');

RequestHeader.Clear;
RequestHeader.AddStrings(Browser);
RequestHeader.Append('Referer='+Location);
RequestHeader.Append('Content-Type=text/html');
ExtractHeader(ResponseHeader,Cookies,Location);
ResponseHeader.Clear;
RequestHeader.Append(InlineCookie(Cookies));

TCP.Connect;
TCP.WriteLn('GET '+Location+' HTTP/1.0');
TCP.WriteHeader(RequestHeader);
TCP.ReadStrings(TStrings(ResponseHeader));

S:=ResponseHeader.Text;
Delete(S,1,pos('<h2>',S)+3);
Delete(S,pos('</h2>',S),length(S));

if (S <> '') then ;// Обработчик ошибок
RequestHeader.Free;
ResponseHeader.Free;
Cookies.Free;
Browser.Free;
TCP.Free;
end;

procedure ExtractHeader(Header: TStringList; var Cookies: TStringList; var Location: string);
var I: integer;
var S: string;
begin
Location:='';
I:=0;
while (Header[I] <> '') do
begin
S:=Header[I];
if (pos('Set-Cookie:',S) = 1) then
begin
Delete(S,1,12);
Delete(S,pos(';',S),length(S));
if (Length( copy(S,pos('=',S)+1,length(S))) > 0) then
Cookies.Append('Cookie='+S);
end;
if (pos('Location:',S) = 1) then
begin
Delete(S,1,10);
Location:=S;
end;
inc(I);
end;

end;
function InlineCookie(Cookies: TStringList): string;
var I: integer;
var S: string;
begin
Result:='Cookie=';
for I:=0 to Cookies.Count-1 do
begin
S:=Cookies[I];
Delete(S,1,7);
Result:=Result+S+'; ';
end;
end;

Код


procedure TwebDispatcher.WebAction(Sender: TObject; Request: TWebRequest; 
  Response: TWebResponse; var Handled: Boolean);
begin
  with (Response.Cookies.Add) do
  begin
    name := 'TESTNAME';
    Value := 'TESTVALUE';
    Secure := False;
    Expires := Now;
    Response.Cookies.WebResponse.SendResponse;
  end;
end;

Код


procedure TForm1.WebDispatcher1WebActionItem1Action(Sender: TObject;
  Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
begin
with (Response.Cookies.Add) do
  begin
    name := 'TESTNAME';
    Value := 'TESTVALUE';
    Secure := False;
    Expires := Now;
    Response.Cookies.WebResponse.SendResponse;
  end;
end;