umain.~pas

AirtoFly.com中的长途有关信息抓取,并存写在数据库中

unit uMain;

interface

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

type
  TfrmMain = class(TForm)
    IdHTTPMain: TIdHTTP;
    mmMain: TMemo;
    btnGet: TButton;
    adoMain: TADOConnection;
    qryMain: TADOQuery;
    procedure btnGetClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function GrabHtml() : Boolean;
    function AnalyseHtml(const sHtml : WideString) : Boolean;
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses
  u_Function;

{ TfrmMain }

function TfrmMain.GrabHtml: Boolean;
const
  sUrlMain = 'http://bus.airtofly.com/zhijiang/';
var
  i, j, iPre : Integer;
  sUrl, sI2, sI3 : String;
  sHtml : AnsiString;
  iFirst, iNow : Longint;
  bErr : Boolean;
begin
  Result := False;
  try
    for i := 1 to 11 do
    begin
      sI2 := Format('cnzj%.2d', [i]);
      if i = 1 then sI2 := 'cnzj';
      j := 1;
      bErr := False;
      while True do
      begin
        sI3 := Format('%.3d.htm', [j]);
        j := j + 1;
        sUrl := sUrlMain + sI2 + '/' + sI3;
        sHtml := '';
        try
          iFirst := GetTickCount();
          repeat            
            sHtml := IdHTTPMain.Get(sUrl);
            Application.ProcessMessages;
            inow := GetTickCount();
            if sHtml <> '' then break;
          until (iNow - iFirst > 90000); 
          if sHtml = '' then Break;
          if bErr then bErr := False;
        except
          WriteLog(sUrl);
          if not bErr then
          begin
            iPre := j - 1;
            bErr := True;
            Continue;
          end
          else
          begin
            if (j - 1) = (iPre + 2) then Break
            else Continue;
          end;
        end; 
        AnalyseHtml(sHtml);
      end;
    end;
    Result := True;
  except
    
  end;
end;

procedure TfrmMain.btnGetClick(Sender: TObject);
var
  sSql : String;
begin
  mmMain.Clear;
  sSql := ' delete from un_Coach';
  if not ExecSql(sSql, qryMain) then Exit;
  if not GrabHtml() then Exit;
end;

function TfrmMain.AnalyseHtml(const sHtml: WideString): Boolean;
const
  sIdentity = '<table class="t"';
var
  i, ipos, ibegin, iend : Integer;
  stmp, scontent : WideString;
  sList, sListA : TStringList;
  sCity, sDepart, sDest, sTime, sPhone, sParticular, sSql : String;

  function GetVal(sStr : String) : String;
  begin
    Result := '';
    try
      Result := Copy(sStr, Pos('>', sStr) + 1, Pos('<', sStr) - Pos('>', sStr)- 1);
    except

    end;
  end;
begin
  Result := False;
  try
    ipos := Pos(sIdentity, sHtml);
    if ipos = 0 then Exit;
    stmp := Copy(sHtml, ipos, Length(sHtml));
    ibegin := Pos('<tbody>', stmp);
    iend := Pos('</tbody>', stmp);
    if (ibegin = 0) or (iend = 0) then Exit;
    scontent := Copy(stmp, ibegin + 7, iend - 1);
    sList := SplitString(scontent, '<tr');
    for i := 0 to sList.Count - 1 do
    begin
      if Pos('<td', sList.Strings[i]) = 0 then Continue;
      sListA := SplitString(sList.Strings[i], '<td');
      sCity := GetVal(sListA.Strings[1]);
      sDepart := GetVal(sListA.Strings[2]);
      sDest := GetVal(sListA.Strings[3]);
      sTime := GetVal(sListA.Strings[4]);
      sPhone := GetVal(sListA.Strings[5]);
      sParticular := GetVal(sListA.Strings[6]);
      mmMain.Lines.Add(sCity + ' ' + sDepart + ' ' + sDest + ' ' + sTime + ' '
                       + sPhone + ' ' + sParticular);
      sSql := ' insert into un_Coach(CityName, DepartCity, DestCity, DepartTime) values('
            + QuotedStr(sCity) + ', ' + QuotedStr(sDepart) + ', '
            + QuotedStr(sDest) + ', ' + QuotedStr(sTime) + ')';
      ExecSql(sSql, qryMain);
    end;
  except
    WriteLog(scontent);
  end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  ReadIni();
  ConnectDB();
end;

end.