webbrowser的一些资料

有人总问为什么在使用webbrowser.document.links.length时候会有错误91  
   
  这是因为你在webbrowser   还没有完整的下载页面，就使用的document   对象  
   
  会出现对象未设置错误91  
   
  解决办法就是   Private   Sub   Form_Load()  
   
  WebBrowser1.Navigate2   (url)   你先给个默认的地址   上来就naviage2   就可以了  
   
   
  End   Sub

 

 

 

 

有人问如何使用webbrowser   去navigate2   一个列表里面的所有urllist  
   
  因为他们经常的出现错误是只浏览最后一个list..是因为webbrowers没有足够的时间去挨个去浏览，解决如下：  
   
  Private   Sub   Go_Click()  
    Dim   URL_Index   As   Integer,   CurrentURL   As   String  
      For   URL_Index   =   0   To   List3.ListCount   -   1  
            CurrentURL   =   List3.List(URL_Index)  
            If   CurrentURL   <>   ""   Then  
                    WebBrowser1.Navigate2   CurrentURL,   4  
          While   Not   (WebBrowser1.ReadyState   =   READYSTATE_COMPLETE)  
              DoEvents  
        Wend  
            End   If  
        Next   URL_Index  
        End   Sub  
   
 

 

 

 

 

这是个不用   webbrowser   抓links   的办法：  
   
  =========  
  Private   Sub   cmdGo_Click()  
          Dim   objLink   As   HTMLLinkElement  
          Dim   objMSHTML   As   New   MSHTML.HTMLDocument  
          Dim   objDocument   As   MSHTML.HTMLDocument  
           
           
          lblStatus.Caption   =   "Gettting   document   via   HTTP"  
           
   
          Set   objDocument   =   objMSHTML.createDocumentFromUrl(txtURL.Text,   vbNullString)  
           
          lblStatus.Caption   =   "Getting   and   parsing   HTML   document"  
           
   
          While   objDocument.readyState   <>   "complete"  
                  DoEvents  
          Wend  
           
          lblStatus.Caption   =   "Document   completed"  
           
           
           
          txtSource.Text   =   objDocument.documentElement.outerHTML  
           
          DoEvents  
           
     
          lblTitle.Caption   =   "Title   :   "   &   objDocument.Title  
           
          DoEvents  
           
          lblStatus.Caption   =   "Extracting   links"  
           
     
           
          For   Each   objLink   In   objDocument.links  
                  lstLinks.AddItem   objLink  
                  lblStatus.Caption   =   "Extracted   "   &   objLink  
                  DoEvents  
          Next  
           
          lblStatus.Caption   =   "Done"  
           
          Beep  
           
  End   Sub

 

 

 

这是个给webbrowser   加右键menu   的东西，好象.net   就不用这么麻烦了  
   
  Option   Explicit  
  Dim   hw   As   Long  
   
  Private   Sub   Command1_Click()  
          WebBrowser1.Navigate   Text1.Text  
          WebBrowser1.Visible   =   True  
  End   Sub  
   
  Private   Sub   Form_Load()  
          Dim   h   As   Long,   aClass   As   String,   k   As   Long  
          h   =   GetWindow(hwnd,   GW_CHILD)  
          aClass   =   Space$(128)  
          Do   While   h  
                  k   =   GetClassName(h,   aClass,   128)  
                  If   Left$(aClass,   k)   =   "Shell   Embedding"   Then   hw   =   h:   Exit   Do  
                  h   =   GetWindow(h,   GW_HWNDNEXT)  
          Loop  
   
          WebBrowser1.Navigate   ""  
          origWndProc   =   SetWindowLong(hw,   GWL_WNDPROC,   AddressOf   AppWndProc)  
  End   Sub  
   
  Private   Sub   Form_QueryUnload(Cancel   As   Integer,   UnloadMode   As   Integer)  
          SetWindowLong   hw,   GWL_WNDPROC,   origWndProc  
  End   Sub  
   
  Private   Sub   mnuPrint_Click()  
          MsgBox   "Print!"  
  End   Sub  
   
  Private   Sub   mnuNavigate_Click()  
  Command1_Click  
  End   Sub  
   
  Private   Sub   Text1_GotFocus()  
          Text1.SelStart   =   0  
          Text1.SelLength   =   Len(Text1.Text)  
  End   Sub  
 

 

 

 

这是上面的加menu   的bas   文件  
   
  ==  
  Option   Explicit  
  Public   Declare   Function   CallWindowProc   Lib   "user32"   Alias   "CallWindowProcA"   (ByVal   lpPrevWndFunc   As   Long,   ByVal   hwnd   As   Long,   ByVal   Msg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long  
  Public   Declare   Sub   CopyMemory   Lib   "kernel32"   Alias   "RtlMoveMemory"   (hpvDest   As   Any,   hpvSource   As   Any,   ByVal   cbCopy   As   Long)  
  Public   Declare   Function   GetClassName   Lib   "user32"   Alias   "GetClassNameA"   (ByVal   hwnd   As   Long,   ByVal   lpClassName   As   String,   ByVal   nMaxCount   As   Long)   As   Long  
  Public   Declare   Function   GetWindow   Lib   "user32"   (ByVal   hwnd   As   Long,   ByVal   wCmd   As   Long)   As   Long  
  Public   Declare   Function   SetWindowLong   Lib   "user32"   Alias   "SetWindowLongA"   (ByVal   hwnd   As   Long,   ByVal   nIndex   As   Long,   ByVal   dwNewLong   As   Long)   As   Long  
   
  Public   Const   GWL_WNDPROC   =   (-4)  
   
  Public   Const   GW_HWNDNEXT   =   2  
  Public   Const   GW_CHILD   =   5  
           
  Public   Const   WM_MOUSEACTIVATE   =   &H21  
  Public   Const   WM_CONTEXTMENU   =   &H7B  
  Public   Const   WM_RBUTTONDOWN   =   &H204  
   
  Public   origWndProc   As   Long  
   
  Public   Function   AppWndProc(ByVal   hwnd   As   Long,   ByVal   Msg   As   Long,   ByVal   wParam   As   Long,   ByVal   lParam   As   Long)   As   Long  
          Select   Case   Msg  
                  Case   WM_MOUSEACTIVATE  
                          Dim   C   As   Integer  
                          Call   CopyMemory(C,   ByVal   VarPtr(lParam)   +   2,   2)  
                          If   C   =   WM_RBUTTONDOWN   Then  
                                  Form1.PopupMenu   Form1.mnuBrowser  
                                  SendKeys   "{ESC}"  
                          End   If  
                  Case   WM_CONTEXTMENU  
                          Form1.PopupMenu   Form1.mnuBrowser  
                          SendKeys   "{ESC}"  
          End   Select  
          AppWndProc   =   CallWindowProc(origWndProc,   hwnd,   Msg,   wParam,   lParam)  
  End   Function