| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

TKOLWebBrowser и OnBeforeNavigate2 [Delphi, Windows]

Artlav ©   (2008-04-07 16:37:00) 

Вопрос такой - как использовать событие OnBeforeNavigate2 в TKOLWebBrowser?
Конкретно, мне надо в нём прочитать адрес, сгенерировать новый и перенаправить.

Как бы я ни пытался сделать, всегда вылетает либо ошибка

---------------------------
Debugger Exception Notification
---------------------------
Project gcv.exe raised exception class EVariantBadVarTypeError with message 'Invalid variant type'. Process stopped. Use Step or Run to continue.
---------------------------
OK   Help  
---------------------------

Либо какая-то предсказуемая системная бяка.
Использую Delphi 7.

Вот буквально вся программа:
program gcv;
uses strval,activex,strutils,sysutils,variants,Windows,Messages,ShellAPI,KOL,KOLWebBr owser,KOLSHDocVw;

{$R gcv.res}
{$R site.res}

const GOOGLE_CACHE=' http://www.google.fr/search?q=%20cache:';

var
HTML:TKOLWebBrowser;
panelbtn,btngo,btnbck,btnfwd,btnref,plflb,pfnceb:pcontrol;

{
function oleGetStr(var value: oleVariant): string;
var
 index,
 lowVal,
 highVal : integer;
 oleArray: PSafeArray;
 oleObj : oleVariant;
begin
 result := '';

 try
   case VarType(value) of
   varEmpty,
   varNull: result := '';
   varSmallint,
   varInteger,
   varByte,
   varError: result := IntToStr(value);
   varSingle,
   varDouble,
   varCurrency: result := FloatToStr(value);
   varDate: result := DateTimeToStr(value);
   varOleStr,
   varStrArg,
   varString: result := value;
   varBoolean:
      if value then
         result := 'True'
      else result := 'False';
   varDispatch, // do not remove IDispatch!
   varVariant,
   varUnknown,
   varTypeMask:
   begin
     VarAsType(value, varOleStr);
     result := value;
   end;
   else
     if VarIsArray(value) then
     begin
       //VarArrayLock(value);
       index := VarArrayDimCount(value);
       lowVal := VarArrayLowBound(value, index);
       highVal := VarArrayHighBound(value, index);
       oleArray := TVariantArg(value).pArray;

       for index := lowVal to highVal do
       begin
         SafeArrayGetElement(oleArray, index, oleObj);
         result := result + oleGetStr(oleObj) + #13#10;
       end;

       //VarArrayUnlock(value);
       Delete(result, length(result) - 1, 2);
     end
     else
       result := ''; //varAny, varByRef
   end;
 except
   // do nothing, just capture
 end;
end;
}

function hexic(s:string):string;
var i:integer;
begin
result:='';
for i:=1 to length(s) do result:=result+'%'+strhex2(ord(s[i]));
end;

function doaction(s:string):string;
begin
result:=GOOGLE_CACHE+hexic(s);
end;
         
procedure bnav(Sender:pobj;const pDisp:IDispatch;var url,Flags,TargetFrameName,PostData,Headers:OleVariant;var Cancel:WordBool);
begin
//Ни один вариант не работает
applet.Caption:=url; //Тут вылетает
//applet.Caption:=pchar(dword(@url)+8)^;
//applet.Caption:=oleGetStr(url);
if (not ansicontainsstr(URL,'%20cache:'))and(not ansicontainsstr(URL,'/stpg'))then HTML.Navigate(doaction(URL));
end;  

procedure btngoClick(Sender:PObj);begin try if pfnceb.Text<>'' then HTML.Navigate(doaction(pfnceb.Text)); except end;end;
procedure btnbckClick(Sender:PObj);begin try HTML.GoBack;HTML.GoBack; except end;end;
procedure btnfwdClick(Sender:PObj);begin try HTML.GoForward; except end;end;
procedure btnrefClick(Sender:PObj);begin try HTML.Refresh; except end;end;
procedure resize(Sender:PObj);begin pfnceb.SetSize(Applet.Width-240,18);end;

procedure setall;
begin
Applet:=NewForm(Nil,'Google cache viewer').SetSize(800,600);
Applet.CenterOnParent;
Applet.CanResize:=true;
applet.WindowState:=wsMaximized;
applet.OnResize:=TOnEvent(MakeMethod(nil,@resize));
applet.Border:=0;
           
HTML:=NewKOLWebBrowser(Applet);
HTML.SetAlign(caClient);
HTML.Offline:=false;
HTML.Silent:=true;
HTML.RegisterAsBrowser:=true;
HTML.RegisterAsDropTarget:=false;
HTML.OnBeforeNavigate2:=TWebBrowserBeforeNavigate2(MakeMethod(HTML,@bnav));

panelbtn:=NewPanel(Applet,esRaised).SetAlign(caTop).SetSize(0,24).SetPosition(1, 1);
btnbck:=NewButton(panelbtn,'<<<').SetPosition(1,1).SetSize(30,17);btnbck.Font.Fo ntHeight:=8;
btnfwd:=NewButton(panelbtn,'>>>').SetPosition(31,1).SetSize(30,17);btnfwd.Font.F ontHeight:=8;
btnref:=NewButton(panelbtn,'Refresh').SetPosition(61,1).SetSize(60,17);btnref.Fo nt.FontHeight:=8;        
btngo :=NewButton(panelbtn,'Go To').SetPosition(121,1).SetSize(50,17);btngo.Font.FontHeight:=8;
btngo .OnClick:=TOnEvent(MakeMethod(nil,@btngoClick));
btnbck.OnClick:=TOnEvent(MakeMethod(nil,@btnbckClick));
btnfwd.OnClick:=TOnEvent(MakeMethod(nil,@btnfwdClick));
btnref.OnClick:=TOnEvent(MakeMethod(nil,@btnrefClick));

plflb:=NewLabel(panelbtn,'Address: ').SetPosition(175,2).SetSize(40,18);plflb.Font.FontHeight:=8;
 
pfnceb:=NewEditbox(panelbtn,[]).SetPosition(220,0).SetSize(Applet.Width-240,18);pfnceb.Font.FontHeight:=8;
pfnceb.Color:=clgreen;pfnceb.font.Color:=RGB(0,255,0);

HTML.Navigate('res://'+paramstr(0)+'/HTML/stpg');

Run(Applet);
end;

begin
setall;
end.

---

gregory   (2009-07-25 23:10:00) [1]

CrqR9k jnT3bz8Qpgj62BaK3ldfTm

---

Artlav   (2008-04-07 19:48:00) [2]

> http://kolmck.net/r_faq.htm#how_to_assign_a_regular

Странно, поменял заголовок на
procedure bnav(Dummy_Self:PObj;Sender:pobj;const pDisp:IDispatch;var url,Flags,TargetFrameName,PostData,Headers:OleVariant;var Cancel:WordBool);

И всё работает...
Мне казалось, что Sender:pobj; и был тот первый скрытый параметер.

Спасибо.

---

Дмитрий К   (2008-04-07 17:50:00) [3]

http://kolmck.net/r_faq.htm#how_to_assign_a_regular

---

Наверх