SöK eFtEr...

[Mikey]

Kan man göra en sökfunktion i delphi som fungerar som Windows sök funktion?

Alltså att man kan skriva in det man vill söka efter och sedan få det i en Memo ruta eller listbox.

 

/Mikey

[Petter Holmström]

Ja. Se på FindFirst och FindNext.

 

-Petter-

[Mikey]

Jag är inte så duktig och jag vet inte vars jag ska kolla...

 

/Mikey

[Petter Holmström]

Delphi-hjälpen.

 

-Petter-

[Unknown error]

Delphi hjälpen fick en ju bara att bli mer frågande.

[J S]

För att följande kod ska fungera så ska ditt formulär inhålla:

Button1 = Startar filsökningen

Button2 = Avbryter filsökningen

Edit1 = Filen man söker efter tex *.txt

Label1 = Visar sökvägar

ListBox1 = Visar resultatet av sökningen

 

 

(Koden är ursprungligen skriven av Peter Below, tror jag.)

 

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

 

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

ListBox1: TListBox;

Edit1: TEdit;

Label1: TLabel;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

FScanAborted: Boolean;

public

{ Public declarations }

function ScanDrive(root, filemask: string; hitlist: TStrings): boolean;

end;

 

var

Form1: TForm1;

 

implementation

 

{$R *.DFM}

 

 

//Rekursiv funktion som söker igenom katalogstrukturer

function TForm1.ScanDrive(root, filemask: string; hitlist: TStrings):

Boolean;

function ScanDirectory(var path: string): Boolean;

var

SRec: TSearchRec;

pathlen: Integer;

res: Integer;

begin

label1.caption := path;

pathlen := Length(path);

{ first pass, files }

res := FindFirst(path + filemask, faAnyfile, SRec);

if res = 0 then

try

while res = 0 do

begin

hitlist.Add(path + SRec.Name);

res := FindNext(SRec);

end;

finally

FindClose(SRec)

end;

Application.ProcessMessages;

Result := not (FScanAborted or Application.Terminated);

if not Result then Exit;

 

{second pass, directories}

res := FindFirst(path + '*.*', faDirectory, SRec);

if res = 0 then

try

while (res = 0) and Result do

begin

if ((Srec.Attr and faDirectory) = faDirectory) and

(Srec.name <> '.') and

(Srec.name <> '..')

then

begin

path := path + SRec.name + '\';

Result := ScanDirectory(path);

SetLength(path, pathlen);

end;

res := FindNext(SRec);

end;

finally

FindClose(SRec)

end;

end;

begin

FScanAborted := False;

Screen.Cursor := crHourglass;

try

Result := ScanDirectory(root);

finally

Screen.Cursor := crDefault

end;

end;

 

//Startar filsöknigen

procedure TForm1.Button1Click(Sender: TObject);

var

ch: Char;

root: string;

begin

root := 'C:\';

for ch := 'A' to 'Z' do

begin

root[1] := ch;

case GetDriveType(Pchar(root)) of

DRIVE_FIXED, DRIVE_REMOTE:

if not ScanDrive(root, edit1.text, listbox1.items) then

Break;

end;

end;

end;

 

//Avbryter sökningen

procedure TForm1.Button2Click(Sender: TObject);

begin

fScanAborted := True;

end;

 

end.

 

 

[Unknown error]

Tack, nu ska det nog lösa sig för oss.

 

Ett annat men liknande problem jag har är om man vill söka efter något man skrivit i en DBGrid.

Dvs jag vill ha en Edit ruta, en Button och den ska automatiskt söka efter det jag har skrivit i Editrutan. Hoppas ni förstår hur jag menar.

 

Mvh Pedda

[MickeS]

Går det att lägga till någon funktion där man kan välja om man vill söka på C:\ eller D:\ osv

 

Tack i förhand!

/Micke

[J S]

Skriv bara

root := 'C:\'; //Om du vill söka på c

ScanDrive(root, edit1.text, listbox1.items);

[MickeS]

Vars EXAKT ska jag lägga in det där två raderna, det finns ju redan två exakt såna rader!?

 

Hur gör jag för att få det att fungera??

 

/Mikael

[J S]

Du kan tex använda en ny knapp och då borde det bli så här.

 

procedure TForm1.Button3Click(Sender: TObject);

var

root: string;

begin

root := 'D:\'; //Om du vill söka på c

ScanDrive(root, edit1.text, listbox1.items);

end;