自己写个从网页里下载图片的程序

王朝c#·作者佚名  2006-12-17
窄屏简体版  字體: |||超大  

自己写个从网页里下载图片的程序

自己写个从网页里下载图片的程序 当你打开某个网页发现上面有很多好看的图片是会怎么办?一个个点另存为?保存网页再慢慢处理?还是跑到IE缓存目录里慢慢COPY呢?由于我经常会遇到这样的问题,所以自己做了个程序下载网页里的图片,代码写的较烂..高手们别笑话哦。

点键击点另存为下载程序

主窗口单元:

{==========================================}

{=======================================}

{ By Lanyus }

{ QQ:231221 }

{ Email:greathjw [at] 163.com }

{=======================================}

unit UtMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Buttons, IdBaseComponent, IdComponent,

IdTCPConnection, IdTCPClient, IdHTTP, ComCtrls, PsAPI,shellapi,FileCtrl;

type

TFmMain = class(TForm)

BitBtn1: TBitBtn;

LE1: TLabeledEdit;

IdHTTP1: TIdHTTP;

StatusBar1: TStatusBar;

LE2: TLabeledEdit;

SpeedButton1: TSpeedButton;

BitBtn2: TBitBtn;

PageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

Memo1: TMemo;

Memo2: TMemo;

procedure BitBtn1Click(Sender: TObject);

procedure SpeedButton1Click(Sender: TObject);

// procedure BitBtn2Click(Sender: TObject);

private

{ Private declarations }

public

PicCount,DownCount:integer;

ThreadQty:Integer;

DnQty:Integer;

{ Public declarations }

end;

var

FmMain: TFmMain;

implementation

uses UtGetThread;

{$R *.dfm}

procedure TFmMain.BitBtn1Click(Sender: TObject);

var

T:TGetThread;

a:TMemoryStream;

savepath:string;

begin

Le1.Text:=Trim(Le1.Text);

SavePath:=FmMain.LE2.Text;

if SavePath[Length(SavePath)]<>'/' then SavePath:=SavePath+'/';

if not DirectoryExists(SavePath) then

begin

try

if not ForceDirectories(savepath) then

begin

showmessage('保存路径非法');

EXIT;

end;

except

showmessage('保存路径非法');

EXIT;

end;

// showmessage('保存目录不存在');

end;

PicCount:=0;

DownCount:=0;

Memo1.Clear;

T:=TGetThread.Create(False);

end;

procedure TFmMain.SpeedButton1Click(Sender: TObject);

var

dir :string;

begin

if selectDirectory('请选择保存目录','',dir) then le2.Text:=dir;

end;

end.

{====================================}

下载线程单元

{===================================}

{===================================}

{ By Lanyus }

{ QQ:231221 }

{ Email:greathjw [at] 163.com }

{===================================}

unit UtGetThread;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls, Buttons, IdBaseComponent, IdComponent,

IdTCPConnection, IdTCPClient, IdHTTP,wininet;

type

TGetThread = class(TThread)

private

{ Private declarations }

protected

IDP:TIDHTTP;

procedure Execute; override;

procedure GetSRC(SRC:string;S:string);

Function CheckURL(URL:string):string;

end;

// function Q_PosStr(const FindString, SourceString: string; StartPos: Integer): Integer;

implementation

uses UtMain,UtDownThread;

{ Important: Methods and properties of objects in visual components can only be

used in a method called using Synchronize, for example,

Synchronize(UpdateCaption);

and UpdateCaption could look like,

procedure TGetThread.UpdateCaption;

begin

Form1.Caption := 'Updated in a thread';

end; }

{ TGetThread }

Function TGetThread.CheckURL(URL:string):string;

var

HURL,s,s1:string;

i,a,b:integer;

begin

if Url[1]='.' then

begin

s:=copy(FmMain.LE1.Text,8,Length(FmMain.LE1.Text)-7);

i:=pos('/',s);

