自定义 组件 控件 制作组件控件

自定义 组件 控件  制作组件控件

 

unit webbrowser;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, SHDocVw_1_1_TLB,activex;

type

{ twebbrowser }

twebbrowser = class(TAxcWebBrowser)
private
{ Private declarations }
OldProgress:integer;
wanchengle:boolean;

protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(TheOwner: TComponent); override;
procedure navigate(url:string);
function source():string;
function kuangjiasource(a1,a2,a3:integer):string;
function kuangjiageshu():integer;

// TDWebBrowserEvents2NewWindow2;
procedure win2(Sender: TObject;var ppDisp:IDispatch;var Cancel:WordBool);

// TDWebBrowserEvents2NewWindow3

procedure win3(Sender: TObject;var ppDisp:IDispatch;var Cancel:WordBool;dwFlags:LongWord;bstrUrlContext:WideString;bstrUrl:WideString) ;

//FOnProgressChange:TDWebBrowserEvents2ProgressChange;
procedure wancheng(Sender: TObject;Progress:Integer;ProgressMax:Integer);

procedure pingbilikai;
published
{ Published declarations }
end;

procedure Register;

implementation
uses lazaruszhaiming,MSHTML_4_0_TLB;

 

procedure Register;
begin
{$I webbrowser_icon.lrs}
RegisterComponents('Standard',[twebbrowser]);
end;

{ twebbrowser }

constructor twebbrowser.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
active:=true;
self.Width:=600;
self.Height:=400;
self.OleServer.Silent:=true;
self.OnNewWindow2:=@win2 ;
self.OnNewWindow3:=@win3 ;
self.OnProgressChange:=@wancheng;
wanchengle:=false;
end;

procedure twebbrowser.navigate(url: string);
label v1,v2,v3,v4,v5,v6,v7,v8,v9,v0;
var
i,j,k:integer; a,b,c:string;
url2,onull:Olevariant;

begin
v1:
wanchengle:=false;
url2:=Utf8decode(url);
onull:=NULL;

self.OleServer.Navigate2(url2,onull,onull,onull,onull);
i:=0;
v0:
i:=i+1;
application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111); application.ProcessMessages; sleep(111);
if i>=30 then goto v1;
if not wanchengle then goto v0;

end;

function twebbrowser.source: string;
var cookie:string; tt:tstringlist;
begin
try
cookie:= (self.OleServer.Document as ihtmldocument2).cookie;
result:='cookie: '+ cookie+' '+#13#10+' html代码 '+#13#10+(self.OleServer.Document as ihtmldocument3).documentElement.outerHTML ;

except
result:='000---';
end;

tt:=tstringlist.Create;
tt.Text:=result;
tt.SaveToFile('d:\yuanma.txt');
tt.free;
end;

function twebbrowser.kuangjiasource(a1, a2, a3: integer): string;
var
doc2:IHTMLDocument2;
wd : IHTMLWindow2;
bw : IWebBrowser2;
ooo:olevariant;
tt:tstringlist;
vframe, frame_dispatch: IDispatch;

function HtmlWindowToHtmlWebBrowser(const ADsp : IDispatch) : IWebBrowser2;
var
isp : IServiceProvider;
begin
Result := nil;
if not Assigned(ADsp) then Exit;
isp := ADsp as IServiceProvider;

isp.QueryService(IID_IWebBrowserApp, IID_IWebBrowser2, Result);
end;
begin
if a1=0 then begin ;exit; end;

try ooo:=a1;
vframe :=(self.OleServer.Document as ihtmldocument2) .frames.item(ooo);
if Assigned(vframe) then
begin
vframe.QueryInterface(IID_IHTMLWindow2, wd);
if Assigned(wd) then
bw := HtmlWindowToHtmlWebBrowser(wd);
if Assigned(bw) then
doc2 := bw.Document as IHTMLDocument2;
wd := nil;
vframe := nil;
end;
result :=(doc2 as ihtmldocument3).documentElement.outerHTML;
tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free;
except
wd := nil;
vframe := nil;
showmessage('第一个参数失败');
result :='000失败 '; tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free; exit;
end;

 

if a2=0 then begin exit; end;

try ooo:=a2;
vframe :=(doc2 as ihtmldocument2) .frames.item(ooo);
if Assigned(vframe) then
begin
vframe.QueryInterface(IID_IHTMLWindow2, wd);
if Assigned(wd) then
bw := HtmlWindowToHtmlWebBrowser(wd);
if Assigned(bw) then
doc2 := bw.Document as IHTMLDocument2;
wd := nil;
vframe := nil;
end;
result :=(doc2 as ihtmldocument3).documentElement.outerHTML;
tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free;
except
wd := nil;
vframe := nil; showmessage('第2个参数失败');
result :='111失败 ';tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free; exit;
end;

 

if a3=0 then begin exit; end;

try ooo:=a3 ;
vframe :=(doc2 as ihtmldocument2) .frames.item(ooo);
if Assigned(vframe) then
begin
vframe.QueryInterface(IID_IHTMLWindow2, wd);
if Assigned(wd) then
bw := HtmlWindowToHtmlWebBrowser(wd);
if Assigned(bw) then
doc2 := bw.Document as IHTMLDocument2;
wd := nil;
vframe := nil;
end;
result :=(doc2 as ihtmldocument3).documentElement.outerHTML;
tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free;
except
wd := nil;
vframe := nil; showmessage('第3个参数失败');
result :='222失败 '; tt:=tstringlist.Create;tt.Text:=result;tt.SaveToFile('d:\kuangjia.txt');tt.free;exit;
end;

end;

function twebbrowser.kuangjiageshu(): integer;
begin

// result:=self.OleServer .Document.documentelement.document.frames.length ;
result:=(self.OleServer.Document as ihtmldocument2).frames.length;
showmessage(inttostr(result));
end;

procedure twebbrowser.win2(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool);
begin
cancel:=true;
end;

procedure twebbrowser.win3(Sender: TObject; var ppDisp: IDispatch;
var Cancel: WordBool; dwFlags: LongWord; bstrUrlContext: WideString;
bstrUrl: WideString);
begin
cancel:=true;
end;

procedure twebbrowser.wancheng(Sender: TObject; Progress: Integer;
ProgressMax: Integer);
begin

//判断页面及JS是否执行完毕
if ( Progress = 0 ) and ( ProgressMax = 0 ) and
( OldProgress = -1 ) then
begin
wanchengle := True;
end;

OldProgress := Progress;

end;

procedure twebbrowser.pingbilikai;
var sa:string;
begin
sa:='function stoprefresh()'+
'{ ' +
'return undefined; ' +
'} window.onbeforeunload=stoprefresh; ' +
'window.onunload =stoprefresh;' ;
// showmessage('1');
( self.OleServer.Document as ihtmldocument2).parentWindow.execScript(sa,'JavaScript') ;
end;

end.