Volltextsuche mit Delphi

[Balosh]

Auf was muss man denn alles achten wenn man die Suche komplett auf Unicode machen will? Ist es zu empfehlen oder eher nicht? (Ist nur mal so ein Gedanke) :)

[Balosh]

So habe nun in etwa das Grundgerüst. Ist zwar noch lang keine richtige Volltextsuche aber es ist ein Anfang.

Wenn jemandem Fehler auffallen oder paar Verbesserungsvorschläge hat als her damit. Meine nächste Hürde wo ich nehmen will ist die Checkbox so zu integrieren, dass wenn sie markiert ist auch die Unterordner mit einbezogen werden. So wie ich das bisher gemacht habe funktioniert es nicht wirklich.

Code:

unit Volltextsuche;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, FileCtrl, System.IOUtils ,
  Vcl.Buttons;

type
  TMainSuche = class(TForm)
    cbSuche: TComboBox;
    lblSuche: TLabel;
    cbZiel: TComboBox;
    lblZiel: TLabel;
    btnZiel: TButton;
    BBstart: TBitBtn;
    ListBox1: TListBox;
    CheckBox1: TCheckBox;
    procedure btnZielClick(Sender: TObject);
    procedure BBstartClick(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);

  private
    { Private-Deklarationen }
    procedure FileSearch(const PathName, FileName : string; const InDir : boolean);

  public
    { Public-Deklarationen }
  end;

var
  MainSuche: TMainSuche;
  OverrideCbBAdr: boolean = false;

implementation

{$R *.dfm}
uses FileInfo;

procedure TMainSuche.FileSearch(const PathName: string; const FileName: string; const InDir: Boolean);
var Rec : TSearchRec;
    Path : string;
