Конференция "KOL" » TKOLWebBrowser и OnBeforeNavigate2 [Delphi, Windows]
 
  • Artlav (07.04.08 16:37) [0]
    Вопрос такой - как использовать событие 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.

  • Дмитрий К © (07.04.08 17:50) [1]
  • Artlav (07.04.08 19:48) [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; и был тот первый скрытый параметер.

    Спасибо.
  • gregory (25.07.09 23:10) [3]
    CrqR9k jnT3bz8Qpgj62BaK3ldfTm
 
Конференция "KOL" » TKOLWebBrowser и OnBeforeNavigate2 [Delphi, Windows]
Есть новые Нет новых   [134465   +2][b:0][p:0.003]