Question

我找到了这个脚本 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

Answer 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;

如何使用WinInet api在Delphi XE6中发送HTTP POST请求

1 个答案: