DELPHI 如何获得 Webbrowser 浏览文件夹 选中的文件路径

Posted

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了DELPHI 如何获得 Webbrowser 浏览文件夹 选中的文件路径相关的知识,希望对你有一定的参考价值。

DELPHI 如何获得 Webbrowser 浏览文件夹 选中的文件路径
Webbrowser1.Nagivate('C:\'); 这下WEBBROWSER变成了一个WINDOWS资源管理器了
现在要在怎么知道 在Webbrowser1中选中的文件的完整路径了
用代码知道 在Webbrowser1中选中的文件的完整路径了

//哥封装的函数
function GetWebPath(web:TWebBrowser): string;
var
item : TLvItem;
clsName: array[0..MAX_PATH] of char;
hwndLv: HWND;
selCount,fileCount,selMark:integer;
fileName: array[0..MAX_PATH] of char;
begin
hwndLV := GetWindow(web.Handle,GW_CHILD);
hwndLV := GetWindow(hwndLV,GW_CHILD);
GetClassName( hwndLV,clsName,MAX_PATH);
if(UpperCase(clsName)<>'SYSLISTVIEW32')then Exit;
Result := web.LocationURL;
Result := StringReplace(Result,'file:///','',[rfIgnoreCase]);
Result := StringReplace(Result,'/','\',[rfReplaceAll]);
if(Result[length(Result)]<>'\')then
Result := Result + '\';

fileCount := ListView_GetItemCount(hwndLV);
selCount := ListView_GetSelectedCount(hwndLV);
selMark := ListView_GetSelectionMark(hwndLV);
if(selCount=0)or(selMark=-1)then
exit;

ListView_GetItemText(hwndLV,selMark,0,@fileName[0],MAX_PATH);

Result := Result + fileName;
end;

//调用示例
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage( GetWebPath(WebBrowser1) );
end;

注意:
uses commctrl
参考技术A 虽然webbrowser可以实现查看文件夹的功能,但是你可以试一下,当你要打开某个文件夹的时候,实际是在资源管理器中打开的,使用webbrowser是没法查看文件的完整路径的,要想实现资源管理器的功能,建议使用listview控件 参考技术B 占位看解决方法

delphi中webbrowser的用法

  1. WebBrowser1.GoHome; //到浏览器默认主页  
  2. WebBrowser1.Refresh; //刷新  
  3. WebBrowser1.GoBack; //后退  
  4. WebBrowser1.GoForward; //前进  
  5. WebBrowser1.Navigate(‘...‘); //打开指定页面  
  6. WebBrowser1.Navigate(‘about:blank‘); //打开空页面  
  7. //打开空页面, 并写入...  
  8.   
  9. WebBrowser1.Navigate(‘about:<head><title>标题</title><body>页面内容</body>‘);  
  10. //读取网页脚本中的变量:  
  11.   
  12. procedure TForm1.Button1Click(Sender: TObject);  
  13. var  
  14. s: string;  
  15. i: Integer;  
  16. begin  
  17. s := WebBrowser1.OleObject.document.Script.str;  
  18. i := WebBrowser1.OleObject.document.Script.num;  
  19. ShowMessage(s); //Hello  
  20. ShowMessage(IntToStr(i)); //99  
  21.   
  22. //也可以这样读:  
  23. s := WebBrowser1.OleObject.document.parentWindow.str;  
  24. i := WebBrowser1.OleObject.document.parentWindow.num;  
  25. ShowMessage(s); //Hello  
  26. ShowMessage(IntToStr(i)); //99  
  27. end;  
  28. //调用网页脚本中的函数:  
  29.   
  30. procedure TForm1.Button1Click(Sender: TObject);  
  31. begin  
  32. WebBrowser1.OleObject.document.parentWindow.MB(); //HTML-Js  
  33.   
  34. //如需指定脚本语言, 需要:  
  35. WebBrowser1.OleObject.document.parentWindow.execScript(‘MB()‘,‘JavaScript‘); //HTML-Js  
  36. end;  
  37.   
  38. //判断网页及内部框架网页是否全部下载完毕  
  39.   
  40. procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;  
  41. const pDisp: IDispatch; var URL: OleVariant);  
  42. begin  
  43. if   not(<span style="font-family: Arial, Helvetica, sans-serif;">WebBrowser1</span>.Busy)   then    
  44.   ShowMessage(‘下载完毕‘);   
  45. end;  
  46.   
  47. //改变背景色或背景图片:  
  48. WebBrowser1.OleObject.document.body.bgcolor := ‘#FF0000‘;  
  49. WebBrowser1.OleObject.document.body.background := ‘...图片地址‘;  
  50. //操作有 ID 标签的对象:  
  51. var  
  52. s: string;  
  53. begin  
  54. s := WebBrowser1.OleObject.document.getElementByIdx_x(‘span1‘).innerText;  
  55. ShowMessage(s); //这是 span1 标签中的内容  
  56.   
  57. //或者:  
  58. s := WebBrowser1.OleObject.document.parentWindow.span1.innerText;  
  59. ShowMessage(s); //这是 span1 标签中的内容  
  60.   
  61. //隐藏它:  
  62. WebBrowser1.OleObject.document.parentWindow.span1.style.display := ‘none‘;  
  63. end;  
  64. //获取网页源代码  
  65. var  
  66. s: string;  
  67. begin  
  68. s := WebBrowser1.OleObject.document.body.innerHTML; //body内的所有代码  
  69. s := WebBrowser1.OleObject.document.body.outerHTML; //body内的所有代码, 包含body标签  
  70. s := WebBrowser1.OleObject.document.documentElement.innerHTML; //html内的所有代码  
  71. end;  
  72. </pre><pre name="code" class="delphi"><span style="color: rgb(73, 73, 73); font-family: simsun; font-size: 14px; line-height: 21px;">Memo1.Lines.Add(IHtmlDocument2(WebBrowser1.Document).Body.OuterHtml);</span>  
  73.   
  74. //获取网页全部源代码  
  75. uses ActiveX;  
  76. var  
  77. ms: TMemoryStream;  
  78. begin  
  79. if not Assigned(WebBrowser1.Document) then Exit;  
  80. ms := TMemoryStream.Create;  
  81. (WebBrowser1.Document as IPersistStreamInit).Save(TStreamAdapter.Create(ms), True);  
  82. ms.Position := 0;  
  83. Memo1.Lines.LoadFromStream(ms, TEncoding.UTF8);  
  84. // Memo1.Lines.LoadFromStream(ms, TEncoding.Default); {GB2312 等双字节}  
  85. ms.Free;  
  86. end;  
  87. //WebBrowser 中的右键菜单  
  88.   
  89. //先要添加ApplicationEvents1,指定其Message事件  
  90.   
  91. //屏蔽右键菜单  
  92. procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);  
  93. begin  
  94. with Msg do  
  95. begin  
  96. if not IsChild(WebBrowser1.Handle, hWnd) then Exit;  
  97. Handled := (message = WM_RBUTTONDOWN) or (message = WM_RBUTTONUP) or (message = WM_CONTEXTMENU);  
  98. end;  
  99. end;  
  100.   
  101. //替换右键菜单  
  102. procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);  
  103. var mPoint: TPoint;  
  104. begin  
  105. if IsChild(WebBrowser1.Handle, Msg.Hwnd) and  
  106. ((Msg.Message = WM_RBUTTONDOWN) or (Msg.Message = WM_RBUTTONUP)) then  
  107. begin  
  108. GetCursorPos(mPoint); //得到光标位置  
  109. PopupMenu1.Popup(mPoint.X, mPoint.Y); //弹出popupmenu1的菜单  
  110. Handled:=True;  
  111. end;  
  112. end;  
  113. //新页面写入  
  114. begin  
  115. WebBrowser1.Navigate(‘about:blank‘);  
  116. WebBrowser1.OleObject.Document.Writeln(‘ok‘);  
  117. end;  
  118.   
  119. //从流中写入:  
  120. var  
  121. ms: TMemoryStream;  
  122. begin  
  123. ms := TMemoryStream.Create;  
  124. Memo1.Lines.SaveToStream(ms);  
  125. ms.Position := 0;  
  126. (WebBrowser1.Document as IPersistStreamInit).Load(TStreamAdapter.Create(ms));  
  127. ms.Free;  
  128. end;  
  129.   
  130. //禁止提示脚步错误  
  131. procedure TForm1.WebBrowser1NavigateComplete2(ASender: TObject;  
  132. const pDisp: IDispatch; var URL: OleVariant);  
  133. begin  
  134. WebBrowser1.Silent := True;  
  135. end;  
  136. </pre><pre name="code" class="delphi">方法二  
  137. TWebBrowser的OnDownloadComplete事件里面执行  
  138. (WebBrowser1.Document as IHTMLDocument2).parentWindow.execScript(‘window.onerror=function(){return true}‘,‘JavaScript‘);  
  139.   
  140. </pre><pre name="code" class="delphi">//禁止弹出窗口  
  141. procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;  
  142. var Cancel: WordBool);  
  143. begin  
  144. Cancel := True;  
  145. end;  
  146. </pre><pre name="code" class="delphi">//使WebBrowser获得焦点  
  147.   TWebBrowser非常特殊,它从TWinControl继承来的SetFocus方法并不能使得它所twebbrows setfocu 方法包含的文档获得焦点,从而不能立即使用Internet Explorer本身具有得internet explor 使用快捷键,解决方法如下:<  
  148.   procedure TForm1.SetFocusToDoc;  
  149.   begin  
  150.    if WebBrowser1.Document <> nil then  
  151.     with WebBrowser1.Application as Ioleobject do  
  152.      DoVerb(OLEIVERB_UIACTIVATE, nil, WebBrowser1, 0, Handle, GetClientRect);  
  153.   end;  
  154.   除此之外,我还找到一种更简单的方法,这里一并列除此之外这里并列出:  
  155.   if WebBrowser1.Document <> nil then  
  156.    IHTMLWindow2(IHTMLDocument2(WebBrowser1.Document).ParentWindow).focus  
  157.   刚找到了更简单的方法,也许是最简单的:  
  158.   if WebBrowser1.Document <> nil then  
  159.    IHTMLWindow4(WebBrowser1.Document).focus  
  160.   还有,需要判断文档是否获得焦点这样来做:  
  161.   if IHTMLWindow4(WebBrowser1.Document).hasfocus then  
  162. </pre><pre name="code" class="delphi">  
  163. //查找内容  
  164.   查找对话框可以在文档获得焦点的时候通过按键Ctrl-F对话框焦点按键来调出,程序中则调用IOleCommandTarget对象的成员函数Exec执行OLECMDID_FIND操作olecmdid 操作执行来调用,下面给出的方法是如何在程序中用代码来做出文下面方法如何字选择,即你可以自己设计查找对话框。  
  165.    Var  
  166.     Doc: IHtmlDocument2;  
  167.     TxtRange: IHtmlTxtRange;  
  168.    begin  
  169.     Doc :=WebBrowser1.Document as IHtmlDocument2;  
  170.     Doc.SelectAll;    //此处为简写,选择全部文档的方法selectal 方法文档请参见第三条命令操作  
  171.                 //这句话尤为重要,因重要尤为为IHtmlTxtRange对象的方法能够操作的前提是  
  172.                 //Document已经有一个文字选document 文字一个择区域。由于接着执行下面的语句,所以不会  
  173.                 //看到文档全选的过程看到过程文档。  
  174.     TxtRange :=Doc.Selection.CreateRange as IHtmlTxtRange;  
  175.     TxtRange.FindText(‘Text to be searched‘,0.0);  
  176.     TxtRange.Select;  
  177.    end;  
  178.   还有,从Txt.Get_text可以得到当前选中的文字内容,某些得到文字当前时候是有用的。  
  179.   
  180. </pre><pre name="code" class="delphi">//点击“提交”按钮  
  181.   如同程序里每个窗体上有一个“缺省”按钮一样,Web一样按钮每个页面上的每个Form也有一个“缺省”按钮——即属性为“Submitsubmit form 按钮”的按钮,当用户按下回车键时就相当于鼠标单击了“Submitsubmit 回车键相当”。但是TWebBrowser似乎并不响应回车键,并且,即使把包含TWebBrowser的twebbrows 回车键似乎窗体的KeyPreview设为True,在窗体的KeyPress事件里还是不能截获用户向keypreview keypress 事件TWebBrowser发出的按键。  
  182.   我的解决办法是用ApplicatinEvents构件或者自己编写Tapplication对象的OnMessage事onmessag tapplic 构件件,在其中判断消息类型,对键盘消息做出响应。至于点至于响应判断击“提交”按钮,可以通过分析网页源代码的方法来实现源代码网页方法,不过我找到了更为简单快捷的方法,有两种,第一种是更为不过方法我自己想出来的,另一种是别人写的代码,这里都提供给自己这里出来大家,以做参考。  
  183.   A、用SendKeys函数向WebBrowser发送回车键  
  184.     在Delphi5光盘上的Info/Extras/SendKeys目录下有一个SndKey32.pas文件,sendkei delphi sndkei其中包含了两个函数SendKeys和AppActivate,我们可以用SendKeys函数来向WebBrowser发appactiv webbrows sendkei送回车键,我现在用的就是这个方法,使用很简单,在WebBrowserwebbrows 回车键使用获得焦点的情况下(不要求WebBrowser所包含的文档获得焦点),webbrows 焦点包含用一条语句即可:  
  185.    Sendkeys(‘~‘,true);// press RETURN key  
  186.    SendKeys函数的详细参数说明等,均包含在SndKey32.pas文件中sendkei sndkei 参数。  
  187.   B、在OnMessage事件中将接受到的键盘消息传递给WebBrowser。  
  188.    Procedure TForm1.ApplicationEvents1Message(var Msg: TMsg; var Handled: Boolean);  
  189.    {fixes the malfunction of some keys within webbrowser control}  
  190.    const  
  191.     StdKeys = [VK_TAB, VK_RETURN]; { standard keys }  
  192.     ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT]; { extended keys }  
  193.     fExtended = $01000000; { extended key flag }  
  194.    begin  
  195.     Handled := False;  
  196.     with Msg do  
  197.     if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and  
  198.      ((wParam in StdKeys) or  
  199.      {$IFDEF VER120}(GetKeyState(VK_CONTROL) < 0) or {$ENDIF}  
  200.      (wParam in ExtKeys) and  
  201.      ((lParam and fExtended) = fExtended)) then  
  202.     try  
  203.      if IsChild(Handle, hWnd) then { handles all browser related messages }  
  204.      begin  
  205.       with {$IFDEF VER120}Application_{$ELSE}Application{$ENDIF} as  
  206.         IOleInPlaceActiveObject do  
  207.        Handled := TranslateAccelerator(Msg) = S_OK;  
  208.        if not Handled then  
  209.        begin  
  210.         Handled := True;  
  211.         TranslateMessage(Msg);  
  212.         DispatchMessage(Msg);  
  213.        end;  
  214.        end;  
  215.     except  
  216.     end;  
  217.    end; // MessageHandler  
  218. </pre><pre name="code" class="delphi">  
  219. </pre><pre name="code" class="delphi">10、提取网页中所有链接  
  220.   这个方法来自大富翁论坛hopfield朋友的对一个问题的回答hopfield 自大问题,我本想自己试验,但总是没成功。  
  221.   Var  
  222.    doc:IHTMLDocument2;  
  223.    all:IHTMLElementCollection;  
  224.    len,I:integer;  
  225.    item:OleVariant;  
  226.   begin  
  227.    doc:=WebBrowser1 .Document as IHTMLDocument2;  
  228.    all:=doc.Get_links;             //doc.Links亦可  
  229.    len:=all.length;  
  230.    for I:=to len-do begin  
  231.     item:=all.item(I,varempty);        //EmpryParam亦可  
  232.     memo1.lines.add(item.href);  
  233.    end;  
  234.   end;  
  235. -----------------------------------------------------------------------------------  
  236. 11、设置TWebBrowser的编码  
  237.   为什么我总是错过很多机会?其实早就该想到的,但为什么错过想到是一念之差,便即天壤之别。当时我要是肯再多考虑一下一念之差天壤之别当时,多试验一下,这就不会排到第11条了。下面给出一个下面试验一个函数,搞定,难以想象的简单。  
  238.   Procedure SetCharSet(AWebBrowser: TWebBrowser; ACharSet: String);  
  239.   var  
  240.    RefreshLevel: OleVariant;  
  241.   Begin  
  242.    IHTMLDocument2(AWebBrowser.Document).Set_CharSet(ACharSet);  
  243.    RefreshLevel :=7;              //这个7应该从这个应该注册表来,帮助有Bug。  
  244.    AWebBrowser.Refresh2(RefreshLevel);  
  245.   End;  
  246.   
  247. </pre><pre name="code" class="delphi">9.将页面中显示的内容全部选中,然后粘贴到Word文档中.  
  248. WebBrowser1.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT);//全选网页  
  249. WebBrowser1.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);     //复制网页  
  250. WordDocu.Range.Paste;            //word文档粘贴  
  251. WebBrowser1.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT);    //取消全选  
  252. 注:WebBrowser的Document属性值和WordDocument的Document属性值必须都不为nil.  
  253. 10.如何解决网页不响应回车事件  
  254. public  
  255.     { Public declarations }  
  256.     procedure MsgHandle(var Msg :TMsg; var Handled :Boolean);  
  257. end;  
  258. var  
  259. Form1: TForm1;  
  260. FOleInPlaceActiveObject :IOleInPlaceActiveObject;  
  261. implementation  
  262. {$R *.DFM}  
  263. procedure TForm1.MsgHandle(var Msg :TMsg; var Handled :Boolean);  
  264. var  
  265. iOIPAO :IOleInPlaceActiveObject;  
  266. Dispatch :IDispatch;  
  267. begin  
  268. if WebBrowser1 =nil then  
  269. begin  
  270. Handled :=False;  
  271. Exit;  
  272. end;  
  273. Handled :=(IsDialogMessage(WebBrowser1.Handle, Msg) =True);  
  274. if (Handled) and (not WebBrowser1.Busy) then  
  275. begin  
  276. if FOleInPlaceActiveObject =nil then  
  277. begin  
  278.    Dispatch :=WebBrowser1.Application;  
  279.    if Dispatch <>nil then  
  280.    begin  
  281.     Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);  
  282.     if iOIPAO <>nil then  
  283.      FOleInPlaceActiveObject :=iOIPAO;  
  284.    end;  
  285. end;  
  286. end;  
  287. if FOleInPlaceActiveObject <>nil then  
  288. if ((Msg.message =WM_KEYDOWN) or (Msg.Message =WM_KEYUP)) and ((Msg.wParam =VK_BACK) or (Msg.wParam =VK_LEFT) or (Msg.wParam =VK_RIGHT)) then  
  289. else  
  290.    FOleInPlaceActiveObject.TranslateAccelerator(Msg);  
  291. end;  
  292. procedure TForm1.FormCreate(Sender: TObject);  
  293. begin  
  294. Application.OnMessage :=MsgHandle;  
  295. end;  
  296. procedure TForm1.FormDestroy(Sender: TObject);  
  297. begin  
  298. FOleInPlaceActiveObject :=nil;  
  299. end;  
  300.   
  301. </pre><pre name="code" class="delphi">//在WebBrowser加载html页面完成后,在页面顶端插入HTML代码  
  302. procedure TForm1.Button1Click(Sender: TObject);  
  303. var  
  304. Range: IHTMLTxtRange;  
  305. begin  
  306. Range := ((WebBrowser1.Document as IHTMLDocument2).body as  
  307.     IHTMLBodyElement).createTextRange;  
  308. Range.collapse(False);  
  309. Range.pasteHTML(‘<br/><b>Hello!</b>‘);  
  310. end;  
  311. <p>  
  312.       
  313.   
  314.       
  315. </p>  

以上是关于DELPHI 如何获得 Webbrowser 浏览文件夹 选中的文件路径的主要内容,如果未能解决你的问题,请参考以下文章

delphi webbrowser 问题

Delphi用WebBrowser控件定制浏览器,如何控制不让下载网页中的图像或Flash或背景音乐之类的东西?

DELPHI如何实现打开某一个网页没webbrowser组件

delphi webbrowser,如何调整webbrowser里面打开网页的大小,或者使打开的内容适应webbrowser控件的大小。

解决Delphi WebBrowser 无法调用当前浏览器的版本

delphi中webbrowser的用法