Einzelnen Beitrag anzeigen

Balosh

Registriert seit: 21. Apr 2015
31 Beiträge
 
Delphi 10 Seattle Professional
 
#27

AW: Volltextsuche mit Delphi

  Alt 24. Apr 2015, 12:28
Also ich finde nirgends etwas was verhindern könnte dass das Programm nicht richtig läuft hier mal den kompletten Code:

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;
    BitBtn1: TBitBtn;
    procedure btnZielClick(Sender: TObject);
    procedure BBstartClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);

  private
    { Private-Deklarationen }
    procedure FileSearch(const PathName, FileName : string);
  public
    { Public-Deklarationen }
  end;

var
  MainSuche: TMainSuche;
  OverrideCbBAdr: boolean = false;

implementation

{$R *.dfm}
uses FileInfo;

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
          begin
            if (Rec.Name <> '.') and (Rec.Name <> '..') then
              FileSearch( Path+Rec.Name , FileName);
          end;
        end
        else
          Listbox1.Items.Add(Path + Rec.Name);

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


procedure TMainSuche.BitBtn1Click(Sender: TObject);
begin
ListBox1.Clear;
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);
end;
end.
Findet ihr da etwas?
  Mit Zitat antworten Zitat