Как отправить HTTP-запрос POST в Delphi XE6 с помощью WinInet api
Я нашел этот скрипт
Как отправить HTTP-запрос POST в Delphi с помощью WinInet api
но в Delphi Xe6 работает неправильно
Мой код XE6
procedure TForm2.WebPostData(const UserAgent: WideString; const Server: string; const Resource: WideString; const Data: WideString);
var
hInet: HINTERNET;
hHTTP: HINTERNET;
hReq: HINTERNET;
pRequest: HINTERNET;
Buffer: array[0..1023] of AnsiChar;
i, BufferLen: cardinal;
Res: string;
Heade : TStringStream;
BufStream : TMemoryStream;
aBuffer : Array[0..4096] of Char;
BytesRead : Cardinal;
resu : AnsiString;
const
// post: packed array[0..4] of LPWSTR = (PWideChar('POST'), nil);
accept: packed array[0..1] of LPWSTR = (PChar('*/*'), nil);
// header: string = 'Content-Type: application/x-www-form-urlencoded;charset=utf-8';
header: string = 'Content-Type: application/x-www-form-urlencoded';
begin
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
hHTTP := InternetConnect(hInet, PChar(Server), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
try
hReq := HttpOpenRequest(hHTTP, PWideChar('POST'), PWideChar(Resource), nil, nil, @accept, 0, 1);
// hReq := HttpOpenRequest(hHTTP, @post, PWideChar(Resource), nil, nil, @accept, 0, 1);
{
pRequest := hReq;
if Assigned(pRequest) then
try
Heade := TStringStream.Create('');
try
with Heade do
begin
WriteString('Host: ' + 'www.site.com' + sLineBreak);
WriteString('User-Agent: Custom program 1.0'+SLineBreak);
WriteString('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+SLineBreak);
WriteString('Accept-Language: en-us,en;q=0.5' + SLineBreak);
WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'+SLineBreak);
WriteString('Keep-Alive: 300'+ SLineBreak);
WriteString('Connection: keep-alive'+ SlineBreak+SLineBreak);
end;
HttpAddRequestHeaders(pRequest, PChar(Heade.DataString), Length(Heade.DataString), HTTP_ADDREQ_FLAG_ADD);
if HTTPSendRequest(pRequest, nil, 0, Pointer(Data), Length(Data)) then
begin
BufStream := TMemoryStream.Create;
try
while InternetReadFile(pRequest, @aBuffer, SizeOf(aBuffer), BytesRead) do
begin
if (BytesRead = 0) then Break;
BufStream.Write(aBuffer, BytesRead);
end;
aBuffer[0] := #0;
BufStream.Write(aBuffer, 1);
Resu := PChar(BufStream.Memory);
ShowMessage(Resu);
finally
BufStream.Free;
end;
end;
finally
Heade.Free;
end;
finally
InternetCloseHandle(pRequest);
end;
}
try
// if not HttpSendRequest(hReq, System.PWideChar(header), Length(System.PWideChar(header)), PWideChar(Data), length(Data)) then begin
if not HTTPSendRequest(hReq, nil, 0, Pointer(Data), Length(Data)) then begin
ShowMessage('HttpOpenRequest failed. ' + SysErrorMessage(GetLastError));
end else begin
repeat
InternetReadFile(hReq, @Buffer, SizeOf(Buffer), BufferLen);
if BufferLen = SizeOf(Buffer) then
Res := Res + AnsiString(Buffer)
else if BufferLen > 0 then
for i := 0 to BufferLen - 1 do
Res := Res + Buffer[i];
until BufferLen = 0;
ShowMessage(Res);
end;
finally
InternetCloseHandle(hReq);
end;
finally
InternetCloseHandle(hHTTP);
end;
finally
InternetCloseHandle(hInet);
end;
end;
мой php код
echo 'metodo ' . $_SERVER['REQUEST_METHOD'];
$post = file_get_contents('php://input');
print_r($post);
print_r($_GET['value']);
print_r($_POST['value']);
print_r($_REQUEST['value']);
?>
bye
но php скажи мне, что метод GET
На самом деле я не могу прочитать переменную $ _POST
Решение
У вас есть ошибки в вашем коде. В частности, вы смешиваете типы строк и передаете свои Data параметр как есть в исходном формате UTF-16, который сервер не ожидает, так как вы не отправляете charset=utf-16 значение в запросе Content-Type заголовок. Вы должны обеспечить Data в правильном формате, прежде чем вы можете отправить его.
Попробуйте что-то более похожее на это:
procedure TForm2.WebPostFormData(const UserAgent: String; const Server: string; const Resource: String; const Data: TStrings);
var
FormData: TStringList;
PostData: UTF8String;
I: Integer;
BufStream: TMemoryStream;
Resu: AnsiString;
begin
FormData := TStringList.Create;
try
FormData.NameValueSeparator := '=';
FormData.LineBreak := '&';
for I := 0 to Data.Count-1 do
begin
// TODO: URL-encode the name and value...
FormData.Add(Data.Names[I] + '=' + Data.ValueFromIndex[I]);
end;
PostData := UTF8String(FormData.Text);
finally
FormData.Free;
end;
BufStream := TMemoryStream.Create;
try
WebPostData(UserAgent, Server, Resource, PAnsiChar(PostData), Length(PostData), 'application/x-www-form-urlencoded; charset="utf-8"', BufStream);
SetString(Resu, PAnsiChar(BufStream.Memory), BufStream.Size);
finally
BufStream.Free;
end;
ShowMessage(String(Resu));
end;
procedure TForm2.WebPostData(const UserAgent: String; const Server: string; const Resource: String; const Data: Pointer; DataSize: UInt32; const ContentType: String; Response: TStream);
var
hInet: HINTERNET;
hHTTP: HINTERNET;
hReq: HINTERNET;
Heade: String;
Buffer: array[0..1023] of Byte;
BytesRead: DWORD;
const
accept: packed array[0..1] of PChar = (PChar('*/*'), nil);
begin
hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if hInet = 0 then RaiseLastOSError;
try
hHTTP := InternetConnect(hInet, PChar(Server), INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
if hHTTP = 0 then RaiseLastOSError;
try
hReq := HttpOpenRequest(hHTTP, PChar('POST'), PChar(Resource), nil, nil, @accept, INTERNET_FLAG_KEEP_CONNECTION, 1);
if hReq = 0 then RaiseLastOSError;
try
Heade := 'User-Agent: ' + UserAgent + #13#10 +
'Accept-Language: en-us,en;q=0.5'#13#10 +
'Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'#13#10 +
'Content-Type: ' + ContentType + #13#10 +
'Keep-Alive: 300'#13#10;
if not HttpAddRequestHeaders(hReq, PChar(Heade), Length(Heade), HTTP_ADDREQ_FLAG_ADD) then RaiseLastOSError;
if not HTTPSendRequest(hReq, nil, 0, Data, DataSize) then RaiseLastOSError;
repeat
if not InternetReadFile(hReq, @Buffer, SizeOf(Buffer), BytesRead) then RaiseLastOSError;
if (BytesRead = 0) then Break;
if Response <> nil then
Response.WriteBuffer(Buffer, BytesRead);
until False;
finally
InternetCloseHandle(hReq);
end;
finally
InternetCloseHandle(hHTTP);
end;
finally
InternetCloseHandle(hInet);
end;
end;
В качестве альтернативы рассмотрите возможность перехода на Indy’s TIdHTTP компонент и пусть он сделает всю работу за вас:
uses
..., IdGlobal, IdHTTP;
procedure TForm2.WebPostFormData(const UserAgent: String; const Server: string; const Resource: String; const Data: TStrings);
var
HTTP: TIdHTTP;
Resu: String;
begin
HTTP := TIdHTTP.Create(nil);
try
HTTP.Request.Accept := '*/*';
HTTP.Request.UserAgent := UserAgent;
HTTP.Request.AcceptLanguage := 'en-us,en;q=0.5';
HTTP.Request.AcceptCharset := 'ISO-8859-1,utf-8;q=0.7,*;q=0.7';
HTTP.Request.ContentType := 'application/x-www-form-urlencoded';
HTTP.Request.Charset := 'utf-8';
HTTP.Request.Connection := 'keep-alive';
HTTP.Request.CustomHeaders.Values['Keep-Alive'] := '300';
Resu := HTTP.Post('http://' + Server + Resource, Data);
finally
HTTP.Free;
end;
ShowMessage(Resu);
end;
procedure TForm2.WebPostData(const UserAgent: String; const Server: string; const Resource: String; const Data: Pointer; DataSize: UInt32; const ContentType: String; Response: TStream);
var
HTTP: TIdHTTP;
DataStrm: TIdMemoryBufferStream;
begin
HTTP := TIdHTTP.Create(nil);
try
HTTP.Request.Accept := '*/*';
HTTP.Request.UserAgent := UserAgent;
HTTP.Request.AcceptLanguage := 'en-us,en;q=0.5';
HTTP.Request.AcceptCharset := 'ISO-8859-1,utf-8;q=0.7,*;q=0.7';
HTTP.Request.ContentType := ContentType;
HTTP.Request.Connection := 'keep-alive';
HTTP.Request.CustomHeaders.Values['Keep-Alive'] := '300';
DataStrm := TIdMemoryBufferStream.Create(Data, DataSize);
try
HTTP.Post('http://' + Server + Resource, DataStrm, Response);
finally
DataStrm.Free;
end;
finally
HTTP.Free;
end;
end;
Другие решения
Других решений пока нет …