Коллеги, добрый день!
Возникло неприятное исключение, нет не какого описания и не ошибка доступа к памяти.
Просто
raise и всё тут
Код выполняется в той хронологии, в которой я изложил суть вопроса
MKNextPage - это обработчик события.
procedure TMainForm.MKNextPage(Sender: TObject; ACountPages,
ACurrentPage: Integer);
begin
success(Format('%d из %d', [ACurrentPage, ACountPages]));
end;
procedure TMainForm.success(msg: string);
var
js: string;
begin
try
CoInitialize(nil);
js := Format('this.success("%s")', [msg]);
MainForm.WbLog.EvaluateJavaScript(js);
finally
CoUninitialize;
end;
end;
WbLog - это браузер (FMX)
Код, где генерируется это исключение.
spoilerprocedure TDelegatedOleControl.CreateControl;
var
Stream: IStream;
CS: IOleClientSite;
X: Integer;
begin
FOleControl := nil;
if FOleControl = nil then
try
try // work around ATL bug
X := FOleObject.GetClientSite(CS);
except
X := -1;
end;
if (X <> 0) or (CS = nil) then
OleCheck(FOleObject.SetClientSite(Self));
if (FObjectData = 0) and Assigned(FPersistStream) then
OleCheck(FPersistStream.InitNew)
else
begin
OleCheck(CreateStreamOnHGlobal(FObjectData, False, Stream));
OleCheck(FPersistStream.Load(Stream));
DestroyStorage;
end;
OleCheck(FOleObject.QueryInterface(IOleControl, FOleControl));
FControlInfo.cb := SizeOf(FControlInfo);
FOleControl.GetControlInfo(FControlInfo);
OleCheck(FOleObject.QueryInterface(IDispatch, FControlDispatch));
InterfaceConnect(FOleObject, IPropertyNotifySink, Self, FPropConnection);
InterfaceConnect(FOleObject, FControlData^.EventIID, FEventDispatch, FEventsConnection);
{
if FControlData^.Flags then
OnChanged(DISPID_BACKCOLOR);
if FControlData^.Flags and cfEnabled <> 0 then
OnChanged(DISPID_ENABLED);
if FControlData^.Flags and cfFont <> 0 then
OnChanged(DISPID_FONT);
if FControlData^.Flags and cfForeColor <> 0 then
OnChanged(DISPID_FORECOLOR);
}
FOleControl.OnAmbientPropertyChange(DISPID_UNKNOWN);
RequestNewObjectLayout;
except
DestroyControl;
raise;
end;
end;
Небольшая поправочка, событие генерирую из асинхронной функции класса THttpClient!
Вот отсюда ноги растут
procedure TMKSearch.ASyncResult(const ASyncResult: IAsyncResult);
var
Ss: TStringStream;
begin
try
Ss := TStringStream.Create('', TEncoding.UTF8);
Ss.LoadFromStream(THTTPClient.EndAsyncHTTP(ASyncResult).ContentStream);
Ss.SaveToFile('debug.html');
FCount := GetCount(Ss.DataString);
if FCount < 0 then exit;
FCountPages := Math.Ceil( FCount / 25 );
if Assigned(FOnNextPage) then
FOnNextPage(Self, FCountPages, FCurrentPage);;
if FCurrentPage >= FCountPages then
begin
if Assigned(FOnSearchComplete) then
FOnSearchComplete(Self);
Exit;
end;
Parsing(Ss.DataString);
Inc(FCurrentPage);
Query(Fq, FCurrentPage);
finally
Ss.Free;
end;
end;
Embarcadero® Delphi 10.3 Version 26.0.33219.4899 
Простой
Средний
