claro, en negrita lo que he añadido
Código Delphi
[-]function THTTPReqResp.Send(const ASrc: TStream): Integer;
const
ContentTypeFormat: array[Boolean] of string = (ContentTypeTemplate, ContentTypeWithActionFmt);
INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
var
Request: HINTERNET;
RetVal, Flags: DWord;
ActionHeader: string;
ContentHeader: string;
BuffSize, Len: Integer;
INBuffer: INTERNET_BUFFERS;
Buffer: TMemoryStream;
WinInetResult: BOOL;
{$IFDEF UNICODE}
DatStr: TBytesStream;
{$ELSE}
DatStr: TStringStream;
{$ENDIF}
UseSendRequestEx: Boolean;
begin
Connect(True);
Flags := INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_NO_CACHE_WRITE;
if FURLScheme = INTERNET_SCHEME_HTTPS then
begin
Flags := Flags or INTERNET_FLAG_SECURE;
if (soIgnoreInvalidCerts in InvokeOptions) then
Flags := Flags or (INTERNET_FLAG_IGNORE_CERT_CN_INVALID or
INTERNET_FLAG_IGNORE_CERT_DATE_INVALID or
SECURITY_FLAG_IGNORE_UNKNOWN_CA or
SECURITY_FLAG_IGNORE_REVOCATION);
end;
Request := nil;
try
Request := HttpOpenRequest(FInetConnect, 'POST', PChar(FURLSite), nil,
nil, nil, Flags, 0);
Check(not Assigned(Request));
if FConnectTimeout > 0 then
Check(not InternetSetOption(Request, INTERNET_OPTION_CONNECT_TIMEOUT, Pointer(@FConnectTimeout), SizeOf(FConnectTimeout)));
if FSendTimeout > 0 then
Check(not InternetSetOption(Request, INTERNET_OPTION_SEND_TIMEOUT, Pointer(@FSendTimeout), SizeOf(FSendTimeout)));
if FReceiveTimeout > 0 then
Check(not InternetSetOption(Request, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(@FReceiveTimeout), SizeOf(FReceiveTimeout)));
if (soIgnoreInvalidCerts in InvokeOptions) then
InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), Sizeof(Flags));
if FBindingType = btMIME then
begin
ContentHeader := Format(ContentHeaderMIME, [FMimeBoundary]);
ContentHeader := Format(ContentTypeTemplate, [ContentHeader]);
HttpAddRequestHeaders(Request, PChar(MIMEVersion), Length(MIMEVersion), HTTP_ADDREQ_FLAG_ADD);
end
else
ContentHeader := Format(ContentTypeTemplate, [GetContentType]);
if (FBindingType = btMIME) or
(not (soNoSOAPActionHeader in FInvokeOptions) and not (wnoSOAP12 in GetWebNodeOptions)) then
begin
ActionHeader := GetSOAPActionHeader;
HttpAddRequestHeaders(Request, PChar(ActionHeader), Length(ActionHeader), HTTP_ADDREQ_FLAG_ADD);
end;
HttpAddRequestHeaders(Request, PChar(ContentHeader), Length(ContentHeader), HTTP_ADDREQ_FLAG_ADD);
if Assigned(FOnBeforePost) then
FOnBeforePost(Self, Request);
ASrc.Position := 0;
BuffSize := ASrc.Size;
if BuffSize > FMaxSinglePostSize then
begin
UseSendRequestEx := True;
Buffer := TMemoryStream.Create;
try
Buffer.SetSize(FMaxSinglePostSize);
INBuffer.dwStructSize := SizeOf(INBuffer);
INBuffer.Next := nil;
INBuffer.lpcszHeader := nil;
INBuffer.dwHeadersLength := 0;
INBuffer.dwHeadersTotal := 0;
INBuffer.lpvBuffer := nil;
INBuffer.dwBufferLength := 0;
INBuffer.dwBufferTotal := BuffSize;
INBuffer.dwOffsetLow := 0;
INBuffer.dwOffsetHigh := 0;
while UseSendRequestEx do
begin
ASrc.Position := 0;
UseSendRequestEx := False;
InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT, SOAP_PTR_CERTIFICADO, SizeOf(CERT_CONTEXT) );
Check(not HttpSendRequestEx(Request, @INBuffer, nil,
0, 0));
try
while True do
begin
Len := BuffSize - ASrc.Position;
if Len > FMaxSinglePostSize then
Len := FMaxSinglePostSize;
if Len = 0 then
break;
Len := ASrc.Read(Buffer.Memory^, Len);
if Len = 0 then
raise ESOAPHTTPException.Create(SInvalidHTTPRequest);
RetVal := ERROR_SUCCESS;
if not InternetWriteFile(Request, @Buffer.Memory^, Len, RetVal) then
RetVal := HandleWinInetError(GetLastError, Request);
case RetVal of
ERROR_SUCCESS:;
ERROR_CANCELLED: SysUtils.Abort;
ERROR_INTERNET_FORCE_RETRY: ;
end;
if Assigned(FOnPostingData) then
FOnPostingData(ASrc.Position, BuffSize);
end;
finally
RetVal := ERROR_SUCCESS;
if not HttpEndRequest(Request, nil, 0, 0) then
RetVal := HandleWinInetError(GetLastError, Request);
case RetVal of
ERROR_SUCCESS: ;
ERROR_CANCELLED: SysUtils.Abort;
ERROR_INTERNET_FORCE_RETRY:
UseSendRequestEx := True;
end;
end;
end;
finally
Buffer.Free;
end;
end else
begin
{$IFDEF UNICODE}
DatStr := TBytesStream.Create;
{$ELSE}
DatStr := TStringStream.Create('');
{$ENDIF}
try
DatStr.CopyFrom(ASrc, 0);
while True do
begin
if Assigned(FOnPostingData) then
FOnPostingData(DatStr.Size, BuffSize);
RetVal := ERROR_SUCCESS;
{$IFDEF UNICODE}
WinInetResult := HttpSendRequest(Request, nil, 0,
DatStr.Bytes, DatStr.Size);
{$ELSE}
WinInetResult := HttpSendRequest(Request, nil, 0,
@DatStr.DataString[1],
Length(DatStr.DataString));
{$ENDIF}
if not WinInetResult then
RetVal := HandleWinInetError(GetLastError, Request);
case RetVal of
ERROR_SUCCESS: break;
ERROR_CANCELLED: SysUtils.Abort;
ERROR_INTERNET_FORCE_RETRY: ;
end;
end;
finally
DatStr.Free;
end;
end;
except
if (Request <> nil) then
InternetCloseHandle(Request);
Connect(False);
raise;
end;
Result := Integer(Request);
end;