在Delhpi中，巧用WebBrowser 和Excel摘取网站内容（数据库）

最新推荐文章于 2021-06-19 01:04:04 发布
最新推荐文章于 2021-06-19 01:04:04 发布
阅读量1.7k 收藏 1
点赞数
分类专栏： Win32/Delphi学习笔记与开发技巧 文章标签： webbrowser excel 数据库 stream string integer
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/hui717/article/details/1854422
版权

      有时候我们在浏览网站的时候， 经常会看到一些重要的数据，想把它全部保存下来，但又没有什么好的工具可以实现。其实我们自己动手，开发一个有针对型的小工具，是很容易的。

     现在就以http://219.142.101.91/jzqy/ 网站为例，

可以看出，该系统共有6527条记录，我们要全部下载下来。

[实现思路]：用WebBrowser打开该网页，然后一条一条地复制数据。然后在用WebBrowser自动浏览下一页，直至全部复制完为止。

[具要实现方法]：

1、初始化工作

procedure TForm1.Button1Click(Sender: TObject);
begin
  ProgressBar1.Max: =  SumCount;
  ProgressBar1.Min: =  Count;

  httpaddress1: = Edit1.Text;
  httpaddress2: = Edit2.Text;
  Count: = StrToIntDef(Edit3.Text, 1 );
  SumCount: = StrToIntDef(Edit4.Text, 1 );

  httpaddress: = httpaddress1 + inttostr(Count) + httpaddress2;
  WebBrowser1.Navigate(httpaddress);
end;

  数理数据，先把整个网页复制下来，把整个网页全部复制在Excel中，然后在Excel中去掉不需要的东西，再从Excel中提取需要的数据，并保存进自己的数据库中。

 

function GetHtml( const  WebBrowser:TWebBrowser):  string ;
 const
  BufSize  =  $ 10000 ;
var
  Size: Int64;
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
   if  not Assigned(WebBrowser.Document) then Exit;
  OleCheck(WebBrowser.Document.QueryInterface(IPersistStreamInit, psi));
   try
    hHTMLText : =  GlobalAlloc(GPTR, BufSize);
     if   0   =  hHTMLText then Exit; //  RaiseLastWin32Error;
    OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream));
     try
      OleCheck(psi.Save(Stream, False));
      Size : =  StrLen(PChar(hHTMLText));
      SetLength(Result, Size);
      CopyMemory(PChar(Result), Pointer(hHTMLText), Size);
     finally
      Stream : =  nil;
    end;
   finally
    psi : =  nil;
  end;
end;

procedure TForm1.OutExcel( const  WebBrowser:TWebBrowser);  // 导出为excel
const
   // 行列的分别起止
  rc  =   3 ;
  rs  =   12 ;
  cc  =   1 ;
  cs  =   7 ;
  str = ' EXCEL.EXE ' ;
var
  Excelid      :variant;
  ri,ci        :Integer;   // 当前行和当前列
  abc          :array[cc..cs] of  string ;
  sqlstr       :String;
  H            :THandle;
  P            :DWORD;
