我找到了这个脚本 How to send a HTTP POST Request in Delphi using 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
答案 0 :(得分：1)
您的代码中存在一些错误。最值得注意的是，您正在混合字符串类型，并且您正在以原始的UTF-16格式发送Data参数，服务器不期望这样，因为您没有发送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的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;