剖析一个DELPHI写的网页图象分析与获取程序

大家都想对一些网页进行特别的自动化处理。人手干预，太浪费时间。这个程序就是用于对网页中的某些图片特别。

unit MainForm;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, Buttons, ComCtrls, ToolWin, Menus, OleCtrls, //NMHTML,
SHDocVw, Psock, NMHttp,jpeg;

type
TWebForm = class(TForm)
MainMenu1: TMainMenu;
fILE1: TMenuItem;
New1: TMenuItem;
Open1: TMenuItem;
Save1: TMenuItem;
close1: TMenuItem;
Edit1: TMenuItem;
View1: TMenuItem;
DocumentSource1: TMenuItem;
StatusBar1: TStatusBar;
//HTML1: THTML;
Splitter1: TSplitter;
Panel2: TPanel;
NMHTTP1: TNMHTTP;
Panel1: TPanel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Panel5: TPanel;
Panel6: TPanel;
Memo2: TMemo;
Memo1: TMemo;
Memo3: TMemo;
Memo4: TMemo;
TabSheet3: TTabSheet;
HTMLPreviewWebBrowser: TWebBrowser;
CoolBar1: TCoolBar;
ToolBar1: TToolBar;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Url2: TComboBox;
SpeedButton3: TSpeedButton;
SpeedButton6: TSpeedButton;
URLButtonsPanel: TPanel;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
HtmlViewWebBrowser: TWebBrowser;
Panel7: TPanel;
Panel8: TPanel;
URLEdit: TEdit;
GetFileSpeedButton: TSpeedButton;
SpeedButton11: TSpeedButton;
SpeedButton12: TSpeedButton;
PageControl2: TPageControl;
URLsTabSheet: TTabSheet;
Panel3: TPanel;
LinkURLListBox: TListBox;
Panel4: TPanel;
FileLinkListBox: TListBox;
HistoryTabSheet: TTabSheet;
HistoryMemo: TMemo;
FileNMHTTP: TNMHTTP;
ImageTabSheet: TTabSheet;
ScrollBox1: TScrollBox;
AfterGetImage: TImage;
SpeedButton10: TSpeedButton;
SpeedButton13: TSpeedButton;
procedure Splitter1Moved(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure Url2Enter(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure NMHTTP1Success(Cmd: CmdType);
procedure SpeedButton6Click(Sender: TObject);
procedure LinkURLListBoxClick(Sender: TObject);
procedure FileLinkListBoxClick(Sender: TObject);
procedure GetFileSpeedButtonClick(Sender: TObject);
procedure FileNMHTTPSuccess(Cmd: CmdType);
procedure SpeedButton10Click(Sender: TObject);
procedure SpeedButton13Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
WebForm: TWebForm;

function GetURLof(kind : integer; HtmlSource : string; urlpath : string) : Tstrings;

implementation

{$R *.DFM}

procedure TWebForm.Splitter1Moved(Sender: TObject);
begin
Panel2.Left := Splitter1.Left +Splitter1.Width;//处理显示区域
end;

procedure TWebForm.SpeedButton2Click(Sender: TObject);
begin
if url2.Items.IndexOf(URL2.text) = -1 then url2.Items.Add(url2.text);//设置当前URL，并且获取当前网页的原代码（HTML代码）

// HTMLPreviewWebBrowser.Navigate (url2.text);//浏览网页
// statusbar1.Panels[0].text := html2.RequestURL;//增加网页到列表中

end;

procedure TWebForm.Url2Enter(Sender: TObject);
begin
//if key = vk_return then
SpeedButton2Click(sender);//响应回车建
end;

procedure TWebForm.SpeedButton3Click(Sender: TObject);
begin
Memo2.Clear;
Memo2.Text := 'Loading...';//显示进度信息
//
NMHTTP1.Get(url2.text);//获得网页HTML代码

FileLinkListBox.Items := GetURLof(1,memo2.text,url2.text);
LinkURLListBox.Items := GetURLof(2,memo2.text,url2.text);

end;

procedure TWebForm.NMHTTP1Success(Cmd: CmdType);
begin
//显示当前网页获取状态
if NMHTTP1.CookieIn <> '' then
Memo4.Text := NMHTTP1.CookieIn;

Case Cmd of
CmdGET:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP GET Successful');//get 操作成功
end;
CmdPOST:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP POST Successful');// post 操作成功
end;
CmdHEAD:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP HEAD Successful');
end;
CmdOPTIONS:
begin

Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP OPTIONS Successful');
end;
CmdTrace:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP TRACE Successful');
end;
CmdPut:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP PUT Successful');
end;
CmdDelete:
begin
Memo1.Text := NMHTTP1.Header;
Memo2.Text := NMHTTP1.Body;
Memo3.Lines.Add('HTTP DELETE Successful');
end;
end;

end;

procedure TWebForm.SpeedButton6Click(Sender: TObject);
begin
// Memo2.Clear;
// Memo2.Text := 'Loading...';

// find out the image
FileLinkListBox.Items := GetURLof(1,memo2.text,url2.text);
LinkURLListBox.Items := GetURLof(2,memo2.text,url2.text);
// FileMemo.text := GetURLof(2,memo2.text,url2.text);

// memo2.Lines.SaveToFile('e:\fathoo\a.html');//保存当网页到'e:\fathoo\a.html'，这将覆盖原来的文件。
// HTMLviewWebBrowser.Navigate('e:\fathoo\a.html');//用于检查结果正确与否

//Memo2.Text := 'OK!';
end;

function GetURLof(kind : integer; HtmlSource : string; urlpath : string) : TStrings;
var
urlstr, htmlstr,Orghtmlstr : string;
idx : integer;
URLs : TStrings;
begin
URLs := TStringList.Create;

htmlstr := HtmlSource;
Orghtmlstr := htmlstr;

// change the html file into lower case, so that can find out the URL easyer.
LowerCase(htmlStr);

idx := 0;
// find out the URL now!
while length(htmlstr) >0 do begin
//find out the href first.
// idx := pos('href',htmlstr);
if kind = 1 then idx := pos('img src',htmlstr);
if kind = 2 then idx := pos('href',htmlstr);

if idx > 1 then begin
delete(htmlstr,1,idx+4);
delete(Orghtmlstr,1,idx+4);

idx := pos('"',htmlstr);
delete(htmlstr,1,idx);
delete(Orghtmlstr,1,idx);

idx := pos('"',htmlstr);
// get the URL from the origenal HTML file.
UrlStr := Copy(OrgHtmlstr,1,idx-1);
if pos('/',Urlstr)< 4 then begin
Urlstr := urlpath+'/'+Urlstr;
end;
// add to the URL list.
URLs.Add(Urlstr);

// delete the URL and the " symbol.
delete(htmlstr,1,idx+1);
delete(Orghtmlstr,1,idx+1);
end else begin
// if not more href, then exit.
result := TStringList.Create;

result.Assign(Urls);
URLs.Free;
exit;
end;

end;

end;

procedure TWebForm.LinkURLListBoxClick(Sender: TObject);
begin
URLEdit.text := LinkURLListBox.Items[LinkURLListBox.ItemIndex];
end;

procedure TWebForm.FileLinkListBoxClick(Sender: TObject);
begin
URLEdit.text := FileLinkListBox.Items[FileLinkListBox.ItemIndex];
end;

procedure TWebForm.GetFileSpeedButtonClick(Sender: TObject);
var
ext : string;
begin
if length(URLEdit.text) < 5 then exit;

ext := copy(URLEdit.text,length(URLEdit.text)-2,3);

FileNMHTTP.Body := 'e:\fathoo\a.'+ext;
FileNMHTTP.InputFileMode := True;
FileNMHTTP.Get(URLEdit.text);
end;

procedure TWebForm.FileNMHTTPSuccess(Cmd: CmdType);
var
jpgimage : TJPEGImage;
begin
// timage
Case Cmd of
CmdGET:
begin
Memo2.Text := NMHTTP1.Body;
end;
end;

jpgimage := TJPEGIMage.Create;
jpgimage.LoadFromFile(FileNMHTTP.Body);//获取JPEG文件

AfterGetImage.Picture.assign(jpgimage);//copy jpeg文件
AfterGetImage.Width := jpgimage.Width;
AfterGetImage.Height := jpgimage.Height;
scrollbox1.HorzScrollBar.Range := jpgimage.Width;
scrollbox1.VertScrollBar.Range := jpgimage.Height;

ImageTabSheet.Visible := true;//显示jpg文件
end;

procedure TWebForm.SpeedButton10Click(Sender: TObject);
begin
if length(url2.text)<10 then exit;

HTMLPreviewWebBrowser.Navigate(url2.text);
end;

procedure TWebForm.SpeedButton13Click(Sender: TObject);
begin
//
FileLinkListBox.Items.SaveToFile('e:\fathoo\SavedURL.txt'); //保存URL清单
end;

end.