a:=pos('/',url);

if i>0 then

result:=copy(FmMain.LE1.Text,1,i+7)+copy(url,a+1,Length(url)-a)

else

result:=FmMain.le1.text+'/'+copy(url,a+1,Length(url)-a);

exit;

end;

if Url[1]='/' then

begin

s:=copy(FmMain.LE1.Text,8,Length(FmMain.LE1.Text)-7);

i:=pos('/',s);

while i>0 do

begin

Delete(s,1,i);

i:=pos('/',s);

end;

result:=copy(FmMain.LE1.Text,1,Length(FmMain.LE1.Text)-Length(s))+copy(url,2,Length(url)-1);

exit;

end;

try

HURL:=uppercase(copy(URL,1,4));

if HURL<>'HTTP' then

begin

s:=copy(FmMain.LE1.Text,8,Length(FmMain.LE1.Text)-7);

i:=pos('/',s);

if i>0 then

result:=copy(FmMain.LE1.Text,1,i+7)+url

else

result:=FmMain.le1.text+'/'+url;

end

else

result:=url;

except

result:=url;

end;

end;

procedure TGetThread.GetSRC(SRC:string;S:string);

var

a,b:integer;

PicUrl,UrlType:string;

DownLoad:TDownloadPic;

begin

FmMain.ThreadQty:=0;

a:=pos(SRC,s);

while a>0 do

begin

delete(s,1,a+3);

trimleft(s);

b:=pos('>',s);

if s[1]=''' then

begin

delete(s,1,1);

b:=pos(''',s);

end;

if s[1]='''' then

begin

delete(s,1,1);

b:=pos('''',s);

end;

PicUrl:=copy(s,1,b-1);

PicUrl:=StringReplace(PicUrl,'''','',[RFReplaceAll]);

PicUrl:=trim(StringReplace(PicUrl,''','',[RFReplaceAll]));

PicUrl:=CheckURl(PicURl);

UrlType:=uppercase(StringReplace(copy(picurl,Length(PicUrl)-3,4),'.','',[rfReplaceAll]));

if (pos('GIF',UrlType)>0) or (pos('JPG',UrlType)>0) or (pos('JPEG',UrlType)>0) or

(pos('PNG',UrlType)>0) or (pos('BMP',UrlType)>0) then

begin

inc(FmMain.ThreadQty);

DownLoad:=TDownLoadPic.Create(FmMain.ThreadQty,PicUrl);

FmMain.PicCount:=FmMain.PicCount+1;

FmMain.StatusBar1.Panels[0].Text:='发现 '+IntToStr(FmMain.PicCount)+' 张图片,成功下载 '+IntToStr(FmMain.DownCount)+' 张 ';

Application.ProcessMessages;

end;

a:=pos(SRC,s);

end;

end;

procedure TGetThread.Execute;

var

URL,s:string;

//a,b,i:integer;

PicUrl,UrlType:string;

DownLoad:TDownloadPic;

begin

FreeOnTerminate:=True;

URL:=FmMain.LE1.Text;

FmMain.StatusBar1.Panels[0].Text:='正在读取'+Url;

try

IDP:=TIdHttp.Create(nil);

s:=IDP.Get(URL);

FmMain.Memo2.text:=s;

FmMain.StatusBar1.Panels[0].Text:='读取网页成功';

except

FmMain.StatusBar1.Panels[0].Text:='读取网页失败';

FmMain.Memo2.text:='';

exit;

end;

FmMain.StatusBar1.Panels[0].Text:='正在分析图片地址,请稍候...';

//FmMain.Memo2.Text:=s;

s:=StringReplace(s,'src','SRC',[rfReplaceALL]);

GetSrc('SRC=',s);

// GetSrc('src=',s);

FmMain.StatusBar1.Panels[0].Text:='分析完毕';

idp.Free;

// FmMain.Memo1.Lines.Add(S);

{ Place thread code here }

end;

end.

{========================================}

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航