begin
   try
    Excelid: = CreateOleObject(  ' Excel.Application '  );
  except
    on Exception  do  raise exception.Create( ' 无法创建Xls文件，请确认是否安装EXCEL ' )
  end;
  Excelid.Visible : =  False;
  Excelid.WorkBooks.Add;
  WebBrowser.ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);
  WebBrowser.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);  // 复制网页
  Excelid.worksheets[ 1 ].Paste;  // excel文档粘贴
  WebBrowser.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT);  // 取消全选

   // Excel文件操作
  Excelid.Range[Excelid.cells[ 1 , 1 ],Excelid.cells[ 100 , 20 ]].select;
  Excelid.selection.MergeCells   : =    False;   // 取消合并
  ri: = 4 ;
  ci: = 0 ;
   while  ri  <   100   do
  begin
     if  ci  >   70  then Break;
     if  Trim(AnsiReplaceText(Excelid.Cells[ri, 1 ].Value, ' ? ' , '' ))  =   ''  then
    begin
      Excelid.ActiveSheet.Rows[ri].Delete;   // 删除行
      inc(ci);
    end  else
    begin
      Inc(ri);
    end;
  end;
  ri: = 2 ;
  ci: = 0 ;
   while  ri  <   20   do
  begin
     if  ci  >   20  then Break;
     if  Trim(AnsiReplaceText(Excelid.Cells[ 2 ,ri].Value, ' ? ' , '' ))  =   ''  then
    begin
      Excelid.ActiveSheet.Columns[ri].Delete;   // 删除行
      inc(ci);
    end  else  Inc(ri);
  end;

   for  ri: =  rc to rs  do
  begin
     for  ci: = cc to cs  do
    begin
      abc[ci]: =  Trim(AnsiReplaceText(Excelid.Cells[ri,ci].Value, ' ? ' , '' ));
    end;
    sqlstr: = ' Insert Into 建筑业企业资质数据库(序号,企业名称, ' +
              ' 资质证书编号,主项资质,增项资质,原发证日期,主管部门 ' +
              ' ) Values ( ' + QuotedStr(abc[ 1 ]) + ' , ' + QuotedStr(abc[ 2 ]) +
              ' , ' + QuotedStr(abc[ 3 ]) + ' , ' + QuotedStr(abc[ 4 ]) + ' , '
              + QuotedStr(abc[ 5 ]) + ' , ' + QuotedStr(abc[ 6 ]) + ' , '
              + QuotedStr(abc[ 7 ]) + ' ) ' ;
 //     ShowMessage(sqlstr);
     if  not od.SetExecSql(sqlstr) then
    begin
       od.SetExecSql( ' Insert into 日志表(日志) values ( '
                   + QuotedStr( ' 系统在取第 ' + inttostr(Count) + ' 页，第 ' + abc[ 1 ] + ' 行时遇到错误！ ' ) + ' ) ' );
       Break;
      //   ShowMessage('第'+inttostr(Count)+'页。第'+abc[1]+'行');
    end;
    ProgressBar1.StepIt;
  end;

  Excelid.ActiveWorkBook.Saved : =  True;
  Excelid.WorkBooks.Close;
  Excelid.quit;

  // 杀死进程
  H: = FindWindow(nil,pchar(Str));
   if  H <> 0  then
  begin
    GetWindowThreadProcessId(H,@P); 
     if  P <> 0  then 
      TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF); 
  end;
end;

 

当一页处理完毕后，自动处理下一页

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
   const  pDisp: IDispatch; var URL: OleVariant);
begin
  Label6.Caption: = IntToStr(count);
   if  Count  <  SumCount then
  begin
   //   htmlstr:= GetHtml(WebBrowser1);   // 取得HTML源代码
    OutExcel(WebBrowser1);
    Inc(Count);
    httpaddress: = httpaddress1 + inttostr(Count) + httpaddress2;
    WebBrowser1.Navigate(httpaddress);
  end;
end;

 

全部源代码如下：

 

unit Unit1;

 interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ExtCtrls,MSHTML, ActiveX,comobj,
  StrUtils, DB, ADODB,UOperationData, ComCtrls;

type
  TForm1  =   class (TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Label3: TLabel;
    Edit4: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    ADOConnection1: TADOConnection;
    ProgressBar1: TProgressBar;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
       const  pDisp: IDispatch; var URL: OleVariant);
    procedure FormShow(Sender: TObject);
   private
    procedure OutExcel( const  WebBrowser:TWebBrowser);  // 导出为excel
     { Private declarations }
   public
     { Public declarations }
  end;

var
  Form1       : TForm1;

  httpaddress1 : string ;
  httpaddress2 :String;
  SumCount     :Integer;
  Count        : Integer;    // 次数
  M_Bool       : Boolean;    // 鼠标模拟是否有效
  httpaddress  : String;
  od           :TOperationData;

