没有人帮我吗???:(,我好可怜:< (200分)

  • 主题发起人 主题发起人 天真
  • 开始时间 开始时间
没有做不成的事,只有想不到的事。感谢天真的奇思妙想,让我们一起搞定它。我来学习。
 谢谢你提供的TFlatButton.
搞定后,别忘了把心得写上来,一起分享。
 
你问的问题也是我想知道的。 呵呵。
 
能不能分析分析 我要上网去 / GoSurf 这类用Delphi做的软件呢?
 
老王,我还以为你会知道呢!:(
 
这有一篇文章也许对你有用
http://www.codelphi.com/channel/jsjn/read.asp?ano=699
 
Saving raw HTML source from TWebBrowser to disk
Obtaining complete HTML source from WebBrowser.Document
Product:
Delphi 3.x (or higher) Category:
Internet / Web Skill Level:
Scoring:
Last Update:
02/24/2001
Search Keys:
delphi delphi3000 article WebBrowser IPersistStreamInit IStreamAdapter Times Scored:
11 Visits:
3176
Uploader: Hans Gul&amp;ouml;
Company: Reference: N/A
Component Download: ../article/1909/HTMLSrcToFile.zip

Question/Problem/Abstract:

How to save raw HTML source from TWebBrowser.Document to disk.
Answer:


TWebBrowser.Document implements IPersistStreamInit which exposes Save() method. All you need to know is how to use this method along with given object which implements IStream. We could simply use TStreamAdapter for this purpose.

Note that IPersistStreamInit and IStream interfaces are declared inside ActiveX unit.

Here's how to do it.

procedure TForm1.SaveHTMLSourceToFile(const FileName: string;
WB: TWebBrowser);
var
PersistStream: IPersistStreamInit;
FileStream: TFileStream;
Stream: IStream;
SaveResult: HRESULT;
begin
PersistStream := WB.Document as IPersistStreamInit;
FileStream := TFileStream.Create(FileName, fmCreate);
try
Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
SaveResult := PersistStream.Save(Stream, True);
if FAILED(SaveResult) then
MessageBox(Handle, 'Fail to save HTML source', 'Error', 0);
finally
{ we are passing soReference in TStreamAdapter constructor,
it is our responsibility to destroy the TFileStream object. }
FileStream.Free;
end;
end;

pocedure TForm1.Button1Click(Sender: TObject);
begin
if SaveDialog1.Execute then
SaveHTMLSourceToFile(SaveDialog1.FileName, WebBrowser1);
end;

Please visit
IE FAQ site http://members.home.net/hfournier/
IE &amp; Delphi site http://www.euromind.com/iedelphi/

 
似乎只能保存网页源代码(IE4以前的版本),不能像IE那样保存图片。
能否查找当前网页中<img之类的字符,将URL记录下来再下载,并保存在与网页同名的目录中:
sample.html/1.jpg
 
找当然可以找到但是你如果去下载?
你给我的代码我一运行就要出问题?
SaveResult := PersistStream.Save(Stream, True);
就是这句
 
老老实实的来听课
 
有没有在uses中加入activex?
 
无意中看到这样一个说法:

来自:fyang, 时间:2001-8-10 14:29:00, ID:595650
用TWebbrowse控件浏览该页,利用TWebBrowser.ExecWB的OLECMDID_SAVEAS就可以了

不妨试一试 :)
 
谢谢TOWN
我现在也有一个做法过两天贴出来
在此,谢谢XIAO_WEN
 
呵,我还想提前一下,如何取网页中的所有网址,希望大家能够提出一个好的方案!
在此先谢谢了,提出好方案者重赏:)

 
关于把网页,以及与网页相关的都保存到硬盘中!
这个答案如下:例子的效果把www.sina.com.cn的网页保存下来!:)
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,nmhttp,urlmon,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Memo2: TMemo;
Splitter1: TSplitter;
procedure Button1Click(Sender: TObject);
private
procedure savedata(url,memo:string);
function dealwith(url,baseurl:string):string; //处理网页路径
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.savedata(url,memo:string);
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;

function getfilename(s:string):string;
var i:integer;
begin
for i:=length(s) downto 1 do
begin
if (s='/')or(s='/') then
break;
end;
result:=copy(s,i+1,length(s)-i);
end;

var i:integer;
imagelist:tstringlist;
bmplist:tstringlist;
tempmemo:string;
beginpos,endpos:integer;
path:string;
s:string;
memorystream:tmemorystream;
begin

bmplist:=tstringlist.Create ;
bmplist.Add('.bmp');
bmplist.Add('.jpg');
bmplist.Add('.swf');
bmplist.Add('.gif');