begin
Path := IncludeTrailingBackslash(PathName);
if FindFirst (Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
try
  repeat
    Listbox1.Items.Add(Path + Rec.Name);
  until FindNext (Rec) <> 0;
finally
   FindClose (Rec);
end;
end;

procedure TMainSuche.btnZielClick(Sender: TObject);
var
 Directory: string;
begin
  Directory := 'C:\';
  if SelectDirectory('Bitte ein Verzeichnis wählen.','',Directory) then
  begin
    if not OverrideCbBAdr then
    begin
    OverridecbBAdr := true;
    cbZiel.Items.Insert(0,'');
    end;

  cbZiel.Items.Delete(0);
  cbZiel.Items.Insert(0,Directory);
  cbZiel.ItemIndex := 0;
end;
end;

procedure TMainSuche.BBstartClick(Sender: TObject);
begin
ListBox1.Clear;
FileSearch(cbZiel.Text, cbSuche.Text, CheckBox1.State in [cbChecked]);
end;

procedure TMainSuche.ListBox1DblClick(Sender: TObject);
var SelectedFile : string;
    Rec          : TSearchRec;
    frInfo       : TfrFileInfo;
begin
SelectedFile := ListBox1.Items.Strings[ListBox1.ItemIndex];
if FindFirst (SelectedFile, faAnyFile, Rec) = 0  then
  begin
    frinfo := TfrFileInfo.Create(Self);
    try
      frInfo.lblFile.Caption := SelectedFile;
      frInfo.lblName.Caption := Rec.Name;
      frInfo.lblSize.Caption := Format('%d bytes', [Rec.Size]);
      frInfo.lblModified.Caption := DateToStr(fileDatetoDateTime(Rec.Time));
      frInfo.lblShortName.Caption := Rec.FindData.cAlternateFileName;
      frInfo.ShowModal;
    finally
      frInfo.Free;
    end;
    FindClose(Rec)
  end;
end;
end.

[Balosh]

Habe nun die Checkbox mit eingebaut aber wenn ich das Programm ausführe und die Checkbox markiere kommt ein Speicher Fehler:

=>Erste Gelegenheit für Exception bei $77060FB2. Exception-Klasse $C0000005 mit Meldung 'access violation at 0x77060fb2: write of address 0x74e4ddf5'. Prozess Suche.exe (5336)<=

ich habe keine Ahnung was den Fehler verursacht.

Hier auch mal der geänderte Code mit der Checkbox:

Code:

procedure TMainSuche.FileSearch(const PathName, FileName: string);
var Rec : TSearchRec;
    Path : string;

begin
  if Checkbox1.Checked = true then
  begin
    Path := IncludeTrailingBackSlash(PathName);
    try
      repeat
       if ((Rec.attr and faDirectory) = faDirectory) then
             FileSearch(Path, Rec.Name);
          until FindNext(Rec) <> 0;
    finally
      FindClose (Rec);
    end;
  end else begin
    Path := IncludeTrailingBackslash(PathName);
    if FindFirst (Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
    begin
      try
        repeat
          Listbox1.Items.Add(Path + Rec.Name);
        until FindNext (Rec) <> 0;
      finally
         FindClose (Rec);
      end;
    end;
  end;
end;

[baumina]

Wenn CheckBox1.Checked dann machst du kein FindFirst, greifst aber schon mal auf das nicht initialisierte Rec.attr zu -> *peng*.

[mkinzler]

Ich würde nur den Code der sich zwischen den beiden Versionen unterscheidet in der Fallunterscheidung getrennt verwenden.
In der 1. Bedingung fehlt das FindFirst()

Delphi-Quellcode:

if Checkbox1.Checked then

reicht

[Balosh]

@ baumina

stimmt kein Wunder das es da crashed.

Zitat:

Zitat von mkinzler (Beitrag 1299051)

Ich würde nur den Code der sich zwischen den beiden Versionen unterscheidet in der Fallunterscheidung getrennt verwenden.
In der 1. Bedingung fehlt das FindFirst()

Delphi-Quellcode:

if Checkbox1.Checked then

reicht

Jetzt steh ich auf dem Schlauch, was meinst du mit trennen?

[mkinzler]

Du hast 2 fast identische Schleifen. Es sollte ja auch mit einer gehen.

[Balosh]

Mhh Ok habe jetzt die Schleifen abgeändert aber nun bringt er mir kein Ergebnis mehr.

Code:

procedure TMainSuche.FileSearch(const PathName, FileName: string);
var Rec : TSearchRec;
    Path : string;

begin
  if FindFirst (Path + FileName, faAnyFile - faDirectory, Rec) = 0 then
  if Checkbox1.Checked = true then
  begin
    Path := IncludeTrailingBackSlash(PathName);
    try
      repeat
       if ((Rec.attr and faDirectory) = faDirectory) then
             FileSearch(Path, Rec.Name);
          until FindNext(Rec) <> 0;
    finally
      FindClose (Rec);
    end;
  end else begin
    Path := IncludeTrailingBackslash(PathName);
    begin
      try
        repeat
          Listbox1.Items.Add(Path + Rec.Name);
        until FindNext (Rec) <> 0;
      finally
         FindClose (Rec);
      end;
    end;
  end;
end;

Hab ich da wieder ein Logikfehler drin und ich sehe ihn nicht bzw. einen Anfänger Fehler?

[baumina]

Wenn du im FindFirst keine Verzeichnisse suchst, wirst du natürlich auch keine finden.

[mkinzler]

Immer noch zuviel doppelt.

Delphi-Quellcode:

procedure TMainSuche.FileSearch(const PathName, FileName: string);
var Rec : TSearchRec;
    Path : string;

begin
  Path := IncludeTrailingBackSlash(PathName);
  try
    if FindFirst (Path + FileName, faAnyFile, Rec) = 0 then
    begin 
      repeat 
        if ((Rec.attr and faDirectory) = faDirectory) then
        begin
          if Checkbox1.Checked then
            FileSearch(Path, Rec.Name)
        end
        else  
          Listbox1.Items.Add(Path + Rec.Name);   

      until FindNext(Rec) <> 0;
  finally
     FindClose (Rec);
  end;
end;