这个东西实现了已经有一段时间了,那个时候谷歌还没有退出中国内地呢!而现在呢,谷歌都退了有一些日子了!紧以此纪念一番!
话说谷歌API,我相信很多人应该都知道!不晓得在实际应用中,用的人多不多(我说的不是Web方面的)。谷歌API提供了很多接口,但是貌似唯独没有提供对Delphi的接口(我们Delphi程序员果然很尴尬啊,很多类库,都没有我们的份,都需要自己来实现)。而我又需要这么个东西,于是,我就写了这么个东西,完全基于搜索API的封装!用来实现在自己的软件中实现搜索的目的!
谷歌的搜索API的详细资料在:
http://code.google.com/intl/zh-CN/apis/ajaxsearch/documentation/reference.html#_class_GSearch
有兴趣的,可以自行参考一下!因为这个资料已经说的很详细了,所以我也就不多费口舌了,直接上代码
代码:
![](https://i-blog.csdnimg.cn/blog_migrate/961ddebeb323a10fe0623af514929fc1.gif)
{Google搜索API
参考资料:
http://code.google.com/intl/zh-CN/apis/ajaxsearch/documentation/reference.html#_class_GSearch
作者:不得闲 2010-4-1
}
unit DxGoogleSearchApi;
interface
uses Classes,SysUtils,msxml,uLkJSON,Variants;
type
//搜索类型 Web搜索 本地搜索 视频搜索 博客 新闻 书籍 图片 专利搜索
TDxSearchType = (Sh_Web,Sh_Local,Sh_Video,Sh_Blog,Sh_News,Sh_Book,Sh_Image,Sh_patent);
//搜索返回的结果
TDxSearchRecord = class
private
RetList: TStringList;
function GetFieldCount: Integer;
function GetFields(index: Integer): string;
function GetValues(index: Integer): string;
public
constructor Create;
procedure FromJsonObj(JsonObj: TlkJSONobject);
destructor Destroy;override;
property FieldCount: Integer read GetFieldCount;
property Fields[index: Integer]: string read GetFields;
property Values[index: Integer]: string read GetValues;
function FieldByName(FieldName: string): string;
end;
TDxSearchRecords = class
private
List: TList;
FSearchType: TDxSearchType;
function GetCount: Integer;
function GetRecords(index: Integer): TDxSearchRecord;
public
procedure Clear;
constructor Create;
property SearchType: TDxSearchType read FSearchType;
destructor Destroy;override;
property Count: Integer read GetCount;
property Records[index: Integer]: TDxSearchRecord read GetRecords;
end;
//搜索API
TDxGoogleSearch = class
private
FSearchType: TDxSearchType;
FBigSearchSize: Boolean;
FSearchStart: Integer;
FVersion: string;
HttpReq: IXMLHttpRequest;
FRecords: TDxSearchRecords;
Pages: array of Integer;
FCurSearchInfo: string;
ClearOld: Boolean;
FCurPageIndex: Integer;
function GetPageCount: Integer;
public
constructor Create;
destructor Destroy;override;
procedure Search(SearchInfo: string);
property CurPageIndex: Integer read FCurPageIndex;
function NextSearch: Boolean;//搜索下一个页
property PageCount: Integer read GetPageCount;
property Records: TDxSearchRecords read FRecords;
property BigSearchSize: Boolean read FBigSearchSize write FBigSearchSize default true;//rsz参数
property SearchStart: Integer read FSearchStart write FSearchStart default 0;//搜索开始的位置,start参数
property Version: string read FVersion write FVersion;
property SearchType: TDxSearchType read FSearchType write FSearchType default Sh_Web;//搜索类型
end;
implementation
type
TBytes = array of Byte;
function BytesOf(const Val: AnsiString): TBytes;
var
Len: Integer;
begin
Len := Length(Val);
SetLength(Result, Len);
Move(Val[1], Result[0], Len);
end;
function ToUTF8Encode(str: string): string;
var
b: Byte;
begin
for b in BytesOf(UTF8Encode(str)) do
Result := Format('%s%s%.2x', [Result, '%', b]);
end;
{ TDxGoogleSearch }
constructor TDxGoogleSearch.Create;
begin
HttpReq := CoXMLHTTPRequest.Create;
ClearOld := True;
FRecords := TDxSearchRecords.Create;
FVersion := '1.0';
FSearchType := Sh_Web;
FBigSearchSize := True;
FSearchStart := 0;
end;
destructor TDxGoogleSearch.Destroy;
begin
HttpReq := nil;
SetLength(Pages,0);
FRecords.Free;
inherited;
end;
function TDxGoogleSearch.GetPageCount: Integer;
begin
Result := High(Pages) + 1;
end;
function TDxGoogleSearch.NextSearch: Boolean;
var
i: Integer;
begin
Result := False;
for i := 0 to High(Pages) do
begin
if Pages[i] = FSearchStart then
begin
if i + 1 <= High(Pages) then
begin
FSearchStart := Pages[i + 1];
Result := True;
end;
Break;
end;
end;
if Result then
Search(FCurSearchInfo);
end;
procedure TDxGoogleSearch.Search(SearchInfo: string);
const
BaseUrl = 'http://ajax.googleapis.com/ajax/services/search/';
var
Url: string;
Json: TlkJsonObject;
ChildJson,tmpJson: TlkJSONbase;
SRecord: TDxSearchRecord;
procedure OnSearch;
var
i: Integer;
begin
Url := Url + '&start='+inttostr(FSearchStart);
HttpReq.open('Get', Url, False, EmptyParam, EmptyParam);
HttpReq.send(EmptyParam);//开始搜索
Url := HttpReq.responseText;
Json := Tlkjson.ParseText(url) as TlkJSONobject;
ChildJson := Json.Field['responseData'];
if ChildJson.SelfType = jsObject then
begin
ChildJson := ChildJson.Field['results'];
if ChildJson.SelfType = jsList then
begin
for i := 0 to ChildJson.Count - 1 do
begin
tmpJson := ChildJson.Child[i];
SRecord := TDxSearchRecord.Create;
SRecord.FromJsonObj(tmpJson as TlkJSONobject);
FRecords.List.Add(SRecord);
end;
end;
if ClearOld or (Length(Pages) = 0) then
begin
//查看分页情况,获得分页情况
ChildJson := Json.Field['responseData'].Field['cursor'].Field['pages'];
if ChildJson.SelfType = jsList then
begin
SetLength(Pages,ChildJson.Count);
for i := 0 to ChildJson.Count - 1 do
begin
tmpJson := ChildJson.Child[i];
Pages[i] := StrToInt(VarToStr(tmpJson.Field['start'].Value));
end;
end;
ChildJson := Json.Field['responseData'].Field['cursor'];
FCurPageIndex := strtoint(vartostr(ChildJson.Field['currentPageIndex'].Value));
end
else
begin
ChildJson := Json.Field['responseData'].Field['cursor'];
FCurPageIndex := strtoint(vartostr(ChildJson.Field['currentPageIndex'].Value));
end;
end;
Json.Free;
end;
begin
FCurSearchInfo := SearchInfo;
case FSearchType of
Sh_Web: Url := BaseUrl + 'web?v='+FVersion+'&q=';
Sh_Local: Url := BaseUrl + 'local?v='+FVersion+'&q=';
Sh_Video: Url := BaseUrl + 'video?v='+FVersion+'&q=';
Sh_Blog: Url := BaseUrl + 'blogs?v='+FVersion+'&q=';
Sh_News: Url := BaseUrl + 'news?v='+FVersion+'&q=';
Sh_Book: Url := BaseUrl + 'books?v='+FVersion+'&q=';
Sh_Image: Url := BaseUrl + 'images?v='+FVersion+'&q=';
Sh_patent: Url := BaseUrl + 'patent?v='+FVersion+'&q=';
else Url := '';
end;
if Url <> '' then
begin
FRecords.FSearchType := FSearchType;
if ClearOld then
FRecords.Clear;
Url := Url + ToUTF8Encode(SearchInfo);
if FBigSearchSize then
Url := Url + '&rsz=large'
else Url := Url + '&rsz=small';
if FSearchStart < 0 then
begin
//搜索返回所有结果
ClearOld := False;
FSearchStart := 0;
OnSearch;
while NextSearch do;//搜索下一个
end
else
begin
OnSearch;
end;
end;
end;
{ TDxSearchRecord }
constructor TDxSearchRecord.Create;
begin
RetList := TStringList.Create;
end;
destructor TDxSearchRecord.Destroy;
begin
RetList.Free;
inherited;
end;
function TDxSearchRecord.FieldByName(FieldName: string): string;
var
index: Integer;
begin
index := RetList.IndexOfName(FieldName);
if (index > -1) and (index < FieldCount) then
Result := RetList.ValueFromIndex[index]
else Result := '';
end;
procedure TDxSearchRecord.FromJsonObj(JsonObj: TlkJsonObject);
var
i: Integer;
str: String;
begin
RetList.Clear;
for i := 0 to JsonObj.Count - 1 do
begin
str := JsonObj.NameOf[i];
str := str + '=' + VarToStr(JsonObj.FieldByIndex[i].Value);
RetList.Add(str);
end;
end;
function TDxSearchRecord.GetFieldCount: Integer;
begin
Result := RetList.Count;
end;
function TDxSearchRecord.GetFields(index: Integer): string;
begin
if (index > -1) and (index < FieldCount) then
Result := RetList.Names[index]
else Result := '';
end;
function TDxSearchRecord.GetValues(index: Integer): string;
begin
if (index > -1) and (index < FieldCount) then
Result := RetList.ValueFromIndex[index]
else Result := '';
end;
{ TDxSearchRecords }
procedure TDxSearchRecords.Clear;
begin
while List.Count > 0 do
begin
TDxSearchRecord(List[List.Count - 1]).Free;
List.Delete(List.Count - 1);
end;
end;
constructor TDxSearchRecords.Create;
begin
List := TList.Create;
FSearchType := Sh_Web;
end;
destructor TDxSearchRecords.Destroy;
begin
clear;
List.Free;
inherited;
end;
function TDxSearchRecords.GetCount: Integer;
begin
Result := List.Count;
end;
function TDxSearchRecords.GetRecords(index: Integer): TDxSearchRecord;
begin
if (index > -1) and (index < Count) then
Result := List[index]
else Result := nil;
end;
end.