在delphi上使用WININET上传文件

Posted 2023-02-16

【中文标题】在delphi上使用WININET上传文件

【英文标题】：Uploading a file with WININET on delphi

【发布时间】：2015-11-03 14:53:49

【问题描述】：

我有一个 delphi wininet 应用程序。

上周我尝试发送信息以执行 JSON 方法，这周我尝试将文件上传到 Web 服务器。我正在使用相同的代码并进行了一些修改，但在 InternetWriteFile 过程执行的那一刻，程序引发了一个异常：“Controlador no válido”。

代码在这里：

    function TFormMain.CargarArchivo(Archivo, Server: string; Username, Password: PChar; blnSSL, iftoken: Boolean): Boolean;
    var
       Url, Header : String;
       pSession, pConnection, pRequest : HINTERNET;
       flags, dwSize, dwFlags : DWORD;
       dwError, Port : Integer;
       Escritos    : Cardinal;
    begin
       Result := false;
       pSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
       if not Assigned(pSession) then
          raise Exception.Create('InternetOpen failed. ' + WinInetErrorMsg(GetLastError));
       try
          Url := Copy(Server,pos('/Servidor',Server),length(Server));
          if blnSSL then
          begin
             Server := Copy(Server,9,pos('/Servidor',Server)-1);
             Port := INTERNET_DEFAULT_HTTPS_PORT
          end
          else
          begin
             Server := Copy(Server,8,pos('/Servidor',Server)-1);
             Server := Copy(Server,1,pos(':',Server)-1);
             Port := 8080;
          end;
          pConnection := InternetConnect(pSession, PChar(Server), port, Username, Password, INTERNET_SERVICE_HTTP, 0, 0);
          if not Assigned(pConnection) then
             raise Exception.Create('InternetConnect failed. ' + WinInetErrorMsg(GetLastError));
          try
             if blnSSL then
                flags := INTERNET_FLAG_SECURE
             else
                flags := 0;
             pRequest := HTTPOpenRequest(pConnection, 'POST', PChar(Url), nil, nil, nil, flags, 0);
             if not Assigned(pRequest) then
                raise Exception.Create('HttpOpenRequest failed. ' + WinInetErrorMsg(GetLastError));
             try
                // Set buffer size
                dwSize:=SizeOf(dwFlags);
                // Get the current flags
                if (InternetQueryOption(pRequest, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then
                begin
                   // Add desired flags
                   dwFlags:=dwFlags or SECURITY_FLAG_IGNORE_UNKNOWN_CA or SECURITY_FLAG_IGNORE_CERT_CN_INVALID or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID;
                   // Set new flags
                   if not(InternetSetOption(pRequest, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags, dwSize)) then
                   begin
                      // Get error code
                      dwError:=GetLastError;
                      // Failure
                      MessageBox(Application.Handle, PChar(IntToStr(dwError)), PChar(Application.Title), MB_OK or MB_ICONINFORMATION);
                   end;
                end
                else
                begin
                   // Get error code
                   dwError:=GetLastError;
                   // Failure
                   MessageBox(Application.Handle, PChar(IntToStr(dwError)), PChar(Application.Title), MB_OK or MB_ICONINFORMATION);
                end;
                Header := 'Host: ' + Server + ':' + IntToStr(Port) + #13#10 +
                          'Content-Type: multipart/form-data; charset=UTF-8'#13#10;
                if iftoken then
                begin
                   Header := Header + 'auth_token: '+token+#13#10;
                   Header := Header + 'Csrf-token: no-check'#13#10;
                end;

                if not HttpAddRequestHeaders(pRequest, PChar(Header), Length(Header), HTTP_ADDREQ_FLAG_ADD) then
                   raise Exception.Create('HttpAddRequestHeaders failed. ' + WinInetErrorMsg(GetLastError));

                Parameters := TIdMultiPartFormDataStream.Create;
                Parameters.AddFile('archivo', Archivo, '');
                if not HTTPSendRequest(pRequest, nil, 0, Parameters, Parameters.Size) then
                   raise Exception.Create('HTTPSendRequest failed. ' + WinInetErrorMsg(GetLastError));

                try
                   if not InternetWriteFile(Parameters, Parameters, Parameters.Size, Escritos) then
                      raise Exception.Create('InternetWriteFile failed. ' + WinInetErrorMsg(GetLastError));
                   Result := true;
                finally
                   Parameters.Free;
                end;
             finally
                InternetCloseHandle(pRequest);
             end;
          finally
             InternetCloseHandle(pConnection);
          end;
       finally
          InternetCloseHandle(pSession);
       end;
    end;

我尝试使用 FTPOpenFile 过程初始化文件指针，但它不起作用，因为服务器是 HTTP，而不是 FTP，我猜。

【参考方案1】：

您不能以您尝试混合它们的方式混合 Indy 和 WinInet。

您正在尝试直接从内存中 POST 一个 Indy TIdMultipartFormDataStream 对象。那永远行不通。您必须告诉 TIdMultipartFormDataStream 从您的输入参数生成其 MIME 数据，然后改为发布该数据。 TIdHTTTP.Post() 为您处理，但您没有使用 TIdHTTP，因此您必须手动完成。在这种情况下，您必须将生成的 TIdMultipartFormDataStream 数据保存到单独的 TMemoryStream（使用 TStream.CopyFrom() 方法），然后您可以使用 WinInet 发布该数据。

即便如此，您的POST 仍然会崩溃，因为：

您没有在 Content-Type 请求标头中包含所需的 boundary 参数（TIdMultipartFormDataStream 动态生成该值），因此服务器可以正确解析 MIME 部分。

如果HTTPSendRequest() 和InternetWriteFile() 都尝试发送请求的正文数据，则不能将它们混合在一起。任选其一。

试试这样的：

PostData := TMemoryStream.Create;
try
  Parameters := TIdMultiPartFormDataStream.Create;
  try
    Parameters.AddFile('archivo', Archivo, '');
    PostData.CopyFrom(Parameters, 0);
    Header := 'Host: ' + Server + ':' + IntToStr(Port) + #13#10 +
              'Content-Type: ' + Parameters.RequestContentType + #13#10;
  finally
    Parameters.Free;
  end;    
  if iftoken then
  begin
    Header := Header + 'auth_token: '+token+#13#10;
    Header := Header + 'Csrf-token: no-check'#13#10;
  end;
  if not HttpAddRequestHeaders(pRequest, PChar(Header), Length(Header), HTTP_ADDREQ_FLAG_ADD) then
    raise Exception.Create('HttpAddRequestHeaders failed. ' + WinInetErrorMsg(GetLastError));
  if not HTTPSendRequest(pRequest, nil, 0, PostData.Memory, PostData.Size) then
    raise Exception.Create('HTTPSendRequest failed. ' + WinInetErrorMsg(GetLastError));
  Result := True;
finally
  PostData.Free;
end;

【讨论】：

再次感谢您的帮助。我真的是处理这个组件的新手，我习惯使用 INDY，因此我的组件组合。