Я столкнулся с Дескриптор находится в неправильном состоянии для запрошенной операции выпуск в ноябре 2018 года с использованием Delphi Tokyo 10.2.3, затем посмотрел патч кода в ссылка на вставку под ответ Арьена .
Этот код очень старый и тестовый код больше не работает (служба SOAP недоступна). Кроме того, из кода Бруно неясно, что именно он исправил.
Сравнивая этот источник и источник из моей версии Delphi, кажется, что это (две) необходимые модификации процедуры HandleWinInetError ('PATCH HERE'):
function THTTPReqResp.HandleWinInetError(LastError: DWord;
Request: HINTERNET;
RaiseError: Boolean): DWord;
function CallInternetErrorDlg: DWord;
var
P: Pointer;
begin
Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
{ After selecting client certificate send request again,
Note: InternetErrorDlg always returns ERROR_SUCCESS when called with
ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED }
if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
Result := ERROR_INTERNET_FORCE_RETRY;
end;
const
{ Missing from our WinInet currently }
INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
var
Flags, FlagsLen, DWCert, DWCertLen: DWord;
ClientCertInfo: IClientCertInfo;
CertSerialNum: string;
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
hStore: HCERTSTORE;
CertContext: PCERT_CONTEXT;
{$ENDIF}
begin
{ Dispatch to custom handler, if there's one }
if Assigned(FOnWinInetError) then
Result := FOnWinInetError(LastError, Request)
else
begin
Result := ERROR_INTERNET_FORCE_RETRY;
{ Handle INVALID_CA discreetly }
if (LastError = ERROR_INTERNET_INVALID_CA) and (soIgnoreInvalidCerts in InvokeOptions) then
begin
FlagsLen := SizeOf(Flags);
InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), FlagsLen);
Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), FlagsLen);
end
else if (LastError = ERROR_INTERNET_SEC_CERT_REV_FAILED) and (soIgnoreInvalidCerts in InvokeOptions) then
begin
FlagsLen := SizeOf(Flags);
InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), FlagsLen);
Flags := Flags or SECURITY_FLAG_IGNORE_REVOCATION;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(@Flags), FlagsLen);
end
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and
Supports(Self, IClientCertInfo, ClientCertInfo) and
(ClientCertInfo.GetCertSerialNumber <> '') then
begin
CertSerialNum := ClientCertInfo.GetCertSerialNumber();
hStore := ClientCertInfo.GetCertStore();
if hStore = nil then
begin
hStore := CertOpenSystemStore(0, PChar('MY'));
ClientCertInfo.SetCertStore(hStore);
end;
CertContext := FindCertWithSerialNumber(hStore, CertSerialNum);
if CertContext <> nil then
begin
ClientCertInfo.SetCertContext(CertContext);
InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
CertContext, SizeOf(CERT_CONTEXT));
end
else
begin
if RaiseError then RaiseCheck(LastError); // PATCH HERE
Result := CallInternetErrorDlg;
end;
end
{$ENDIF}
else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and (soPickFirstClientCertificate in InvokeOptions) then
begin
{ This instructs WinInet to pick the first (a random?) client cerficate }
DWCertLen := SizeOf(DWCert);
DWCert := 0;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_SELECT_CLIENT_CERT,
Pointer(@DWCert), DWCertLen);
end
else
begin
if RaiseError then RaiseCheck(LastError); // PATCH HERE
Result := CallInternetErrorDlg;
end;
end;
end;
Обратите внимание, что параметр процедуры RaiseError даже не использовался до этого патча; -)
Вот некоторый тестовый код, использующий службу SOAP, из веб-службы SOAP Национальной базы цифровых прогнозов (NDFD) :
Uses SOAP.SOAPHTTPTrans;
const Request2 =
'<soapenv:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:ndf="http://graphical.weather.gov/xml/DWMLgen/wsdl/ndfdXML.wsdl">' +
' <soapenv:Header/>' +
' <soapenv:Body>' +
' <ndf:NDFDgenByDay soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +
' <latitude xsi:type="xsd:decimal">38.9936</latitude>' +
' <longitude xsi:type="xsd:decimal">-77.0224</longitude>' +
' <startDate xsi:type="xsd:date">%tomorrow%</startDate>' +
' <numDays xsi:type="xsd:integer">5</numDays>' +
' <Unit xsi:type="dwml:unitType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">e</Unit>' +
' <format xsi:type="dwml:formatType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">12 hourly</format>' +
' </ndf:NDFDgenByDay>' +
' </soapenv:Body>' +
'</soapenv:Envelope>';
const URL2= 'https://graphical.weather.gov:443/xml/SOAP_server/ndfdXMLserver.php';
procedure TFrmHandleWinINetError.Button1Click(Sender: TObject);
var
RR: THTTPReqResp;
Response: TMemoryStream;
U8: UTF8String;
begin
RR := THTTPReqResp.Create(nil);
try
try
RR.URL := URL2;
RR.UseUTF8InHeader := True;
RR.SoapAction := 'NDFDgenByDay';
Response := TMemoryStream.Create;
RR.Execute(Request2, Response);
SetLength(U8, Response.Size);
Response.Position := 0;
Response.Read(U8[1], Length(U8));
ShowMessage(String(U8));
except
on E:Exception do ShowMessage('ERROR CAUGHT: ' + e.message);
end;
finally
Response.Free;
RR.Free;
end;
end;
end;
Без ошибки исправления в конце URL-адреса отлавливаются, но ошибки в имени домена просто вызывают пустое сообщение об ошибке.
С патчем те тоже поймали.
Я сообщил о проблеме на портале качества RAD Studio под номером RSP-21862
Используйте на свой страх и риск и, пожалуйста, сообщайте о любых дополнительных выводах.
Добавление : проблема была исправлена в декабре 2018 года в Delphi 10.3 Rio, и проблема с порталом качества была закрыта со следующим замечанием:
В RAD Studio 10.3 реализация THTTPReqResp была изменена и заменена на THTTPClient. Таким образом, эта проблема больше не применяется.
Я не проверял это.