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

Код


unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Wininet, StdCtrls;
const
  HTTP_PORT = 80;
  CLRF = #13#10;
  Header = 'Content-Type: application/x-www-form-urlencoded' + CLRF;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;

    procedure Button1Click(Sender: TObject);
  end;
var
  Form1: TForm1;
implementation
{$R *.dfm}


function GetUrl(const URL: String): String;
var
  FSession, FConnect, FRequest: HINTERNET;
  FHost, FScript: String;
  Ansi: PAnsiChar;
  Buff: array [0..1023] of Char;
  BytesRead: Cardinal;
  szData:pchar;
begin
  szData:='age=asssssssssssssssssss dddddddddddddddddddd  ddddddddddddddd dddddddd ddddd';
  FHost:='****.ru';
  FScript:='rsc/script.php';

  FSession := InternetOpen('DMFR', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if not Assigned(FSession) then Exit;
  try

    FConnect := InternetConnect(FSession, PChar(FHost), HTTP_PORT, nil,'HTTP/1.0', INTERNET_SERVICE_HTTP, 0, 0);
    if not Assigned(FConnect) then Exit;
    try

      Ansi := 'text/*';
      FRequest := HttpOpenRequest(FConnect, 'POST', PChar(FScript), 'HTTP/1.0','', @Ansi, INTERNET_FLAG_RELOAD, 0);
     if not Assigned(FConnect) then Exit;
      try

        if not (HttpAddRequestHeaders(FRequest, Header, Length(Header),HTTP_ADDREQ_FLAG_REPLACE or HTTP_ADDREQ_FLAG_ADD)) then Exit;

        if not (HttpSendRequest(FRequest, 'Content-Type: application/x-www-form-urlencoded', 47, szData, lstrlen(szData))) then Exit;

        FillChar(Buff, SizeOf(Buff), 0);
        repeat
          Result := Result + Buff;
          FillChar(Buff, SizeOf(Buff), 0);
          InternetReadFile(FRequest, @Buff, SizeOf(Buff), BytesRead);
        until BytesRead = 0;
      finally
        InternetCloseHandle(FRequest);
      end;
    finally
      InternetCloseHandle(FConnect);
    end;
  finally
    InternetCloseHandle(FSession);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Memo1.Text := GetUrl('http://****.ru/rsc/script.php');
end;
end.

Код


var
  Ansi: PChar;

Код


unit Unit1;

interface

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

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

var
  Form1: TForm1;

implementation

{$R *.dfm}
uses wininet;

 procedure SendPOSTData(const szHost, szPath, szData: PWideChar);
var
szHeaders: PWideChar;
hOpenHandle,
hConnectHandle,
hResourceHandle: Pointer;
begin
hOpenHandle := InternetOpen(nil, 0, nil, nil, 0);
if hOpenHandle <> nil then
begin
hConnectHandle := InternetConnect(hOpenHandle, szHost,80,nil,nil,3,0,0);
if hConnectHandle <> nil then
begin
hResourceHandle := HttpOpenRequest(hConnectHandle,'POST',szPath,nil,nil,nil,INTERNET_FLAG_KEEP_CONNECTION,0);
if hResourceHandle <> nil then
begin
HttpSendRequest(hResourceHandle,'Content-Type: application/x-www-form-urlencoded',47,szData,lstrlen(szData));
end;
InternetCloseHandle(hResourceHandle);
end;
InternetCloseHandle(hConnectHandle);
end;
InternetCloseHandle(hOpenHandle);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   SendPOSTData('****.ru','rsc/script.php', 'age=Hello WORLD !!!!');
end;

end.

Код


 procedure SendPOSTData(const szHost, szPath, szData: WideString);
var
szHeaders: WideString;
hOpenHandle,
hConnectHandle,
hResourceHandle: Pointer;
begin
hOpenHandle := InternetOpen(nil, 0, nil, nil, 0);
if hOpenHandle <> nil then
begin
hConnectHandle := InternetConnect(hOpenHandle, PWideChar(szHost),80,nil,nil,3,0,0);
if hConnectHandle <> nil then
begin
hResourceHandle := HttpOpenRequest(hConnectHandle,'POST',PWideChar(szPath),nil,nil,nil,INTERNET_FLAG_KEEP_CONNECTION,0);
if hResourceHandle <> nil then
begin
HttpSendRequest(hResourceHandle,'Content-Type: application/x-www-form-urlencoded',47,PWideChar(szData),lstrlen(PWideChar(szData)));
end;
InternetCloseHandle(hResourceHandle);
end;
InternetCloseHandle(hConnectHandle);
end;
InternetCloseHandle(hOpenHandle);
end;

Код


procedure SendPOSTData(szHost, szPath, szData: WideString);
var
C_CLIENT, post, headers : WideString;
hOpenHandle,
hConnectHandle,
hResourceHandle: Pointer;
begin
post:='POST';
C_CLIENT :='checkurl' ;
headers:='Content-Type: application/x-www-form-urlencoded';

hOpenHandle := InternetOpenW(PWideChar(C_CLIENT), PRE_CONFIG_INTERNET_ACCESS, nil, nil, 0);
if hOpenHandle <> nil then
begin
hConnectHandle := InternetConnectW(hOpenHandle, PWideChar(szHost),80,nil,nil,3,0,0);
if hConnectHandle <> nil then
begin
hResourceHandle := HttpOpenRequestW(hConnectHandle,PWideChar(post),PWideChar(szPath),nil,nil,nil,INTERNET_FLAG_KEEP_CONNECTION,0);
if hResourceHandle <> nil then
begin
HttpSendRequestW(hResourceHandle,PWideChar(headers),47,PWideChar(szData),lstrlen(PWideChar(szData)));
end;
InternetCloseHandle(hResourceHandle);
end;
InternetCloseHandle(hConnectHandle);
end;
InternetCloseHandle(hOpenHandle);
end;