Misc - mandar uma pesquisa para o google

Top  Previous  Next

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.Cursor<>TheCursor 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 <= Slen) AND (Count <> n) do begin 

//skip over delimiters 

    while (i <= Slen) AND (s[i] IN Worddelims) DO 

      Inc(i); 

 

//if we're not beyond end of S, we're at the start of a word 

    if i <= Slen then 

      Inc(Count); 

 

//if not finished, find the end of the current word 

    if Count <> n then 

      while (i <= Slen) AND NOT(s[i] IN Worddelims) DO 

        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 <= Slen) AND NOT(s[i] IN Worddelims) DO 

      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] < #32) then begin 

      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_CONFIGURED<>0); 

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)<=0 then 

      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 wcl>lMinWord 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 wc>10 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<=10 then break; 

        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;