delphi 获取获取当前网页的URL(100)

  • 主题发起人 主题发起人 zhangxuepu107
  • 开始时间 开始时间
unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls;type TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); private list_tmp: TStringList; list_now: TstringList; procedure Get_URL_List; public end;var Form1: TForm1;implementationuses SHDocVw;{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);begin list_tmp := TStringList.Create; list_now := TstringList.Create;end;procedure TForm1.FormDestroy(Sender: TObject);begin list_tmp.Clear; list_tmp.Free; list_now.Clear; list_now.Free;end;procedure TForm1.Get_URL_List;Var Browser: IWebBrowser2; I: Integer; aname, apath: String;begin list_now.Clear; With TShellWindows.Create(Nil) Do Begin try For I := 0 To Count - 1 do Begin Browser := Item(I) As IWebBrowser2; aname := Browser.LocationName; apath := Browser.LocationURL; If Not (pos('file', apath) = 1) Then Begin list_now.Add(Format('%s',[apath])); If list_tmp.IndexOf(apath) = -1 Then //是新开的地址 Begin Application.MessageBox(PChar(apath),'新开的网页:',64); //If pos('google', apath) <> 0 Then //Browser.Quit; End; End; End; finally list_tmp.CommaText := list_now.CommaText; Free; end; End;End;procedure TForm1.Timer1Timer(Sender: TObject);begin timer1.Enabled := False; try Get_URL_List; finally timer1.Enabled := True; end;end;end.
 
var classname: array[0..255] of char; addr: array[0..255] of char; edith: THandle;begin GetClassName(hwnd,classname,256); if classname = 'IEFrame' then begin edith:= findwindowex(hwnd,0,'WorkerW',nil); edith:= findwindowex(edith,0,'ReBarWindow32',nil); edith:= findwindowex(edith,0,'ComboBoxEx32',nil); sendmessage(edith,wm_gettext,256,Integer(@addr)); F_main.Memo2.Lines.Add(addr); end; result:= true;end;这段代理为何在2003下能够执行,在xp下不能获得网址?
 
多人接受答案了。
 
后退
顶部