main.pas

飞库网 电子书下载

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Gauges, StdCtrls, IEHTTP3, PerlRegEx, DB, ADODB, ExtCtrls,
  DBCtrls, Mask, Grids, DBGrids;

type
  TMainForm = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Gauge1: TGauge;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Button1: TButton;
    Edit1_1: TEdit;
    Edit2_1: TEdit;
    Edit3: TEdit;
    Edit4_1: TEdit;
    Button2: TButton;
    Memo1: TMemo;
    Reg: TPerlRegEx;
    Dn: TIEHTTP;
    Rec: TPerlRegEx;
    ADOConnection1: TADOConnection;
    ADOQuery1: TADOQuery;
    DataSource1: TDataSource;
    DBNavigator1: TDBNavigator;
    Edit1: TDBEdit;
    Edit2: TDBEdit;
    Edit4: TDBEdit;
    DBGrid1: TDBGrid;
    ADOQuery1iCode: TIntegerField;
    ADOQuery1title: TWideStringField;
    ADOQuery1listurl: TWideStringField;
    ADOQuery1bootadd: TWideStringField;
    ADOQuery1savedir: TWideStringField;
    Query: TADOQuery;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ADOQuery1AfterInsert(DataSet: TDataSet);
  private
    { Private declarations }
     procedure DownAllFile(ReplaceFlag:Boolean; DList:TStringList);
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.Button1Click(Sender: TObject);
var Flag:Boolean;
    FileName:String;
    DList:TStringList;
begin
 Dn.ExecuteURL(Edit1.Text);
 Reg.Subject :=Dn.result_sl.Text;
 Reg.RegEx :='(href\=")(.+?)('+Edit3.Text+'")';
 Flag:=Reg.Match;
 DList:=TStringList.Create;
 Try
 while Flag do
 begin
  Rec.Subject :=Reg.MatchedExpression;
  Rec.RegEx:='(href\="|'+Edit3.Text+'")';
  Rec.ReplaceAll;
  DList.Add(Rec.Subject);
  Flag :=Reg.MatchAgain;
 end;
  DList.Add('List.');
  FileName :=Edit4.text+'List.'+Edit3.Text;
  if FileExists(FileName) then DeleteFile(FileName);
  DownAllFile(False,DList);
//  Dn.result_sl.SaveToFile(Edit4.text+'list.html');
 Finally
  DList.Free;
 end;

end;

procedure TMainForm.DownAllFile(ReplaceFlag:Boolean;DList:TStringList);
var I,J:LongWord;
    List:TStringList;
    FileName:String;
{
Const RegExArr :array [0..8] of String =
  (
    '(\/Skin\/feiku2007\/Css\/)',
    '(\/js\/Html\/)',
    '(http:\/\/www\.feiku\.com)',
    '(\<div id\="Menu"\>\<script\>ShowTopMenu)(.+?)(;\<\/script\>\<\/div\>)',
    '(\<table border\="0"\>\s*\<tr height\="252"\>\s*\<td width\="252"\>)(.+?)(\<\/a\>\<\/td\>\s*\<\/tr\>\<\/table\>)',
    '(\<table border\="0"\>\s*\<tr height\="110"\>\s*\<td width\="760"\>\<fieldset)(.+?)(\<\/script\>\s*\<script src\="\/js\/gb\.js"\>\<\/script\>\s*\<div align\=center\>\s*\<\/div\>)',
    '(\<table border\="0"\>\s*\<tr height\="252"\>\s*\<td width\="252"\>)(.+?)(\s*\s*\<\/tr\>\s*\<\/table\>)',
    '(\<div id\="EndMenu"\>\<script\>ShowEndMenu)(.+?)(\<\/a\>\<\/noscript\>\<\/div\>\s*\s*\s*\s*)',
    '(\<a href\="\/User\/Messages\.aspx)(.+?)(\<\/font\>\<\/u\>\<\/a\>\<\/div\>)'
  );
}
begin
 List:=TStringList.Create;
 try
 Gauge1.MaxValue :=DList.Count-1;
 For I:=0 to DList.Count -1 do
 begin
    if ReplaceFlag then
     begin
      FileName :=DList.Strings[I];
      List.LoadFromFile(FileName);
      Rec.Subject :=List.Text;
     end
    else
     begin
      FileName :=Edit4.text+DList.Strings[I]+Edit3.Text;

      if FileExists(FileName) then Continue;
      Dn.ExecuteURL(Edit2.Text+DList.Strings[I]+Edit3.Text);
      Rec.Subject :=Dn.result_sl.Text;
     end;

     For J:=0 to Memo1.Lines.Count-1 do
       begin
        Rec.RegEx:=Memo1.Lines.Strings[J];
        Rec.Replacement :='';
        if Length(Rec.RegEx)<2 then Continue;

        Rec.ReplaceAll;
       end;
      List.Clear;
      List.Add(Rec.Subject);
      List.SaveToFile(FileName);

     Gauge1.Progress :=I;
 end;
 Label5.Caption :='下载完毕';
 Finally
  List.Free;
 end;
 
end;

procedure TMainForm.Button2Click(Sender: TObject);
var
  sr: TSearchRec;
  FindFlag :Integer;
  FileList:TStringList;
begin
  FindFlag :=  FindFirst(Edit4.Text + '*.*', faAnyFile, sr);
  FileList:=TStringList.Create;
  try
    while FindFlag =0 do
     begin
      if (Sr.Name<>'.') and (Sr.Name<>'..') then FileList.Add(Edit4.Text+Sr.Name);
      FindFlag :=FindNext(sr);
     end ;
    FindClose(sr);
    DownAllFile(True,FileList); 
  Finally
   FileList.Free;
  End;
end;

procedure TMainForm.FormCreate(Sender: TObject);
//var
begin
 ADOConnection1.Close;
 ADOConnection1.ConnectionString :=Format(
  'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s\book.mdb;Persist Security Info=False',
  [ExtractFileDir(Application.ExeName)]);
 try
  ADOConnection1.Open;
  ADOQuery1.Close;
  ADOQuery1.SQL.Clear;
  ADOQuery1.Sql.Add('select * from book ');
  ADOQuery1.Open;
  if (ADOQuery1.Bof and ADOQuery1.Eof) then
  begin
   ADOQuery1.Append;
   ADOQuery1.FieldByName('iCode').AsInteger :=1;
   ADOQuery1.FieldByName('Title').AsString :='例子';
   ADOQuery1.FieldByName('listurl').AsString :=Edit1_1.text;
   ADOQuery1.FieldByName('bootadd').AsString :=Edit2_1.text;
   ADOQuery1.FieldByName('SaveDir').AsString :=Edit4_1.text;
   ADOQuery1.Post;
   ADOQuery1.Refresh;

  end;
 except
  ShowMessage(ADOConnection1.ConnectionString);
  Close;
 end;
 
end;

procedure TMainForm.ADOQuery1AfterInsert(DataSet: TDataSet);
Var iCode:LongWord;
begin
 Query.Close;
 Query.SQL.Text :='select max(iCode)+1 from Book';
 Query.Open;
 iCode :=1;
 if not (Query.Bof and Query.Eof) then iCode:=Query.Fields[0].AsInteger;

 ADOQuery1.FieldByName('iCode').AsInteger :=iCode;
end;

end.