unit2.pas

此程序用于图书分类

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, Buttons, StdCtrls, DB, ADODB;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    BitBtn1: TBitBtn;
    IdH1: TIdHTTP;
    IdH2: TIdHTTP;
    Button2: TButton;
    ADODataSet1: TADODataSet;
    ADOConnection1: TADOConnection;
    ADODataSet2: TADODataSet;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
       getWeb:Tmemorystream; //TStringList;
    weburl:String;
    strTitle:String;
    strAuthor:String;
    strCopyFrom:String; 
    strContent:String; 
    StrSource:String; 
    StrBegin:String; 
    StrEnd:String;
  end;
   function Get(AURL:String):String;
   function GetStr(StrSource,StrBegin,StrEnd:String):string;
var
  Form1: TForm1;


implementation

{$R *.dfm}
function Get(AURL:string):string;
var
result1: string;
begin
  result1:='';
end;

//截取左边的编码
function GetStr(StrSource,StrBegin,StrEnd:String):string;
var
in_star,in_end:integer;
strsource1:string;
begin
    if length(StrBegin)=0 then
    begin
      in_end:=AnsiPos(StrEnd,StrSource);
      result:=copy(StrSource,1,in_end);
    end
    else
    begin
      in_star:=AnsiPos(StrBegin,StrSource)+length(StrBegin);
      if  in_star>length(StrBegin) then
      begin
        strsource1:=copy(StrSource,in_star,length(StrSource));
        in_end:=AnsiPos(StrEnd,StrSource1)-length(StrEnd);
        result:=copy(StrSource1,1,in_end);
      end;
    end;
{
  函数里的AnsiPos和copy，都是系统定义的，可从delphi的帮助文件里找到相关说明，
  function AnsiPos(const Substr, S: string): Integer
  返回Substr在S中第一次出现的位置。
  function copy(strsource,in_star,in_end-in_star): string;
  返回字符串strsource中,从in_star(整型数据)开始到in_end-in_star(整型数据)结束的字符串。
    }
end;

//除去{或者【
function CQ(str:string):string;
begin
  if ((str[1]='[') or (str[1]='{')) then
  begin
     result:=copy(str,2,length(str)-2);
  end
  else
  begin
     result:=str;
  end;
end;

//截取右边的名字
function RStr(StrSource,StrBegin:String):String;
var
  in_star,in_end:integer;
  strsource1:string;
begin
  in_star:=AnsiPos(StrBegin,StrSource)+length(StrBegin);
  strsource1:=copy(StrSource,in_star,length(StrSource));
  in_end:=AnsiPos(' ',StrSource1)+1;
  result:=copy(StrSource1,in_end,length(StrSource1));
end;

{function Father(son:String):string;
var
  son1:string;
begin
  if son[length(son)]=' ' then
  begin
    result:='';
  end
  else
  begin
    son1:=son[length(son)-1];
    if (son1<>'.') and (son1<>'+') and (son1<>'-') and (son1<>'/') then
    begin
      result:=copy(son,1,length(son)-1);
    end
    else
    begin
      result:=copy(son,1,length(son)-2);
    end;
  end
end;
}

function Father(son:String):string;
var
  i:integer;
  son1:string;
begin
  if son[length(son)]=' ' then
  begin
    result:='';
  end
  else
  begin
    for i:=1 to length(son) do
    begin
      son1:=son[length(son)-i];
      if (son1<>'.') and (son1<>'+') and (son1<>'-') and (son1<>'/') then
      begin
        result:=copy(son,1,length(son)-i);
        break;
      end;
    end;
  end;
end;


function isnum(str:string):boolean;
begin
    if not (str[1] in ['0'..'9']) then
    begin
      result:=true;
      exit;
    end;
    result:=false;
end;

{function inABC(str:string):boolean;
begin
    if not (str[1] in ['A'..'Z']) then
    begin
      result:=false;
      exit;
    end;
    result:=true;
end;
}
function check(str:string):boolean;
var
  i:integer;
begin
   for i:=1 to length(str) do
   begin
     if (str[i]='/') then
     begin
      result:=false;
      exit;
     end;
   end;
   result:=true;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  Edit1.Text:='';

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
If Application.MessageBox('您真的要退出系统吗？','系统提示！',mb_yesno)=idyes then
  begin
    Form1.Close;
  end;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
s: TmemoryStream;
i,j:integer;
begin
 If Edit1.Text='' then
    Showmessage('请输入网址后再点击‘开始采集’按钮！')
  else
  try
begin
s:= TmemoryStream.Create;
try
weburl:=Edit1.Text;
Idh1.Get(weburl, s);
except
on e: exception do
begin
//Memo1.Lines.Text:= e.Message;
end;
end;
s.SaveToFile('G:\book.txt');
s.Free;
showmessage('已经下载文件，请录入！');
  end;
  except
  begin
    Showmessage('访问数据不成功或你所输入的网址不存在！');
  end;
  end;

end;


procedure TForm1.Button2Click(Sender: TObject);
var
  TxtFile:TextFile;
  List: TStringList;
  I,j: integer;
  newstr,Nstr: string;
  s:array[0..8]of string;
begin
  adoconnection1.Open;
  adodataset1.CommandText:='select * from book';
  adodataset1.Open;
  List := TStringList.Create();
  List.LoadFromFile('G:\book.txt');
  s[1]:='                ';
  s[2]:='              ';
  s[3]:='            ';
  s[4]:='          ';
  s[5]:='        ';
  s[6]:='      ';
  s[7]:='    ';
  s[8]:='';
//截取最新
  begin
 for j := 1 to 8 do
  begin
    for I := 0 to List.count - 1 do
    begin
      Nstr:=GetStr(List[I],s[j],' ');
       if (Nstr<>' ') and (Nstr<>'') and (isnum(Nstr))  {and(inABC(Nstr) and(check(Nstr))}then
       begin
          Nstr:=CQ(Nstr);
          adodataset2.CommandText:='select * from book where id='''+Nstr+'''';
          adodataset2.Open;
          if(adodataset2.RecordCount<=0) then
            begin
              newstr:=RStr(List[I],s[j]);
              adodataset1.Append;
              adodataset1.Fields[0].AsString:=Nstr;
              adodataset1.Fields[1].AsString:=newstr;
              adodataset1.Fields[2].AsString:=Father(Nstr);
              adodataset1.Post;
            end;
       end;
       adodataset2.Close();
   end;
  end;
      adodataset1.Close();
      adoconnection1.Close();
      showmessage('输入成功！');
 end;

end;

end.