Just nu i M3-nätverket
Jump to content

SöK eFtEr...


Mikey

Recommended Posts

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

Link to comment
Share on other sites

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.

 

 

Link to comment
Share on other sites

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

Link to comment
Share on other sites

  • 2 months later...

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

Link to comment
Share on other sites

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;

Link to comment
Share on other sites

Archived

This topic is now archived and is closed to further replies.



×
×
  • Create New...