改变一下问法,在DLL中如何创建WebBrowser并取动态网页内容?(150)

  • 主题发起人 主题发起人 hying95
  • 开始时间 开始时间
不在DLL中已经实现
 
能把你的代码贴出来看看么,我写了个dll,可以实现,但有毛病,程序会出无效的指针地址错误。
 
TO Vsun 你上面的代码我先调用时也出错后来我引用了ShareMem就不出错,但取http://188100.net/1218.htm,我不会改你哪代码里的参数。我觉得你的代码取里面的内容比较快。unit UKM;interfaceuses Windows, Messages, SysUtils, StrUtils, ExtCtrls, OleCtrls, SHDocVw, StdCtrls, Controls, Classes, Variants, Graphics, Forms, Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, inifiles, mshtml;Type TMyWZ= Array[1..4] of string; type TFrmKM = class(TForm) Panel1: TPanel; P_KJJG: TPanel; Image2: TImage; LbTime: TLabel; Label17: TLabel; Panel2: TPanel; WebBrowser1: TWebBrowser; IdHTTP1: TIdHTTP; Timer4: TTimer; Timer3: TTimer; procedure Timer4Timer(Sender: TObject); procedure Timer3Timer(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormPaint(Sender: TObject); private { Private declarations } procedure WbnHttp(var s:string); procedure GetKJ_SJ;//获取下期开码时间 public { Public declarations } end;var FrmKM: TFrmKM; ini: TInifile; KJTime,KMJG,aWZ: string;function Show_KMXC(aHandle:THandle; var WZ: String):Boolean;stdcall;implementation{$R *.dfm}uses Wininet;//检测计算机是否上网function CheckNet: Boolean; stdcall;const // local system uses a modem to connect to the Internet. INTERNET_CONNECTION_MODEM = 1; // local system uses a local area network to connect to the Internet. INTERNET_CONNECTION_LAN = 2; // local system uses a proxy server to connect to the Internet. INTERNET_CONNECTION_PROXY = 4; // local system's modem is busy with a non-Internet connection. INTERNET_CONNECTION_MODEM_BUSY = 8;var dwConnectionTypes : DWORD;begin dwConnectionTypes := INTERNET_CONNECTION_LAN+INTERNET_CONNECTION_MODEM +INTERNET_CONNECTION_PROXY; //Result := InternetGetConnectedState(@dwConnectionTypes, 1); Result := InternetGetConnectedState(@dwConnectionTypes, 0);end;//提取字符串中指定子字符串前的字符串Function Before(Str,S:string): string ;var f: word;begin f:= pos(s,Str) ; if f=0 then before:= Str else before:=copy(Str,1,F-1);end;//提取字符串中指定子字符串后的字符串function After(Str,S:string): string ;var f: Word;begin f:=pos(s,str); if F=0 then After:='' else After:=COPY(Str,F+1,length(str)-length(s));end;function fmtTime(aTime: string):string;var s: string;begin s:=aTime; s :=StringReplace(s,'点',':',[rfReplaceAll]); s :=StringReplace(s,'分',':',[rfReplaceAll])+'00'; Result:=s;end;//转化为秒function TimeToInt(const Times: TTime): Integer;var Hour, Min, Sec, MSec: Word;begin DeCodeTime(Times,Hour, Min, Sec, MSec); Result := Hour * 3600 + Min * 60 + Sec;end;function inttotime(aInt: integer):string;//var H,M,TMP: Integer; Str: String;begin H:=aInt Div 3600; //tmp:=aInt-H*3600; tmp:=(aInt mod 3600) div 60; M:=Tmp Div 60; if (H>0) and (H<10) then Str:='还差 '+inttostr(H)+'个小时'+inttostr(M)+'分 才开码'; IF (H=0) Then IF (m>0) Then Str:='还有 '+inttostr(M)+' 分就开码了,再等等!!!' else Str:='已经开了 '+inttostr(abs(M))+' 分钟了!!!'; if (H<0) then Str:='靠,都已经开了'+inttostr(abs(H))+'个小时 '+inttostr(abs(M))+' 分了!!还来看'; result:=str;end;function fmtKJ_Time(aTime: string):string;var s: string; Y,M,D: Word;begin DeCodeDate(now,y,m,d); s:=inttostr(m)+'月'+inttostr(d); if before(aTime,'日')=s then Result:='今天开码时间晚上:'+RightStr(aTime,6) else Result:=aTime;end;function GetWZ(var S: String): TMyWZ;//把INI中网址读到ARRAY中var ii: TInifile; str: string; i: integer;begin //setlength(result,4); ii:=tinifile.Create('./WZ32.Ini'); for i := 1 to 4 do begin str:=ii.ReadString(S,inttostr(i),''); result:=str; end; str:=ii.ReadString(s,'WZ',''); S:=Str; end;//提取字符串中两个指定子字符串间字符串function GetssStr(Const AText:String; cStart, cEnd: String):String; stdcall;var iBegin,iEnd: Integer; cStartLen: integer;begin Result := ''; cStartLen:=Length(cStart); iBegin := Pos(cStart,AText); iEnd := PosEx(cEnd,AText,iBegin); Result := Copy(AText,iBegin+cStartLen,iEnd - iBegin-cStartLen);end;//开码现场function Show_KMXC(aHandle:THandle; var WZ: String):Boolean;stdcall;begin Application.Handle:=aHandle; aWZ:=WZ; FrmKM:=TFrmKM.Create(Application); try FrmKM.ShowModal; WZ:=KMJG; result:=False; finally FrmKM.Free; end;end;procedure TFrmKM.GetKJ_SJ;//获取下期开码时间const cField: Array[1..4] of string=('月','日 星期',' ','');var s: TStringStream; sHtml,str,jg: String; cBegin,cEnd: string; iBegin,iEnd,i: Integer; WZ: String;//网址 iLenBegin:integer; cArr: TMyWZ;begin WZ:=ini.ReadString('Https','WZ','A'); cArr:=GetWZ(WZ); s := TStringStream.Create(''); try IdHTTP1.HandleRedirects := True; IdHTTP1.Get(WZ,s); sHtml := s.DataString; for i := 1 to 4 do begin cBegin:=before(cArr,','); cEnd:=after(cArr,','); iLenBegin:=Length(cBegin); iBegin := Pos(cBegin,sHtml); Inc(iBegin,iLenBegin); iEnd := PosEx(cEnd,sHtml,iBegin); Str:=Copy(sHtml,iBegin,iEnd - iBegin)+cField; jg:=jg+str; end; KJTime:='开码时间: '+jg; //B1.Text:='开码时间: '+jg; finally s.Free; end;end;{ 返回字符串是否是正确的数字表达 }function IsNumber(mStr: string): Boolean; var I: Real; E: Integer;begin Val(mStr, I, E); Result := E = 0; E := Trunc(I);end; { IsNumber }procedure TFrmKM.WbnHttp(var s:string);var aSection: string; ii: tinifile;begin ii:=tinifile.Create('./WZ32.ini'); aSection:=ini.ReadString('Https','WZ','A'); begin S:=''; WebBrowser1.Navigate(ii.ReadString(aSection,'WZ','http://www.855800.com/1218.htm')); if not(WebBrowser1.Busy) then s:=(IHtmlDocument2(WebBrowser1.Document).Body.OuterText); end;end;procedure TFrmKM.Timer4Timer(Sender: TObject);var s,tmp: string; KJ_Time,Nkj_Time: string; sLis: TStrings;begin sLis:=TStringList.Create; if not CheckNet then exit; WbnHttp(s); sLis.Text:=s; //sLis.SaveToFile('./mm.txt'); NKJ_Time:=ini.ReadString('Https','aDateTime',''); if NKJ_Time='' then exit else if sLis.count>3 then begin tmp:=sLis.Strings[sLis.count-3]; KJ_Time:=sLis.Strings[sLis.count-1]; if pos('分',KJ_Time)>0 then LbTime.Caption:=before(KJ_Time,'分')+'分'; if GetssStr(KJ_Time,'时间',' win')<>NKJ_Time then ini.WriteString('Https','aDateTime',GetssStr(KJ_Time,'时间',' win')); if (length(tmp)>=40) then begin KMJG:=After(tmp,':'); Timer4.Enabled:=false; //timer3.Enabled:=true; exit; sLis.Free; FrmKM.Close; end; end;end;procedure TFrmKM.Timer3Timer(Sender: TObject);var H: Integer; s: string; aDate: TDate; kj_time: string; t1: ttime; aIni: tinifile; y,m,d: word;begin DeCodeDate(date,y,m,d); aIni:=Tinifile.Create('./LH32.ini'); kj_time:=aIni.ReadString('Https','aDatetime',''); //如果为空就连网获取开码时间 if KJ_Time='' then begin if CheckNet then begin GetKJ_SJ; //如果有接入互联网就获取开码时间 kj_time:=after(KJTime,' '); aIni.WriteString('Https','aDatetime',kj_time); end else begin //b1.Text:='开码时间更新失败!!!'; exit; end; end; aDate:=EnCodeDate(Y,strtoint(before(KJ_Time,'月')),strtoint(GetssStr(KJ_Time,'月', '日'))); if aDate=Date then //如果是开码日期 begin if (kj_time<>'') and (length(kj_time)<22) then exit; s:=RightStr(kj_time,6); s:=fmtTime(s); t1:=strtotime(s); h:=TimeToInt(t1)-TimeToInt(time); if (H<0) and (h>-300) then begin timer4.Enabled:=true; timer3.Enabled:=false; end; end;end;//procedure TFrmKM.FormCreate(Sender: TObject);begin Ini:=TInifile.Create('./LH32.ini'); Timer4.Enabled :=True;end;procedure TFrmKM.FormPaint(Sender: TObject);var X,Y: Integer; art,art1: trect;begin X:=IMAGE2.Width; Y:=IMAGE2.Height; with IMAGE2.Canvas do begin Brush.Color:=clblue; Pen.Color:=clblue; art:=rect(6,6,X-6,Y-6); art1:=rect(12,12,X-12,Y-12); FrameRect(art); Brush.Color:=clFuchsia; Pen.Color:=clFuchsia; FrameRect(art1); end;end;end.WZ32.INI文件内容[A]1=</font><font color="#FF0000"><b>,</b></font><font color="#0000FF">2=</font></b><font color="#FF0200"><b>,</b></font><font color="#0000FF">3=期</font><font color="#FF0000">,</font>4=<font color="#008000">,</font>WZ=http://188100.net/1218.htm1=</font><b><font color="#FF0000">,</font></b><font color="#0000FF">2=月</font><b><font color="#FF0000">,</font></b><font color="#0000FF">日星期3=日星期</font><b><font color="#FF0000">,</font></b>4=<font color="#008000">,</font> <aWZ=http://www.855800.com/1218.htmLH32.INI内容[Https]WZ=ABM1=http://788700.com/1218.htmaBegin=<font size="3">aEnd=</font>NextB=<font color="#0000FF">NextE=</font>开码倒计时=300KJ_Week=星期一KJ_Time=7:00:00aDatetime=4月8日星期四 21点30分
 