implementation

 {$R *.dfm}
function GetHtml( const  WebBrowser:TWebBrowser):  string ;
 const
  BufSize  =  $ 10000 ;
var
  Size: Int64;
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
   if  not Assigned(WebBrowser.Document) then Exit;
  OleCheck(WebBrowser.Document.QueryInterface(IPersistStreamInit, psi));
   try
    hHTMLText : =  GlobalAlloc(GPTR, BufSize);
     if   0   =  hHTMLText then Exit; //  RaiseLastWin32Error;
    OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream));
     try
      OleCheck(psi.Save(Stream, False));
      Size : =  StrLen(PChar(hHTMLText));
      SetLength(Result, Size);
      CopyMemory(PChar(Result), Pointer(hHTMLText), Size);
     finally
      Stream : =  nil;
    end;
   finally
    psi : =  nil;
  end;
end;

procedure TForm1.OutExcel( const  WebBrowser:TWebBrowser);  // 导出为excel
const
   // 行列的分别起止
  rc  =   3 ;
  rs  =   12 ;
  cc  =   1 ;
  cs  =   7 ;
  str = ' EXCEL.EXE ' ;
var
  Excelid      :variant;
  ri,ci        :Integer;   // 当前行和当前列
  abc          :array[cc..cs] of  string ;
  sqlstr       :String;
  H            :THandle;
  P            :DWORD;
begin
   try
    Excelid: = CreateOleObject(  ' Excel.Application '  );
  except
    on Exception  do  raise exception.Create( ' 无法创建Xls文件，请确认是否安装EXCEL ' )
  end;
  Excelid.Visible : =  False;
  Excelid.WorkBooks.Add;
  WebBrowser.ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);
  WebBrowser.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT);  // 复制网页
  Excelid.worksheets[ 1 ].Paste;  // excel文档粘贴
  WebBrowser.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT);  // 取消全选

   // Excel文件操作
  Excelid.Range[Excelid.cells[ 1 , 1 ],Excelid.cells[ 100 , 20 ]].select;
  Excelid.selection.MergeCells   : =    False;   // 取消合并
  ri: = 4 ;
  ci: = 0 ;
   while  ri  <   100   do
  begin
     if  ci  >   70  then Break;
     if  Trim(AnsiReplaceText(Excelid.Cells[ri, 1 ].Value, ' ? ' , '' ))  =   ''  then
    begin
      Excelid.ActiveSheet.Rows[ri].Delete;   // 删除行
      inc(ci);
    end  else
    begin
      Inc(ri);
    end;
  end;
  ri: = 2 ;
  ci: = 0 ;
   while  ri  <   20   do
  begin
     if  ci  >   20  then Break;
     if  Trim(AnsiReplaceText(Excelid.Cells[ 2 ,ri].Value, ' ? ' , '' ))  =   ''  then
    begin
      Excelid.ActiveSheet.Columns[ri].Delete;   // 删除行
      inc(ci);
    end  else  Inc(ri);
  end;

   for  ri: =  rc to rs  do
  begin
     for  ci: = cc to cs  do
    begin
      abc[ci]: =  Trim(AnsiReplaceText(Excelid.Cells[ri,ci].Value, ' ? ' , '' ));
    end;
    sqlstr: = ' Insert Into 建筑业企业资质数据库(序号,企业名称, ' +
              ' 资质证书编号,主项资质,增项资质,原发证日期,主管部门 ' +
              ' ) Values ( ' + QuotedStr(abc[ 1 ]) + ' , ' + QuotedStr(abc[ 2 ]) +
              ' , ' + QuotedStr(abc[ 3 ]) + ' , ' + QuotedStr(abc[ 4 ]) + ' , '
              + QuotedStr(abc[ 5 ]) + ' , ' + QuotedStr(abc[ 6 ]) + ' , '
              + QuotedStr(abc[ 7 ]) + ' ) ' ;
 //     ShowMessage(sqlstr);
     if  not od.SetExecSql(sqlstr) then
    begin
       od.SetExecSql( ' Insert into 日志表(日志) values ( '
                   + QuotedStr( ' 系统在取第 ' + inttostr(Count) + ' 页，第 ' + abc[ 1 ] + ' 行时遇到错误！ ' ) + ' ) ' );
       Break;
      //   ShowMessage('第'+inttostr(Count)+'页。第'+abc[1]+'行');
    end;
    ProgressBar1.StepIt;
  end;

  Excelid.ActiveWorkBook.Saved : =  True;
  Excelid.WorkBooks.Close;
  Excelid.quit;

  // 杀死进程
  H: = FindWindow(nil,pchar(Str));
   if  H <> 0  then
  begin
    GetWindowThreadProcessId(H,@P); 
     if  P <> 0  then 
      TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF); 
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ProgressBar1.Max: =  SumCount;
  ProgressBar1.Min: =  Count;

  httpaddress1: = Edit1.Text;
  httpaddress2: = Edit2.Text;
  Count: = StrToIntDef(Edit3.Text, 1 );
  SumCount: = StrToIntDef(Edit4.Text, 1 );

  httpaddress: = httpaddress1 + inttostr(Count) + httpaddress2;
  WebBrowser1.Navigate(httpaddress);
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
   const  pDisp: IDispatch; var URL: OleVariant);
