search.pas

通过使用COM接口

unit Search;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, OleCtrls, MSScriptControl_TLB,
  comObj,dialogs;

type
  TBaseSearch = class(TObject)
  public
    constructor Create;
    procedure Free;

    procedure Test;
    function  GetMsg:TStrings;
  private
     FUrlList: TStrings;
     FUrl   : string;
  end;

implementation

{ TBaseSearch }

constructor TBaseSearch.Create;
begin
  inherited ;
  FUrlList := TStringList.Create;
end;

procedure TBaseSearch.Free;
begin
  FreeAndNil(FUrlList);
  inherited;
end;

function TBaseSearch.GetMsg: TStrings;
begin
  Result :=  FUrlList;
end;

procedure TBaseSearch.Test;


var
  Obj:OleVariant;
  Str:string;
begin
  Obj:=CreateOleObject('ScriptControl');
  Obj.Language:='JavaScript';
  Obj.AddCode('function test(S){'
             +'var re=/<a href=\"(.[^<>]*)">(.[^<>]*)<\/a>/ig;'
             +'var r1; var outStr="";'
             +'while ((r1=re.exec(S))!=null){outStr+="http:/"+r1[1]+","+r1[2]+"\n"} return outStr}');
  Str:='<table width="100%" border="0" cellspacing="0" cellpadding="4">'
     +'<tr>'
     +'<td bgcolor="F0F0F0" class="S" align="right">'
     +'  显示 1-10 条 共 41 条 5 页'
     +'      <strong>1</strong>'
     +'      <a href=''/athena/offerlist/dd/qianliwei-default-2-false.html''>2</a>'
     +'      <a href="/athena/offerlist/qianliwei-default-3-false.html">3</a>'
     +'      <a href="/athena/offerlist/qianliwei-default-4-false.html">4</a>'
     +'      <a href="/athena/offerlist/qianliwei-default-5-false.html">5</a>'
     +'</td>'
     +'</tr>'
     +'</table>';
  FUrlList.Text :=Obj.run('test',Str);
end;
end.