有关Webbrowser的保存(100分)

  • 主题发起人 主题发起人 mzgmzg
  • 开始时间 开始时间
M

mzgmzg

Unregistered / Unconfirmed
GUEST, unregistred user!
Webbrowser中保存文件可用
ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DODEFAULT,EmptyParam,EmptyParam);
来实现,他将打开一个保存对话框。
能不能在程序中给出文件名后直接保存,而不显示保存对话框?
 
有谁关注?!
 
很简单,使用WebCopy控件就可以解决。
 
用ExecWB(OLECMDID_SAVEAS,OLECMDEXECOPT_DONTPROMPTUSER,EmptyParam,EmptyParam);试试
 
wangxd:试过了,还是要出保存对话框。
 
你可以使用urlmon单元的方法: urldownloadtofile 就可以解决你的问题了!
先定义一个函数:
function DownloadFile(Source, Dest: string): Boolean;
begin
try
Result:=UrlDownloadToFile(nil, PChar(source), PChar(Dest), 0, nil) = 0;
except
Result:=False;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if DownloadFile ('http://www.sina.com.cn/index.htm 'c:/Temp/index.htm') then
ShowMessage('Download succesful')
else
ShowMessage('Download unsuccesful')
end;
 
得到源代码,然后保存,你看怎么样?
 
怎么得到原代码呢,能给段程序么
 
mm.Lines.Add(IHtmlDocument2(downwb.Document).Body.OuterHtml);
//mm.Lines.Add(IHtmlDocument2(downwb.Document).Body.OuterText);
mm.Lines.SaveToFile("filename");


mm是一个memo控件
 
// 说明:打开对话框后直接保存对应的txt文件,滤除html代码非常有用,但对多个文件时发生错误,若需要修改后Email一份给您.
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
clipbrd, StdCtrls, ComCtrls, OleCtrls, SHDocVw, ExtCtrls,FileCtrl;
type
THTMToTxt_Frm = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
Splitter1: TSplitter;
Panel3: TPanel;
WebBrowser1: TWebBrowser;
Splitter2: TSplitter;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
OpenDialog1: TOpenDialog;
Memo1: TMemo;
Panel4: TPanel;
ProgressBar1: TProgressBar;
Button4: TButton;
procedure MakeTree;
Procedure HtmProcess(TempFname:string);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
private
{ Private declarations }
public
{ Public declarations }
end;

var
HTMToTxt_Frm: THTMToTxt_Frm;
Fname:string;
GFname:string;
implementation

{$R *.DFM}
//----------maketree ---------
procedure THTMToTxt_Frm.MakeTree;
var Sr : TSearchRec;
Err : integer;
//SFname:string;
//LenFname:integer;
Begin
Err:=FindFirst('*.htm',$37,Sr) ;
While (Err = 0) do
begin
if Sr.Name[1]<>'.' then
begin
if (Sr.Attr and faDirectory)=0 then
begin
GFName:='';
GFName:=ExpandFileName(sr.Name);
HtmProcess(GFName);

{ SFname:=GFname;
LenFname:=Length(GFname);
Delete(SFname,LenFname-2,3);
SFname:=SFname+'txt';
WebBrowser1.Navigate(GFname);
Memo1.Clear;
ClipBoard.Clear;
WebBrowser1.ExecWB(17,2);
WebBrowser1.ExecWB(12,2);
Memo1.PasteFromClipboard;
Memo1.Lines.SaveToFile(SFname);
}
end;
end;

{ Begin Recursion }
If ((Sr.Attr and faDirectory)<>0)AND(Sr.Name[1] <> '.') then
begin
ChDir(Sr.Name) ;
MakeTree ;
ChDir('..') ;
end ;
Err:=FindNext(Sr) ;
end ;
End;
//--end maketree -------------

//---start htm proess
procedure THTMToTxt_Frm.HtmProcess(TempFname:string);
var
CurrentFile:string;
begin
CurrentFile:=TempFname;
WebBrowser1.Navigate(CurrentFile);
end;
//---end htm proess
procedure THTMToTxt_Frm.Button1Click(Sender: TObject);
var
HtmlDir:String;
begin
GetDir(0,HtmlDir);
OpenDialog1.InitialDir:=HtmlDir+'/html';
OpenDialog1.Execute;
Fname:=Opendialog1.FileName;
WebBrowser1.Navigate(Fname);
Edit1.text:=Fname;
end;



procedure THTMToTxt_Frm.Button4Click(Sender: TObject);
var
GDir:string;
begin
SelectDirectory('请选择需要转换为TXT文件的目录','',GDir);
ChDir(GDir);
MakeTree;
end;

procedure THTMToTxt_Frm.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
SFName:string;
LenFname:integer;
begin
SFname:=Fname;
LenFname:=Length(Fname);
Delete(SFname,LenFname-2,3);
SFname:=SFname+'txt';
Memo1.Clear;
ClipBoard.Clear;
WebBrowser1.ExecWB(17,2);
WebBrowser1.ExecWB(12,2);
Memo1.PasteFromClipboard; //error prompt:'试图激活未注册的丢弃目标'
Memo1.Lines.SaveToFile(SFname);
end;
end.
 
怎样才能连图片以及其他的东西一块保存,例如大富翁的网页保存后就
需要格式表才能正确显示
 
这也简单,激活word,将文件贴入word,然后保存。
 
to kunmeng:
我照你写的程序运行了一遍,出错而且根本就没保存下来,请与我联系。
 
后退
顶部