最好留个邮箱我发给你,
 
你上面所贴的代码中的几个网址我这里都打不开,所以我也没有办法测试。其实我贴的代码也没有什么的,用的就是xmlhttp组件和正则表达式组件。取静态网页内容的话是可以用xmlhttp的,但是取动态的就不行了。像http://188100.net/1218.htm里面的部份内容就是动态js写进去的。所以用xmlhttp就没有办法取得正确的内容的。正则表达式是个很好的字符串处理组件,在网上有很多的教材,也很简单的。我也是个delphi门外汉,很多都不懂,贴段代码,让你参考一下。procedure TForm1.Button3Click(Sender: TObject);var Getdoc: IHTMLDocument2; Getall: IHTMLElementCollection; Getitem: IHTMLElement; i, stime, etime: integer;begin while (WebBrowser1.ReadyState < 4) do Application.ProcessMessages; Getdoc := IHTMLDocument2(WebBrowser1.Document); Getall := IHTMLElementCollection(Getdoc.Get_all); for i := 0 to Getall.Length - 1 do begin Getitem := Getall.Item(i, null) as IHTMLElement; if Getitem.id = 'start_score' then ShowMessage(Getitem.OuterText); end;end;procedure TForm1.FormCreate(Sender: TObject);begin WebBrowser1.Navigate('http://188100.net/1218.htm');end;
 
