PHP DM Gate v0.9 » TWebBroser перестал реагировать на нажатия на ссылки <span class="vd">[D7, Win2k]</span>

GreyWolf © (25.01.11 02:33) [0]

Доброго времени суток.

У меня на форме TWebBrowser, я загрузил туда из памяти HTML посредством IPersistStreamInit, и хочу теперь установить базовый адрес для страницы, если он не был явно установлен. Нашел код для этого, код создает элемент <BASE> внутри <HEAD>, если он не был создан ранее, и устанавливает адрес через атрибут href этого тега:

[pascal]

function ForceBaseReference(WebDoc: IHTMLDocument2; const URL: WideString): Boolean;
var
LDocument: IHTMLDocument3;
LCollection: IHtmlElementCollection;
BaseFound: Boolean;
BaseCreated: Boolean;
BaseElement: IHTMLBaseElement;
HeadFound: Boolean;
HeadElement: IHTMLElement;
ChildElement: IHTMLElement;
HeadNode: IHTMLDomNode;
ChildNode: IHTMLDomNode;
begin
// Initialize
Result := False;
BaseFound := False;
BaseCreated := False;
BaseElement := nil;
HeadElement := nil;
// Get the needed base interface
WebDoc.QueryInterface(IHTMLDocument3, LDocument);
if not Assigned(LDocument) then
begin
DebugLog('No "IHTMLDocument3" interface found!');
Exit;
end;
// Try to find a 'BASE' element
LCollection := LDocument.GetElementsByTagName('BASE');
if Assigned(LCollection) then
begin
BaseFound := LCollection.Length > 0;
if BaseFound then
begin
LCollection.Item(0, 0).QueryInterface(IHTMLBaseElement, BaseElement);
DebugLog('"BASE" element found');
Exit;
end;
end;
// Try to find the 'HEAD' Element
if not BaseFound then
begin
DebugLog('No "BASE" element found!');
LCollection := LDocument.GetElementsByTagName('HEAD');
if Assigned(LCollection) then
begin
HeadFound := LCollection.Length > 0;
if HeadFound then
begin
LCollection.Item(0, 0).QueryInterface(IHTMLElement, HeadElement);
if Assigned(HeadElement) then
begin
DebugLog('"HEAD" element found!');
// Create a "BASE" element
ChildElement := WebDoc.CreateElement('BASE');
HeadElement.QueryInterface(IHTMLDomNode, HeadNode);
ChildElement.QueryInterface(IHTMLDomNode, ChildNode);
ChildElement.QueryInterface(IHTMLBaseElement, BaseElement);
HeadNode.AppendChild(ChildNode);
BaseCreated := Assigned(BaseElement);
if BaseCreated then
DebugLog('"BASE" element created')
else
DebugLog('Unable to create "BASE" element');
end;
end else
DebugLog('No "HEAD" element found!');
end;
end;
if BaseCreated then
begin
BaseElement.HRef := URL;
BaseElement.target := '_self';
Result := True;
end;
end;

[/pascal]

В качестве URL пробовал передавать имя каталога с "\" как разделителем, "/" как разделителем, "file://localhost/имя_каталога_со_слэшем", "file:///имя_каталога_со_слэшем", "file://localhost/имя_каталога_с_Обратным_слэшем", "file:///имя_каталога_с_Обратным_слэшем".
В качестве BaseElement.target пробовал также _top, '', не присваивать этому свойству значения.
После выполнения процедуры, если кликнуть на контекстное меню ссылки (относительной, без полного URI c протоколом и доменом), в обработанном документе в TWebBrowser, то адрес показывается правильный, то есть процедура отрабатывает и очевидно устанавливает базовый адрес.

НО!!! при этом если кликнуть на эту ссылку, то _ничего не происходит_, даже не вызываются никакие события (OnBeforeNavigate2, OnNewWindow2, whatever).

Пробовал даже использовать сторонний компонент - улучшенную версию TWebBrowser, но с тем же результатом.

В чем может быть причина???

<Цитата>