{
Simple HTTP POST.
Простой пример, показывающий использования метода POST.
©oded by BuH@LicH at sysman.ru 2007
}

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Winsock, StdCtrls;   // не забудьте добавить Winsock

type
  TMyThread = class(TThread)    // поток из которого будем вызывать POST запрос
  private
    { Private declarations }
  protected
    procedure Execute; override;
  public
    Host, URI, Login, Password : String;
  end;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Edit2: TEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  wsData: TWSAData;

implementation

{$R *.dfm}
function Resolve(host: string):string;// Функция преобразования HOST --> IP
var
IP:string;
hostEnt : PHostEnt;
hostName : array [0..255] of char;
addr : PChar;
begin
  result:=host;
  try
    strpcopy(hostname, host);
    hostEnt := gethostbyname(hostName);
    if Assigned(hostEnt) and Assigned(hostEnt^.h_addr_list) then
      begin
        addr:=hostEnt^.h_addr_list^;
        IP:=Format('%d.%d.%d.%d', [byte(addr[0]), byte(addr[1]), byte(addr[2]), byte(addr[3])]);
      end;
    result:=ip;
  except
  end;
end;

function SendString(Socket: TSocket; Str: string):boolean;// Отправка данных
var
Buffer: Array [1..1024] of Byte; {буфер для отправки данных}
i: Integer;
begin
FillChar(Buffer,SizeOf(Buffer),0); {заполняем буфер нулями}
if Length(Str)>1000 then Exit;     {если длинна посылаемых данных больше 1000, выходим}
for i:=1 to Length(Str) do Buffer[i]:=Ord(Str[i]); {заполняем буфер}
{
function Send(S:TSocket;var Buf;Len,Flags:Integer):Integer;
Параметры:
S: задаёт сокет, который используется для передачи данных.
Buf: задаёт буфер, в котором хранятся данные для отправки.
Len: размер этих данных в байтах.
Flags задаёт дополнительные опции, в большинстве случаев равен 0.
}
i:=WinSock.send(Socket, buffer, sizeof(buffer), 0);
if i>0 then result:=true;
end;

function ReadString(Socket: TSocket): string;// Чтение данных из сокета
var
Buffer: Array [1..100] of Byte;  {буфер для приёма данных}
i,RecB: Integer;
BufStr: String;  {строка в которую сохраняется принятый буфер}
begin
BufStr := '';
{
function Recv(S:TSocket;var Buf;Len,Flags:Integer):Integer;
Параметры:
S: задаёт сокет, из входного буфера которого будут извлекаться данные.
Buf: буфер, в который эти данные будут копироваться.
Len: размер этого буфера.
Flags задаёт дополнительные опции, в большинстве случаев равен 0.
}
RecB:=Recv(Socket, Buffer, SizeOf(Buffer), 0);
for i:=1 to RecB do
BufStr := BufStr + Chr(buffer[i]);
try
Result := BufStr;
except
Result := '';
end;
end;

procedure TMyThread.Execute;
var
  I: integer;
  Sock: TSocket;
  Request: string;
  Answer: string;
  _Host: string;
  adr: sockaddr_in;  {sockaddr - это общее представление адреса для сокетов. Для семейства AF_INET используется структура sockaddr_in.}
  Data: string;
const
  CRLF=#13#10;