DLL没有普通程序中的Application帮你处理消息所以WebBrowser1.Navigate之后你取不到里面的值所以需要自己处理消息循环,等WebBrowser1.Navigate完成后再取里面的内容。
 
xianjun 能否贴段代码?如何处理?就用 Vsun的代码procedure TForm1.Button3Click(Sender: TObject);var Getdoc: IHTMLDocument2; Getall: IHTMLElementCollection; Getitem: IHTMLElement; i, stime, etime: integer;begin while (WebBrowser1.ReadyState < 4) do Application.ProcessMessages; Getdoc := IHTMLDocument2(WebBrowser1.Document); Getall := IHTMLElementCollection(Getdoc.Get_all); for i := 0 to Getall.Length - 1 do begin Getitem := Getall.Item(i, null) as IHTMLElement; if Getitem.id = 'start_score' then ShowMessage(Getitem.OuterText); end;end;procedure TForm1.FormCreate(Sender: TObject);begin WebBrowser1.Navigate('http://188100.net/1218.htm');end;
 
晚上睡不着,起来看看有没有人回答,结果有失望
 
把Application.ProcessMessages替换一下用PeekMessageTranslateMessageDispatchMessage替代。
 
无法替换老大,帮忙看看xianjun
 
晕,这里肯定只能给你思路,总不能把所有代码写好贴出来吧。或者你把整个工程发过来,包括DLL及调用程序,我帮你看一下。
 
