Zurück   PixAndMore - Support Forum > Programmierung > Skripte

Antwort
 
Themen-Optionen Ansicht
  #1  
Alt 09.03.2009
Benutzerbild von Kai
Kai Kai ist offline
Imabas-Entwickler
Admin
Obertroll
Registriert seit: 11.2003
Ort: Holzwickede
Beiträge: 2.756
Kai befindet sich auf einem aufstrebenden Ast
Standard Volltextsuche wie in Imabas (Für Bastler)

Aktionstyp: Direkt

pascal Code:
  1. function PerformAction: Boolean;
  2. var
  3.    dlg: TIDialog; words: String; wholewords, containsAll: Boolean;
  4.    wordList: TStringList; mode: TServerMode; q: String;
  5.    i, cnt: Integer; qry: TIQuery; image: TIImage;
  6. begin
  7.    Result := True;
  8.    
  9.    dlg := TIDialog.Create('Suchbegriff');
  10.    try
  11.       dlg.AddStringControl('Wörter', words);
  12.       dlg.AddBooleanControl('Nur ganze Wörter', wholewords);
  13.       dlg.AddBooleanControl('Muss alle Wörter beinhalten', containsAll);
  14.       if ( not dlg.Execute ) then
  15.          Exit;
  16.    finally
  17.       dlg.Free;
  18.    end;
  19.  
  20.    wordList := TStringList.Create;
  21.    wordList.Sorted := True;
  22.    wordList.Duplicates := dupIgnore;
  23.    try
  24.       BuildWordList(words, wordList);
  25.       mode := DatabaseServerMode;
  26.      
  27.       if ( wordList.Count > 0 ) then begin
  28.          if ( containsAll ) then begin
  29.  
  30.             case mode of
  31.                smMySQL:    q := 'select b.* from bildwoerter bw, bilder b where (bw.bild = b.ukey) and (';
  32.                smFirebird,
  33.                smADO,
  34.                smOracle:   q := 'select * from bilder where ukey in ( select b.ukey from bildwoerter bw, bilder b where (bw.bild = b.ukey) and (';
  35.             end;
  36.  
  37.             cnt := 0;
  38.             for i := 0 to wordList.Count-1 do begin
  39.                if ( cnt > 0 ) then q := q + ' or ';
  40.  
  41.                if ( wholeWords ) then q := q + '(normiert = ''' + wordList[i] + ''') '
  42.                else q := q + '(normiert like ''%' + wordList[i] + '%'') ';
  43.  
  44.                cnt := cnt + 1;
  45.             end;
  46.  
  47.             case mode of
  48.                smMySQL:    q := q + ') group by b.ukey having count(b.ukey) = '+IntToStr(cnt);
  49.                smFirebird,
  50.                smADO,
  51.                smOracle:   q := q + ') group by b.ukey having count(b.ukey) = '+IntToStr(cnt)+')';
  52.             end;
  53.          end
  54.          else begin
  55.             q := 'select distinct b.* from bildwoerter bw, bilder b where (bw.bild = b.ukey) and (';
  56.  
  57.             cnt := 0;
  58.             for i := 0 to wordList.Count-1 do begin
  59.                if ( cnt > 0 ) then q := q + ' or ';
  60.  
  61.                if ( wholeWords ) then q := q + '(normiert = ''' + wordList[i] + ''') '
  62.                else q := q + '(normiert like ''%' + wordList[i] + '%'') ';
  63.  
  64.                cnt := cnt + 1;
  65.             end;
  66.  
  67.             q := q + ')';
  68.          end;
  69.  
  70.          Browser_BeginUpdate;
  71.          qry := TIQuery.Create;
  72.          image := TIImage.Create;
  73.          try
  74.             qry.SQL := q;
  75.             qry.Open;
  76.             while ( not qry.Eof ) do begin
  77.                image.Initialise(qry);
  78.                Browser_AddImage(image);
  79.                qry.Next;
  80.             end;
  81.          finally
  82.             Browser_EndUpdate;
  83.             qry.Free;
  84.             image.Free;
  85.          end;
  86.       end
  87.    finally
  88.       wordList.Free;
  89.    end;
  90.  
  91. end;
__________________
Mit freundlichen Grüßen
Kai Brendel
http://www.pixandmore.com
Mit Zitat antworten
Antwort
Themen-Optionen
Ansicht

Forumregeln
Es ist Ihnen nicht erlaubt, neue Themen zu verfassen.
Es ist Ihnen nicht erlaubt, auf Beiträge zu antworten.
Es ist Ihnen nicht erlaubt, Anhänge hochzuladen.
Es ist Ihnen nicht erlaubt, Ihre Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Gehe zu

Ähnliche Themen
Thema Autor Forum Antworten Letzter Beitrag
Bildrecherche bzw. Volltextsuche s2pro_fan Imabas Allgemein 10 24.05.2016 12:33
Volltextsuche mit "Sonderzeichen" Bernd Bugreports 6 15.06.2008 12:00
Fehlermeldung bei Volltextsuche Ohrenbeisser Bugreports 1 21.04.2005 13:37
Dateigröße von Bildern anzeigen und Volltextsuche anthes Neue Features in Imabas 1 04.12.2004 19:22
Zugriffsverletzung bei Volltextsuche (mysql-DB) neuschi Bugreports 2 10.03.2004 12:06


Powered by vBulletin® Version 3.7.1 (Deutsch)
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.