begin
_host               :=resolve(host);
{заполнение структуры sockaddr_in}
adr.sin_addr.s_addr :=inet_addr(pchar(_host));   // ip адрес
adr.sin_family      :=AF_INET;                   // семейство протоколов
adr.sin_port        :=htons(80);                 // порт
{
Function Socket(AF,SocketType,Protocol:Integer):TSocket;
Параметры:
AF задаёт семейство адресов (address family). Этот параметр определяет, какой способ адресации (т.е., по сути дела, какой стек протоколов) будет использоваться для данного сокета. При использовании TCP/IP этот параметр должен быть равен AF_Inet, для других стеков также есть соответствующие константы, которые можно посмотреть в файле WinSock.pas.
SocketType указывает на тип сокета и может принимать одно из двух значений: Sock_Stream (сокет используется для потоковых протоколов) и Sock_Dgram (сокет используется для дейтаграммных протоколов).
Protocol позволяет указать, какой именно протокол будет использоваться сокетом. Этот параметр можно оставить равным нулю - тогда будет выбран протокол по умолчанию, отвечающий заданным первыми двумя параметрами.
}
Sock:=Socket(AF_INET, SOCK_STREAM, 0);
if Sock =-1 then Exit;
if Connect(sock,adr,sizeof(adr))<>0 then
  begin
    CloseSocket(Sock);
    exit;
  end;
{Заполняем строку данных, которую мы будем посылать в запросе}
Data:='referer=&t=&f=&st=&UserName='+Login+'&PassWord='+Password+'&CookieDate=1';
{
Обратите внимание, что каждая строка заканчивается на CRLF - символ возврата каретки и перехода на новую строку.
}
Request:= 'POST '+URI+' HTTP/1.1'+CRLF+
          'Host: '+Host+CRLF+
          'User-Agent: Mozilla/5.0 (Windows; U; Windows NT 5.1; ru; rv:1.8.1.2)'+CRLF+
          'Accept: */*'+CRLF+
          'Accept-Language: ru-ru,ru;q=0.8,en-us;q=0.5,en;q=0.3'+CRLF+
          'Accept-Encoding: gzip,deflate'+CRLF+
          'Accept-Charset: windows-1251,utf-8;q=0.7,*;q=0.7'+CRLF+
          'Content-Length: '+IntToStr(Length(Data))+CRLF+
          'Content-Type: application/x-www-form-urlencoded'+CRLF+
          'Connection: Close'+CRLF+CRLF+
          Data;
SendString(Sock, Request);
{Считываем в переменную Answer ответ сервера}
for i:=0 to 5 do Answer:=Answer + ReadString(Sock);
IF Pos('302 Found', Answer) > 0 Then Form1.Label1.Caption := 'Good!'
Else Form1.Label1.Caption := 'Bad :(';
CloseSocket(Sock);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
{Функция WSACleanup завершает работу с библиотекой сокетов.
Не имеет параметров и возвращает ноль в случае удачного выполнения}
WSACleanup;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
{
function WSAStartup(wVersionRequired:Word;var WSData:TWSAData): Integer;
Функция для инициализации библиотеки сокетов. Её необходимо вызвать до использования любой другой функции этой библиотеки.

Параметры:
wVersionRequired задаёт требуемую версию библиотеки сокетов. Допустимы версии 1.0 ($0001), 1.1 ($0101), 2.0 ($0002) и 2.2 ($0202).
WSData является выходным параметром, т.е. значение, которое имела переменная до вызова функции, игнорируется,
а имеет смысл только то значение, которая эта переменная получит после вызова функции. Через этот параметр передаётся
дополнительная информация о библиотеке сокетов. В большинстве случаев эта информация не представляет никакого интереса,
поэтому её можно игнорировать.

В случае удачного завершения функция возвращает 0}
WSAStartup($101,wsData);
{Возможно, в других исходниках вы встретите такое написание: wsaStartup(MAKEWORD(1,1), wsData);}
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  host, URI, login, password: string;
  MyThread : TMyThread;
begin
Label1.Caption:='';
Login := Edit1.Text;
Password := Edit2.Text;
Host := 'sysman.ru';
URI := '/index.php?act=Login&CODE=01';
{Создаём поток с параметрами Host, URI, Login, Password.}
MyThread := TMyThread.Create(True);
MyThread.Host := Host;
MyThread.URI := URI;
MyThread.Login := Login;
MyThread.Password := Password;
MyThread.Resume;
End;


end.