在DLL中使用TWebBrowser必须注意一点:初始化和反初始化CoInitialize(nil);CoUninitialize;使用Activex单元
 
在网上搜过,试着初始化了,但是还是不行
 
library Project1;uses SysUtils, ShDocVw, Forms, MSHTML, Classes;{$R *.res}function GetHTML(Handle: integer): string; stdcall;var HideWebBrower: TWebBrowser; GetText: string;begin HideWebBrower := TWebBrowser.Create(nil); ; HideWebBrower.ParentWindow := Handle; HideWebBrower.Hide; HideWebBrower.Navigate('http://188100.net/1218.htm'); while HideWebBrower.ReadyState < 4 do Application.ProcessMessages; GetText := HideWebBrower.OleObject.document.ParentWindow.start_score.innerText; while Length(GetText) < 1 do begin GetText := HideWebBrower.OleObject.document.ParentWindow.start_score.innerText; Application.ProcessMessages; end; result := GetText; HideWebBrower.Free;end;exports GetHTML;end.program Project1;uses Forms, ActiveX, Unit1 in 'Unit1.pas' {Form1};{$R *.res}begin [red]CoInitialize(nil);[/red] Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; [red]CoUnInitialize;[/red]end.这些代码前几天在我的机器上运行老有出错,今晚无聊,再运行,又不出错了,我也不懂是啥会事,你自己参考一下吧。
 
to Vsun 在你机器上能否取到结果?我这里调用取不到结果,完了后还关闭不了主窗口procedure TForm1.btn1Click(Sender: TObject);var aGetHTML: function(Handle:Integer): string; stdcall; dllname: string; hnd: THandle;begin dllname:='./Project1.dll'; hnd:=LoadLibrary(PChar(dllname)); if hnd<>0 then; begin @aGetHTML:=GetProcAddress(hnd,PChar('GetHTML')) ; if @aGetHTML<>nil then edt1.Text:=aGetHTML(0); if hnd<>0 THEN FreeLibrary(HND); end;end;
 
关键还是在于Application.ProcessMessages,这个DLL的Application是处理不了WebBrowser的消息的,所以WebBrowser也不可能真正Navigate到指定网页。这也就是为什么我之前要你自己处理消息循环。当然我看你现在都直接使用字符串传递了,也就是DLL与主程序之间会使用ShareMem,那就可以简化一下,直接传递Application对象过去好了。function GetHTML(AParentHandle: THandle; App: TApplication): string; stdcall;var HideWebBrower: TWebBrowser; GetText: string;begin HideWebBrower := TWebBrowser.Create(App); HideWebBrower.ParentWindow := AParentHandle; HideWebBrower.Hide; HideWebBrower.Navigate('http://188100.net/1218.htm'); while HideWebBrower.ReadyState < READYSTATE_COMPLETE do App.ProcessMessages; GetText := HideWebBrower.OleObject.document.ParentWindow.start_score.innerText; while Length(GetText) < 1 do begin GetText := HideWebBrower.OleObject.document.ParentWindow.start_score.innerText; App.ProcessMessages; end; Result := GetText; HideWebBrower.Free;end;主程序中要这样调用:GetHTML(Handle, Application);最后DLL及主程序都要在DPR第一个位置引用ShareMem内存管理器。
 
可以了多谢Vsunt和Xianjun两位大侠
 
[red] edt1.Text:=aGetHTML(0);[/red]不能这样调用的,要用 aGetHTML(self.Handle)调用,你要看函数中有个设置动态webBrowser的父窗口的步骤啊。你传个0的参数进去当然是不行的了。
 
后退
顶部