path:='d:/download/';
tempmemo:=memo;
imagelist:=tstringlist.create;
try
while pos('src=',memo)>0 do
begin
beginpos:=pos('src=',memo)+4;
while (memo[beginpos]=' ') or (memo[beginpos]='"') do
begin
inc(beginpos);
end;
endpos:=beginpos+1;
while (memo[endpos]<>' ') and (memo[endpos]<>'"')and (memo[endpos]<>'>')do
begin
inc(endpos);
end;
// s:=copy(memo,beginpos,endpos-beginpos);
s:=dealwith(copy(memo,beginpos,endpos-beginpos),'www.sina.com.cn');
// showmessage(s);
if (imagelist.indexof(s)=-1)or(imagelist=nil) then
begin
imagelist.Add(s);
DownloadFile(s,'d:/download/'+getfilename(s));
end;
delete(memo,1,endpos);
end;
except
showmessage(inttostr(beginpos)+','+inttostr(endpos));
end;
showmessage(inttostr(imagelist.count));
for i :=0 to imagelist.count-1 do
begin
memo1.text:=stringreplace(memo1.text,imagelist.strings,getfilename(imagelist.strings),[rfReplaceAll]);
end;

memorystream:=tmemorystream.Create ;
memorystream.Position :=0;
imagelist.Free;
bmplist.Free ;
memorystream.Free ;
memo1.Lines.SaveToFile('d:/download/index.htm');
showmessage('ok');
end;


procedure TForm1.Button1Click(Sender: TObject);
var s:string;
nmhttp:tnmhttp;
begin
//建立nmhttp
nmhttp:=tnmhttp.Create(nil);
NMHTTP.InputFileMode := FALSE;
NMHTTP.OutputFileMode := FALSE;
// NMHTTP.ReportLevel := Status_Basic;
try
nmhttp.Get('www.sina.com.cn');
s:=nmhttp.body;
except
end;
memo1.text:=s;

savedata('sss',s);

end;

function Tform1.dealwith(url,baseurl:string):string; //处理网页路径
var i:integer;
beginpos:integer;
begin
URL:=stringreplace(url,'"','',[rfReplaceAll]);
if url[1]+url[2]+url[3]+url[4]+url[5]+url[6]+url[7]='http://' then
dealwith:=url;

URL:=stringreplace(url,'/','/',[rfReplaceAll]);

if pos(' ',url)<>0 then
begin
url:=copy(url,1, pos(' ',url)-1);
end;

for i:=length(baseurl) downto 1 do
begin
if baseurl='/' then
BEGIN
break;
END;
end;

IF I<>1 THEN
baseurl:=copy(baseurl,1,i)
ELSE
BASEURL:=BASEURL+'/';

if ((pos('.',url)<>0)and(pos('./',url)=0)and(url[1]<>'/')) or (pos('www.',url)<>0) then
dealwith:=url;

if (pos('../',url)=0)AND (POS('./',URL)=0) then //没有指定目录//??要改改
begin
if url[1]='/' then
url:=copy(url,2,length(url)-1);
dealwith:=baseurl+url;
end
else
begin
i:=length(baseurl)-1;
while pos('../',url)<>0 do
begin
beginpos:=pos('../',url);
delete(url,1,beginpos+2);
while i>=1 do
begin
if baseurl='/' then
begin
dec(i);
break;
end;
dec(i);
end;
end;
dealwith:=copy(baseurl,1,i)+'/'+url;
end;
dealwith:=url;
end;

end.
 
1分不出,还学了一手,爽.
谢谢天真老弟了.
 
,如何取网页中的所有网址,希望大家能够提出一个好的方案!
在此先谢谢了,提出好方案者重赏:)
大家帮帮我!:《
 
翻箱倒柜翻出这样一段代码,也许有用 :)
.......
public
IEThis:IWebbrowser2;
......
procedure TForm1.Button1Click(Sender: TObject);
var
doc:IHTMLDocument2;
all:IHTMLElementCollection;
len,i,flag:integer;
item:IHTMLElement;
vAttri:Variant;
begin
if Assigned(IEThis)then begin
ComboBox1.Clear;
//获得Webbrowser对象中的文档对象
doc:=IEThis.Document as IHTMLDocument2;
//获得文档中所有的HTML元素集合
all:=doc.Get_all;
len:=all.Get_length;
//访问HTML元素集合中的每一个元素
for i:=0 to len-1 do begin
item:=all.item(i,varempty) as IHTMLElement;
//如果该元素是一个链接
if item.Get_tagName = 'A'then begin
flag:=0;
vAttri:=item.getAttribute('protocol',flag); //获得链接属性
//如果是mailto链接则将链接的目标地址添加到ComboBox1
if vAttri = 'mailto:'then begin
vAttri:=item.getAttribute('href',flag);
ComboBox1.Items.Add(vAttri);
end;
end;
end;
end;
end;
 

Similar threads

回复
0
查看
846
不得闲
D
回复
0
查看
1K
DelphiTeacher的专栏
D
D
回复
0
查看
800
DelphiTeacher的专栏
D
后退
顶部