Title: Query Google
Question: Recently I wrote an on click event handler, my Query-Goolge handler that I want to share with the Delphi3000 community.
Answer:
The idea was, that for certain text labels I wanted to add the posibility to search (lookup) directly Google. Basically the search pattern was put in the hint of the controls (The application is multilanguage so if you switch language you will get language dependend results). The hints were composed to be precise and when passed to the routines give good language specific results on Google.
When the mouse moved over the control a special cursor - a [G] - appeared, indicating a link to Google. This happens only if there is a live connection to the internet (I hate applications like Symantec-Antivirus that are so stupid that they want to update when you sit in a train working with your notebook and you have no internet connection). The function CanConnectInternet handles this situation. You can use it in some kind of action update handler to control the appearance of the cursor. The following code within comment brackets is part of my project and is given for your imagination only. Treate it as 'pseudo code'.
(*
//The action update handler
procedure TDataModDlg.APrintSubjectsUpdate(Sender: TObject);
begin
UpdateGoogleLookupControls;
end;
//The procedure that controls the cursor look
procedure TDataModDlg.UpdateGoogleLookupControls;
var
TheCursor: TCursor;
begin
if CanConnectedToInternet then
TheCursor:=crGoGoogle
else
TheCursor:=crDefault;
if VLBMI.CursorTheCursor then begin
VLBMI.Cursor:=TheCursor; //vlbmi is a TLabel control (BMI=Body mass index)
VLDBBMI.Cursor:=TheCursor; //vldbbmi is a TDBText control (calculated DB field Body mass index)
VLWHR.Cursor:=TheCursor; //vlwhr is a TLabel control (WHR=Waist to Hip ratio)
VLDBWHR.Cursor:=TheCursor; //vldbwhr is a TDBText control (calculated DB field Waist to Hip ratio)
end;
end;
*)
//German Hint for VLBMI and VLDBBMI "Body Mass Index"
//French Hint for VLBMI and VLDBBMI "Indice de masse corporelle"
//English Hint for VLBMI and VLDBBMI "Body mass index"
//Spanish Hint for VLBMI and VLDBBMI "ndice de masa corporal (Body Mass Index)"
In the on click hander the Google-query is fired!
(*
procedure TDataModDlg.VLDBBMIClick(Sender: TObject);
begin
if sender is Tcontrol then
QueryGoogle(TControl(Sender).Hint,'()');
end;
*)
From the hints above you see that there are characters like the brackets, that are better not sent to Google. By specifying '()' as RemChar - characters to be removed - in QueryGoogle, this characters are stripped, filtered off. Googles allows up to 10 key words. QueryGoogle automatically reduces the keywords to 10 - if there are more then 10 - passed with the parameter qs. It does so by removing short words first. Because Google expects UTF8 the strings - the only way to pass characters like the spanish - are converted correpondentetly. QueryGoogle calls your default web-browser.
//-----------------------------------------------------------------
// Uesfull code starts here ---------------------------------------
//-----------------------------------------------------------------
//-----------------------------------------------------------------
// Helper functions
//-----------------------------------------------------------------
function Wordposition(n : Integer; const s : string; Worddelims : Charset) : Integer;
// Given a set of word delimiters, return start position of N'th word in S
var
i,count,Slen:Integer;
begin
Count := 0;
i := 1;
Wordposition := 0;
Slen:=Length(s);
while (i n) do begin
//skip over delimiters
while (i Inc(i);
//if we're not beyond end of S, we're at the start of a word
if i Inc(Count);
//if not finished, find the end of the current word
if Count n then
while (i Inc(i)
else
Wordposition := i;
end;
end;
function Extractword(n : Integer; const s : string; Worddelims : Charset) : string;
//Given a set of word delimiters, return the N'th word in S
var
slen,k,i:Integer;
begin
Result:='';
k := Wordposition(n, s, Worddelims);
if k 0 then begin
slen:=Length(s);
i:=k;
//find the end of the current word
while (i Inc(i);
Result:=Copy(s,k,i-k);
end;
end;
function URLEncode(ASrc: string): string;
//convert a string so that it can be used on a URL query string
const
UnsafeChars = ['*', '#', '%', '', '+', ' '];
var
i: Integer;
begin
ASrc:=AnsiToUtf8(ASrc);
Result := '';
for i := 1 to Length(ASrc) do begin
if (ASrc[i] in UnsafeChars) or (ASrc[i] = #$80) or (ASrc[1] Result := Result + '%' + IntToHex(Ord(ASrc[i]), 2);
end else begin
Result := Result + ASrc[i];
end;
end;
end;
const
INTERNET_CONNECTION_OFFLINE=$20;
INTERNET_CONNECTION_CONFIGURED=$40;
function CanConnectedToInternet: boolean;
var
ConFlags: dword;
ConnOK: boolean;
begin
ConFlags:= INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
ConnOK:=InternetGetConnectedState(@ConFlags,0);
result:=ConnOK or (ConFlags and INTERNET_CONNECTION_CONFIGURED0);
end;
//-----------------------------------------------------------------
// QueryGoogle
//-----------------------------------------------------------------
procedure QueryGoogle(const qs,RemChar:string;const AndWords:Boolean=True;const MinWordLength:integer=3);
//Input: qs query string
// RemChar list of characters to be removed from query string qs
// Andwords replace blanks with '+' sign (And query)
// MinWordLength word or fragments with less then MinWordLength
// are removed from the query by default
//Comments: The routine strips down a query string to a maximum of 10 words.
// This is the maximum allowed by Google. It does this by repeatetly
// incrementing the minimal word length.
var
hs: String; //helper string
ws: String; //word string
wl: array of integer; //word string lengths
ns: String; //new string
i,k: integer;
wi: integer;
wcl: integer;
Delim: char;
lMinWord: integer;
wc: integer;
begin
if not CanConnectedToInternet then exit;
hs:='';
if AndWords then Delim:='+'
else Delim:=' ';
//extract unwanted characters
for i:=1 to length(qs) do
if pos(qs[i],RemChar) hs:=hs+qs[i];
if AndWords then
hs:=StringReplace(hs,' ','+',[rfReplaceAll, rfIgnoreCase ]);
//remove small words and build a list of word lengths
lminword:=MinWordLength;
wi:=0;
SetLength(wl,0);
for i:=1 to Wordcount(hs,[Delim]) do begin
ws:=Extractword(i,hs,[Delim]);
wcl:=Length(ws);
if wcllMinWord then begin
Inc(wi);
SetLength(wl,Succ(wi));
wl[wi]:=wcl;
if ns'' then ns:=ns+Delim+ws
else ns:=ws;
end;
end;
// If there are more than 10 words reduce then number until we have 10
// Strategy: then smallest are removed first.
wc:=Wordcount(hs,[Delim]);
if wc 10 then begin
hs:=ns;
lMinWord:=MinIntValue(wl);
i:=0;
while wc10 do begin
for k:=0 to length(wl) do
//mark the word length to -1 for the ones to be removed
if wl[k]=lMinWord then begin
wl[k]:=-1;
if wc end;
inc(lMinWord);
end;
// rebuild the list
ns:='';
for i:=1 to Wordcount(hs,[Delim]) do begin
ws:=Extractword(i,hs,[Delim]);
if wl[i-1]-1 then
if ns'' then ns:=ns+Delim+ws
else ns:=ws;
end;
end;
if (ns'') then
ShellExecute(0, 'open', Pchar('http://www.google.ch/search?q='+URLEncode(ns)+'&lr='), '', '', SW_SHOWNORMAL);
end;