begin
  Label6.Caption: = IntToStr(count);
   if  Count  <  SumCount then
  begin
   //   htmlstr:= GetHtml(WebBrowser1);   // 取得HTML源代码
    OutExcel(WebBrowser1);
    Inc(Count);
    httpaddress: = httpaddress1 + inttostr(Count) + httpaddress2;
    WebBrowser1.Navigate(httpaddress);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  od: =  TOperationData.Create(ADOConnection1);
end;

initialization
    OleInitialize(nil);
  finalization
   try
    OleUninitialize;
  except
  end;

end.
hui717
关注
  • 0
    点赞
  • 踩
  • 1
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
专栏目录
delphi 使用webbrowser取得网页中表格（Table）内容的正确方法
t1122的专栏
10-14 5386
今天偶然需要取得网页中表格的内容，找了好久竟然都找不到，盒子中也没有，大富翁上也没有找到。 想了半天，貌似03年的某个资料上有，翻到了赶紧记下来，一个泛类型的简单应用。 csdn上面只有问的，没有答对的。 我把资料中的错误改正确了写在这里，需要的朋友可以查，利人利己。 需要注意的是：目前这是我发现的唯一正确的方法，如果有朋友知道，请补充一下。 procedure TForm1.btn1C
delphi使用webbrowser取得网页中无序列表（ul）内容的正确方法
t1122的专栏
10-14 4231
怎么没有人发表这些东西啊真郁闷今天，继续昨天的话题。例如：111111111111112222222222222233333333333333344444444444444读取无序列表的内容，没找到资料。上一篇《使用webbrowser取得网页中表格（table）内容的正确方法 》不完全，参考java的写法，改了一段。有序表格和无序表格还真不一样，呵呵。 //这一部分是取得“无序列表”的部分 ovTable:=Webbrowser1.OleObject.Document.getElement
delphi WebBrowser获取iframe页面内容及操作
weixin_30845171的博客
09-26 378
uses MSHTML, ActiveX;function GetFrame(FrameNo:Integer):IWebbrowser2;varOleContainer:IOleContainer;enum:IEnumUnknown;unk:IUnknown;Fetched:PLongint;beginwhile Form1.wb1.ReadyState <> READYSTATE...
delphi获得webbrowser中的html文本
wh445306
12-15 1047
procedure TForm1.Button1Click(Sender: TObject); begin WebBrowser1.Navigate(Edit1.Text); end; procedure TForm1.Button2Click(Sender: TObject); var doc:olevariant; str:string; begin doc:=We...
Delphi常见错误中英文对照
justin_hua的专栏
08-09 1242
******************************* * 编 译 错 误 信 息 * ******************************* ; not allowed before ELSE ElSE前不允许有“;” clause not allowed in OLE automation section 在OLE自动区段不允许“”子句 is not a t
在delhpi程序中获取网络资源信息
07-18
在实际应用中，例如需要在MIDAS多层应用程序中选择上层应用程序所在的服务器名称、在打印模块中选择可用的网络打印机、或者是在应用程序中选择其他机器上的共享文件等场景，都需要能够准确地获取相关的网络资源信息...
Delhpi 数据库设计思想与实践
06-22
有一句话在程序员中广为流行——“聪明的 程序员学 Delphi”。纵观 Delphi的发展历程,可见其处处闪烁着计算机技术最新成果的光 芒 新推出的 Delphi6不仅保持了原有版本的全部优点和兼容性,而且还首次推出了旨在 支持...
基于Delhpi平台的数据库程序设计研究 (2011年)
05-30
数据库技术是当今信息社会的重要基础技术之一，在众多的数据库开发工具当中，Delphi尤为突出，它适应于多种数据库结构，具有高效率的数据库管理系统和最新的数据分析手段并且提供大量的企业组件。介绍了基于Delphi...
001_《Delhpi6数据库设计思想与实践》(2/2)
11-17
说明：共两个压缩包。 本书是使用Delphi作为数据库应用程序的软件开发工具的专题介绍，基本涵盖了...本书的实例遵循软件工程中的软件系统的开发方法和步骤进行设计，使得读者对数据库应用系统的开发有更深刻的了解。
001_《Delhpi6数据库设计思想与实践》(1/2)
11-17
说明：共两个压缩包。 本书是使用Delphi作为数据库应用程序的软件开发工具的专题介绍，基本涵盖了...本书的实例遵循软件工程中的软件系统的开发方法和步骤进行设计，使得读者对数据库应用系统的开发有更深刻的了解。
vb,Webbrowser1获取网页源码
03-25
Webbrowser1获取网页源码,实例
delphi中Try...Except 语句和Try...Finally 语句
找个地方放一下
09-14 1504
在Try...Except 语句中可以进行抛出异常和处理异常的工作。Try...Except 的一般形式如下：  try Statements1; except on Exception1 do HandleStatements1; on Exception
Delphi Webbrowser使用方法详解（二）
xtfnpgy
11-01 9407
delphi如何用webbrowser模拟登录网站？   我们就以如何登录博客园来做示例：   1.要登入一个网站，首先要获取网页的源代码，我们可以通过网页菜单--查看--查看源代码来获取。 2.我们找到登录部分的代码：                         登录到博客园  立即注册                         用户名          
delphi html table,delphi 使用webbrowser取得网页中表格（Table）内容的正确方法
weixin_32789583的博客
06-19 431
今天偶然需要取得网页中表格的内容，找了好久竟然都找不到，盒子中也没有，大富翁上也没有找到。想了半天，貌似03年的某个资料上有，翻到了赶紧记下来，一个泛类型的简单应用。csdn上面只有问的，没有答对的。我把资料中的错误改正确了写在这里，需要的朋友可以查，利人利己。需要注意的是：目前这是我发现的唯一正确的方法，如果有朋友知道，请补充一下。procedure TForm1.btn1Click(Sende...
c#.net使用webBrowser1获取网站信息源码
11-23 1893
         private void button1_Click(object sender, EventArgs e)         {             string url = @"http://www.***.com/Login.aspx";             webBrowser1.Navigate(url);             while (we
delhpi TADOQuery和 TADOConnection组件进行数据关联
最新发布
07-13
在 Delphi 中，您可以使用 TADOQuery 和 TADOConnection 组件进行数据关联，以实现数据库的连接和查询操作。以下是一个简单的示例： 1. 在窗体上放置 TADOConnection 和 TADOQuery 组件，并设置相关属性。 2. 在...
评论 1
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值