я нашел то, что искал @ бюллетень Паскаля # 01
я снова посмотрю на мой код и найду мою ошибку
Unit1.dfm:
object Form1: TForm1
Left = 468
Top = 177
Width = 467
Height = 354
Caption = 'File Search'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
DesignSize = (
459
320)
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 17
Top = 13
Width = 55
Height = 13
Alignment = taRightJustify
Caption = 'File &Names:'
FocusControl = Edit1
end
object Label2: TLabel
Left = 19
Top = 42
Width = 53
Height = 13
Alignment = taRightJustify
Caption = '&Containing:'
FocusControl = Edit2
end
object Label3: TLabel
Left = 31
Top = 72
Width = 41
Height = 13
Alignment = taRightJustify
Caption = 'In f&older:'
FocusControl = Edit3
end
object Button1: TButton
Left = 376
Top = 6
Width = 78
Height = 24
Anchors = [akTop, akRight]
Caption = '&Find'
Default = True
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 376
Top = 38
Width = 78
Height = 24
Anchors = [akTop, akRight]
Cancel = True
Caption = '&Cancel'
Enabled = False
TabOrder = 1
OnClick = Button2Click
end
object StatusBar1: TStatusBar
Left = 0
Top = 301
Width = 459
Height = 19
Panels = <>
SimplePanel = True
end
object Edit1: TEdit
Left = 74
Top = 8
Width = 291
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 3
Text = '*.ini'
end
object Edit2: TEdit
Left = 74
Top = 37
Width = 291
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 4
Text = 'General'
end
object Edit3: TEdit
Left = 75
Top = 67
Width = 290
Height = 21
Anchors = [akLeft, akTop, akRight]
TabOrder = 5
Text = 'C:\Windows'
end
object CheckBox1: TCheckBox
Left = 76
Top = 97
Width = 111
Height = 13
Caption = '&Include subfolders'
TabOrder = 6
end
object ListView1: VListView
Left = 0
Top = 120
Width = 459
Height = 188
Anchors = [akLeft, akTop, akRight, akBottom]
Columns = <
item
Caption = 'Name'
Width = 150
end
item
Caption = 'Folder'
Width = 300
end>
TabOrder = 7
ViewStyle = vsReport
OnDblClick = ListView1DblClick
OnMouseDown = ListView1MouseDown
end
object Animate1: TAnimate
Left = 393
Top = 66
Width = 48
Height = 50
Anchors = [akTop, akRight]
FileName = 'C:\LatiumSoft\Pascal#001\findfile.avi'
StopFrame = 23
end
end
Unit1.pas:
unit Unit1;
//{$DEFINE Spanish}
{
Copyright (c) 2001 Ernesto De Spirito
Latium Software http://www.latiumsoftware.com/
Email: edespirito @ latiumsoftware.com
To try this example you first have to install the ListViewX component
and set a correct value for the FileName property of the Animate1
control (the full path name of an AVI file).
Para probar este ejemplo primero debe instalar el componente ListViewX y
establecer un valor correcto para la propiedad FileName del control
Animate1 (la ruta y nombre completo de un archivo AVI).
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ShellAPI, ListView;
const
WM_ThreadDoneMsg = WM_User + 8;
{$IFDEF Spanish}
cstrCouldNotExecApp = 'No se pudo ejecutar la aplicaci≤n';
cstrSearchEnded = 'B·squeda finalizada (%d ficheros encontrados).';
cstrSearchCancelled =
'B·squeda cancelada (%d ficheros encontrados).';
cstrSearching = 'Buscando... (%d ficheros encontrados)';
cstrEnterFileSpec = 'Especifique el nombre de archivo';
cstrEnterKeywords = 'Especifique el texto de b·squeda';
cstrEnterFolder = 'Especifique la carpeta inicial';
{$ELSE}
cstrCouldNotExecApp = 'Couldn''t execute the application';
cstrSearchEnded = 'Search ended (%d files found).';
cstrSearchCancelled = 'Search cancelled (%d files found).';
cstrSearching = 'Searching... (%d files found)';
cstrEnterFileSpec = 'Enter file spec';
cstrEnterKeywords = 'Enter keywords';
cstrEnterFolder = 'Enter folder';
{$ENDIF}
{$IFDEF WIN32}
PathSeparator: char = '\';
DriveSeparator: char = ':';
{$ELSE}
PathSeparator: char = '/';
// DriveSeparator: char = ' ';
{$ENDIF}
type
TForm1 = class;
TThread1 = class(TThread)
private
OwnerForm: TForm1;
Location: string;
FileName: string;
Count: cardinal;
procedure Initialize;
procedure AddFileName;
procedure Finalize;
protected
procedure Execute; override;
published
constructor Create(Owner: TForm1);
destructor Destroy; override;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
StatusBar1: TStatusBar;
Edit1: TEdit;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
CheckBox1: TCheckBox;
ListView1: VListView;
Animate1: TAnimate;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListView1DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
Last: TPoint;
Thread1: TThread1;
procedure Thread1Done(var AMessage: TMessage); message WM_ThreadDoneMsg;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//---------------------------------------------------------------
procedure TForm1.Button1Click(Sender: TObject);
var
c: char;
begin
if Edit1.Text = '' then begin
MessageDlg(cstrEnterFileSpec, mtWarning, [mbOK], 0);
Edit1.SetFocus;
end else if Edit2.Text = '' then begin
MessageDlg(cstrEnterKeywords, mtWarning, [mbOK], 0);
Edit2.SetFocus;
end else if Edit3.Text = '' then begin
MessageDlg(cstrEnterFolder, mtWarning, [mbOK], 0);
Edit3.SetFocus;
end else begin
c := Edit3.Text[Length(Edit3.Text)];
if (c <> PathSeparator) and (c <> DriveSeparator) then
Edit3.Text := Edit3.Text + PathSeparator;
Button1.Enabled := False;
Edit1.Enabled := False;
Edit2.Enabled := False;
Edit3.Enabled := False;
Checkbox1.Enabled := False;
Button2.Enabled := True;
Thread1 := TThread1.Create(Self);
// Animate1.Active := True;
end;//if
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Thread1.Terminate;
end;
procedure TForm1.Thread1Done(var AMessage: TMessage);
begin
// Animate1.Active := False;
Button1.Enabled := True;
Edit1.Enabled := True;
Edit2.Enabled := True;
Edit3.Enabled := True;
Checkbox1.Enabled := True;
Button2.Enabled := False;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Button2.Enabled then begin
Thread1.Terminate;
Thread1.WaitFor;
end; // if
Action := caFree;
end;
// ---------------------------------------------------------------
constructor TThread1.Create(Owner: TForm1);
begin
inherited Create(True);
OwnerForm := Owner;
Priority := tpHigher;
FreeOnTerminate := True;
Suspended := False;
end;
destructor TThread1.Destroy;
begin
PostMessage(OwnerForm.Handle,
WM_ThreadDoneMsg, Self.ThreadID, 0);
inherited destroy;
end;
procedure TThread1.Execute;
var
Content: TStringList;
Keywords: string;
procedure ScanFolder(const folder: string);
var
SearchRec: TSearchRec;
begin
if FindFirst(folder + OwnerForm.Edit1.Text,
faReadOnly Or faHidden Or faSysFile Or faArchive,
SearchRec) = 0 then begin
repeat
try
FileName := SearchRec.Name;
Content.LoadFromFile(folder + FileName);
if AnsiPos(Keywords, AnsiUpperCase(Content.Text))
<> 0 then begin
Inc(Count);
Location := folder;
Synchronize(AddFileName);
end; // if
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
if (not Terminated) and OwnerForm.Checkbox1.Checked then begin
if FindFirst(folder + '*', faReadOnly Or faHidden
Or faSysFile Or faArchive Or faDirectory,
SearchRec) = 0 then begin
repeat
try
if ((SearchRec.Attr and faDirectory) <> 0)
and (SearchRec.Name <> '.')
and (SearchRec.Name <> '..') then
ScanFolder(folder + SearchRec.Name + PathSeparator);
except
end; // try
until Terminated Or (FindNext(SearchRec) <> 0);
end; // if
FindClose(SearchRec);
end; // if
end;
begin // procedure TThread1.Execute;
Count := 0;
Synchronize(Initialize);
Content := TStringList.Create();
Keywords := AnsiUpperCase(OwnerForm.Edit2.Text);
ScanFolder(OwnerForm.Edit3.Text);
Content.Free;
Synchronize(Finalize);
end;
procedure TThread1.Initialize;
begin
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearching, [Count]);
OwnerForm.ListView1.Items.Clear;
end;
procedure TThread1.AddFileName;
var
ListItem: TListItem;
begin
OwnerForm.StatusBar1.SimpleText := Format(cstrSearching, [Count]);
ListItem := OwnerForm.ListView1.Items.Add();
ListItem.Caption := FileName;
ListItem.SubItems.Add(Location);
end;
procedure TThread1.Finalize;
begin
if Terminated then
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearchCancelled, [Count])
else
OwnerForm.StatusBar1.SimpleText :=
Format(cstrSearchEnded, [Count]);
end;
procedure TForm1.ListView1DblClick(Sender: TObject);
var
Col: Integer;
ListItem: TListItem;
begin
ListItem := ListView1.GetItemAtX(Last.X, Last.Y, Col);
if ListItem <> nil then begin
if Col = 0 then begin
if ShellExecute(Self.Handle, nil,
PChar(ListItem.SubItems.Strings[0] + ListItem.Caption),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin
Application.MessageBox(cstrCouldNotExecApp,
'Error', MB_ICONEXCLAMATION);
end;//if
end else if Col = 1 then begin
if ShellExecute(Self.Handle, 'explore',
PChar(ListItem.SubItems.Strings[0]),
nil, nil, SW_SHOWMAXIMIZED) <= 32 then begin
Application.MessageBox(cstrCouldNotExecApp,
'Error', MB_ICONEXCLAMATION);
end; // if
end; // if
end; // if
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
{$IFDEF Spanish}
Button1.Caption := '&Buscar';
Button2.Caption := '&Detener';
Label1.Caption := 'No&mbre:';
Label2.Caption := 'Con el &texto:';
Label3.Caption := 'B&uscar en:';
CheckBox1.Caption := '&Incluir subcarpetas:';
ListView1.Columns[0].Caption := 'Nombre';
ListView1.Columns[1].Caption := 'Ubicaci≤n';
{$ENDIF}
end;
procedure TForm1.ListView1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
Last.X := X;
Last.Y := Y;
end;
end.