类似WINDOWS下的搜索

[peterzhu1999]

各位，新年好

在下想求用DELPHI编写类似WINDOWS下搜索功能的代码

即能够编写完成查找，点击查找的内容能够显示或运行相关程序的


谢谢，在线

[boytomato]

这是一个网友做的图标搜索工具！







{ ********************************************************************** }
{ }
{ Extract Icon 1.0(图标搜索工具) }
{ MainForm Source }
{ }
{ Copyright (c) 2003 by netrobo & [e-mail] in changchun }
{ }
{ ********************************************************************** }

unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ActnList, Menus, ComCtrls, ToolWin, ImgList,ShellAPI,ShlObj,
ExtCtrls,strUtils;

type
TfrmMain = class(TForm)
MainMenu1: TMainMenu;
ActionList1: TActionList;
SearchStart: TAction;
SearchStop: TAction;
SearchSetDir: TAction;
SearchSave: TAction;
SearchSaveAll: TAction;
SearchExit: TAction;
ViewLarge: TAction;
ViewSmall: TAction;
ViewList: TAction;
ViewDet: TAction;
HelpTopic: TAction;
HelpAbout: TAction;
MnuSearch: TMenuItem;
MnuView: TMenuItem;
MnuHelp: TMenuItem;
T1: TMenuItem;
O1: TMenuItem;
N1: TMenuItem;
E1: TMenuItem;
N2: TMenuItem;
S1: TMenuItem;
A1: TMenuItem;
N3: TMenuItem;
X1: TMenuItem;
L1: TMenuItem;
M1: TMenuItem;
L2: TMenuItem;
D1: TMenuItem;
N4: TMenuItem;
T2: TMenuItem;
mnuAbout: TMenuItem;
ViewPre: TAction;
P1: TMenuItem;
StuBar1: TStatusBar;
TBMain: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
LvIcons: TListView;
imgFace: TImageList;
SaveIconDlg: TSaveDialog;
imgIcons: TImageList;
imgTemp: TImage;
SavePmenu: TPopupMenu;
S2: TMenuItem;
A3: TMenuItem;
N5: TMenuItem;
P2: TMenuItem;
procedure SearchExitExecute(Sender: TObject);
procedure HelpAboutExecute(Sender: TObject);
procedure HelpTopicExecute(Sender: TObject);
procedure ViewPreExecute(Sender: TObject);
procedure ViewLargeExecute(Sender: TObject);
procedure ViewSmallExecute(Sender: TObject);
procedure ViewListExecute(Sender: TObject);
procedure ViewDetExecute(Sender: TObject);
procedure SearchSaveExecute(Sender: TObject);
function SelectFolder(const DlgTitle:string):string;
procedure SearchSetDirExecute(Sender: TObject);
procedure SearchSaveAllExecute(Sender: TObject);
procedure SearchAndDisp(const schPath:string);
procedure SearchStartExecute(Sender: TObject);
procedure SearchStopExecute(Sender: TObject);
procedure LvIconsClick(Sender: TObject);
procedure SavePic(const I:integer;S:string);
procedure LvIconsSelectItem(Sender: TObject; Item: TListItem;Selected: Boolean);
procedure SetButton(const IsTrue:boolean);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;
SearchPath:string;
IconCount:integer;
stopSearch:boolean=true;

implementation

uses Pre, Help;

{$R *.dfm}

procedure TfrmMain.SearchExitExecute(Sender: TObject);
begin
halt;
end;

procedure TfrmMain.HelpAboutExecute(Sender: TObject);
const
strTitle:Pchar=' Extract Icon 1.00...';
strVer:Pchar='Verson 1.00'+#13+'Author:netrobo';
begin
ShellAbout(application.handle,strTitle,strVer,application.Icon.Handle);
end;

procedure TfrmMain.HelpTopicExecute(Sender: TObject);
begin
frmHelp.showModal;
end;

procedure TfrmMain.ViewPreExecute(Sender: TObject);
begin
if lvIcons.selected<>nil then
frmPre.show;
end;

procedure TfrmMain.ViewLargeExecute(Sender: TObject);
begin
LvIcons.ViewStyle:=vsIcon;
ViewSmall.Checked:=false;
ViewLarge.Checked:=true;
ViewList.Checked:=false;
ViewDet.Checked:=false;
end;

procedure TfrmMain.ViewSmallExecute(Sender: TObject);
begin
LvIcons.ViewStyle:=vsSmallIcon;
ViewSmall.Checked:=true;
ViewLarge.Checked:=false;
ViewList.Checked:=false;
ViewDet.Checked:=false;
end;

procedure TfrmMain.ViewListExecute(Sender: TObject);
begin
LvIcons.ViewStyle:=vsList;
ViewSmall.Checked:=false;
ViewLarge.Checked:=false;
ViewList.Checked:=true;
ViewDet.Checked:=false;

end;

procedure TfrmMain.ViewDetExecute(Sender: TObject);
begin
LvIcons.ViewStyle:=vsReport;
ViewSmall.Checked:=false;
ViewLarge.Checked:=false;
ViewList.Checked:=false;
ViewDet.Checked:=true;

end;

procedure TfrmMain.SearchSaveExecute(Sender: TObject);
begin
if lvIcons.selected=nil then exit;
SaveIconDlg.FileName:=lvIcons.selected.Caption;
if SaveIconDlg.Execute=false then exit;
savePic(lvIcons.Selected.Index,SaveIconDlg.FileName);
end;

[boytomato]

//接上。。。
function TfrmMain.SelectFolder(const DlgTitle:string): string;
var
bi:TBrowseInfo;
PathIdList:PItemIdList;
strPath:string;
begin
strPath:=stringOfChar(' ',512);
bi.hwndOwner:=Self.handle;
bi.pidlRoot:=nil;
bi.pszDisplayName:=nil;
bi.lpszTitle:=pchar(dlgTitle);
bi.ulFlags:=BIF_ReturnOnlyFsDirs;
bi.lpfn:=nil;
bi.lParam:=0;
bi.iImage:=0;
result:='';
pathIdList:=SHBrowseForFolder(bi);
if pathIdList<>nil then
if SHGetPathFromIdList(pathIdList,pchar(strPath))then
result:=trim(strPath);
end;

procedure TfrmMain.SearchSetDirExecute(Sender: TObject);
var tempPath:string;
begin
tempPath:=SelectFolder('请选择要搜索的文件夹：');
if tempPath<>'' then begin
searchPath:=tempPath;
StuBar1.Panels[1].Text:='搜索目录：'+searchPath;
end;
end;

procedure TfrmMain.SearchSaveAllExecute(Sender: TObject);
var SaveFolder:string;
begin
if lvIcons.Items.count=0 then exit;
SaveFolder:=SelectFolder('请选择要保存的目录：');
if SaveFolder<>'' then SavePic(-1,SaveFolder);
end;

procedure TfrmMain.SearchAndDisp(const schPath: string);
var
targetPath :string;
iconFilePath :string;
FindAttr :integer;
FindSr :TSearchRec;
tmpExt :string;
tmpIcon :Hicon;
tmpPath :string;
I:integer;
begin
//Search icons and display in listView(lvIcons);
targetPath:=schPath;
if rightStr(targetPath,1)<>'\' then targetPath:=targetPath+'\';
tmpPath:=targetPath;
targetPath:=targetPath+'*.*';
stuBar1.Panels[1].Text:='正在搜索 '+targetPath+'...';
findAttr:=sysUtils.faReadOnly+sysUtils.faSysFile+sysUtils.faArchive+sysUtils.faDirectory;
if findFirst(targetPath,findAttr,findSr)<>0 then exit;
repeat
application.ProcessMessages;
if stopSearch=true then exit;
if(findSr.name='.')or(findSr.name='..')then continue;
iconFilePath:=tmpPath+findSr.Name;
tmpExt:=UpperCase(ExtractFileExt(iconFilePath));
if(tmpExt='.EXE')or(tmpExt='.ICO')or(tmpExt='.DLL')then begin
//Extract icons;
I:=0;
while true do begin
tmpIcon:=ExtractIcon(0,pchar(iconFilePath),i);
if tmpIcon=0 then break;
imgTemp.Picture:=nil;
drawIcon(imgTemp.Canvas.Handle,0,0,tmpIcon);
imgTemp.Picture.Icon.Handle:=tmpIcon;
imgIcons.AddIcon(imgTemp.picture.icon);
destroyIcon(tmpIcon);
inc(I);
inc(IconCount);
with lvIcons.Items.add do begin
caption:='ICO-'+intToStr(IconCount);
imageIndex:=iconCount-1;
subItems.Add(iconFilePath);
end;
stuBar1.Panels[0].Text:=intToStr(iconCount);
end;
end;
if(findSr.attr and faDirectory)<>0 then
searchAndDisp(iconFilePath);
until findNext(findSr)<>0;
findClose(findSr);
end;

procedure TfrmMain.SearchStartExecute(Sender: TObject);
begin
if searchPath='' then begin
application.messageBox('请先设置搜索图标的目录！','提示',mb_iconInformation);
exit;
end;
SetButton(false);
stuBar1.Panels[0].Text:='0';
iconCount:=0;
imgIcons.Clear;
lvIcons.Clear;
stopSearch:=false;
frmPre.imgPre.Picture:=nil;
if frmPre.visible=true then frmPre.Close;
SearchAndDisp(searchPath);
stuBar1.Panels[1].Text:='搜索完毕('+searchPath+')。';
SetButton(true);
end;

procedure TfrmMain.SearchStopExecute(Sender: TObject);
begin
stopSearch:=true;
end;

procedure TfrmMain.LvIconsClick(Sender: TObject);
begin
if lvIcons.selected=nil then exit;
imgIcons.getIcon(lvIcons.Selected.Index,frmPre.imgPre.Picture.Icon);
end;

procedure TfrmMain.SavePic(const I: integer;S:string);
var Ic:Ticon;
Id:integer;
SaveAllPath:string;
SaveFileName:string;
begin
//Save picture to Icon;
Ic:=Ticon.Create;
if I<>-1 then begin
imgIcons.GetIcon(I,Ic);
Ic.SaveToFile(s);
Ic.Free;end
else begin
SaveAllPath:=S;
if rightStr(S,1)<>'\'then SaveAllPath:=SaveAllPath+'\';
for Id:=0 to lvIcons.Items.Count-1 do begin
if lvIcons.Items.Item[Id].caption=''then
SaveFileName:=formatDateTime('MMSS',now)else
SaveFileName:=lvIcons.Items.Item[Id].Caption;
Ic:=Ticon.Create;
imgIcons.GetIcon(Id,Ic);
Ic.SaveToFile(saveAllPath+SaveFileName+'.ICO');
Ic.Free;
end;
end;
end;

procedure TfrmMain.LvIconsSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
LvIconsClick(nil);
end;

procedure TfrmMain.SetButton(const IsTrue: boolean);
begin
searchStart.Enabled:=IsTrue;
SearchStop.Enabled:=not IsTrue;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
AppendMenu(GetSystemMenu(application.Handle,true),Mf_separator,0,nil);
screen.HintFont.Color:=clGreen;
SetButton(true);
end;

end.

[ganju]

查找哪个控件或数据集的内容?

[peterzhu1999]

和WINDOWS下的搜索的功能差不多的就行

[peterzhu1999]

开始---搜索---文件夹或文件中 的内容

[DelphiBoy2003]

FindFirst,FindNext,FindClose,三个函数可以满足要求
如何使用请自己看帮助!查找到的结果调用可以使用Winexec或者引用ShellAPI单元后使用ShellExecute函数来调用.

[boytomato]

转贴！！
实现方法：
1． 获取当前目录下的所有下一级子目录。
2． 存入字符串列表中（Tstrings）。
其中，用到了几个API函数。
FindFirst 是找出指定目录下第一个文件或目录。
FindNext 一般和FindFirst配合使用，用来找出下一个文件或目录。
FindClose 用来关闭查询。
（以上函数Delphi在线帮助中有详尽解释，在此不赘述）；
3． 用FileExists函数查找当前目录，
4． 寻找是否有满足条件的文件存在，
5． 依次使各个子目录成为当前目录，
6． 递归调用本函数，
7． 释放资源，
8． 返回查询结果。 　
　
代码如下：
1． 从搜索记录中判断是否是子目录。
　
function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
if (SearchRec.Attr=16) and
(SearchRec.Name<>'.') and
(SearchRec.Name<>'..') then
Result:=True
else
Result:=False;
end;
2． 这是查询主体函数。
参数介绍：

Mainpath： 指定的查询目录。
Filename： 欲查询的文件。
Foundresult： 返回的含完整路径的匹配文件（可能有多个）。

如果有匹配文件，函数返回True，否则，返回False; 　

function SearchFile(mainpath:string; filename:string;
var foundresult:TStrings):Boolean;
var i:integer;
Found:Boolean;
subdir1:TStrings;
searchRec:TsearchRec;
begin
found:=false;
if Trim(filename)<>'' then
begin
subdir1:=TStringList.Create;//字符串列表必须动态生成
//找出所有下级子目录。
if (FindFirst(mainpath+'*.*', faDirectory, SearchRec)=0) then
begin
if IsValidDir(SearchRec) then
subdir1.Add(SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
if IsValidDir(SearchRec) then
subdir1.Add(SearchRec.Name);
end;
end;
FindClose(SearchRec);
//查找当前目录。
if FileExists(mainpath+filename) then
begin
found:=true;
foundresult.Add(mainpath+filename);
end;
//这是递归部分，查找各子目录。
for i:=0 to subdir1.Count-1 do
found:=Searchfile(mainpath+subdir1.Strings[i]+
'\',Filename,foundresult)or found;
//资源释放并返回结果。
subdir1.Free;
end;
result:=found;
end;

[peterzhu1999]

用于显示查找的内容的可以放在TREEVIEW中吗？
在这里面点击能不能显示他的内容的

[peterzhu1999]

function SearchFile(mainpath, filename: string;
var foundresult: TStrings): Boolean;
var
i: integer;
Found: Boolean;
subdir1: TStrings;
searchRec: TsearchRec;
begin
if GetStrRight(mainpath, 1) <> '\' then mainpath := mainpath + '\';//自己写的，关键判断是否最后一个字符是“\”，你可以自己改一下。
found := False;
if Trim(filename) <> '' then
begin
subdir1 := TStringList.Create;
if (FindFirst(mainpath + '*.*', faDirectory, SearchRec) = 0) then
begin
if (DirectoryExists(mainpath + SearchRec.Name)) and (SearchRec.Name <> '.')
and (SearchRec.Name <> '..') then subdir1.Add(SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
if (DirectoryExists(mainpath + SearchRec.Name)) and (SearchRec.Name <> '.')
and (SearchRec.Name <> '..') then subdir1.Add(SearchRec.Name);
end;
end;
FindClose(SearchRec);
//²éÕÒµ±Ç°Ä¿Â¼¡£
if (FindFirst(mainpath + filename, faAnyFile - faDirectory, SearchRec) = 0) then
begin
foundresult.Add(mainpath + SearchRec.Name);
while (FindNext(SearchRec) = 0) do
begin
foundresult.Add(mainpath + SearchRec.Name);
end;
end;
FindClose(SearchRec);
for i := 0 to subdir1.Count - 1 do
found := Searchfile(mainpath + subdir1.Strings[i] + '\', Filename, foundresult) or found;
subdir1.Free;
end;
Result := found;
end;




procedure TForm1.Button1Click(Sender: TObject);
var
ss: TStrings;
begin
ss := TStringList.Create;
SearchFile('C:\whsh\', 'qwe.txt', ss);
memo1.Lines.AddStrings(ss); //在MEMO中实现显示
ss.Free;
end;


在TREEVIEW中实现显示的内容因该如何解决，

[chenylin]

使用FileFinder控件。FileFinder是一个目录搜索的VCL控件,可以实现带子目录和通配符的查找。

[dickeybird888]

我给你个显示目录下所有文件名的例子吧！
procedure TForm1.Button1Click(Sender: TObject);
var
SearchRec:TSearchRec;
ext,AppPath:string;
begin
listbox1.Items.Clear;
AppPath:='d:\aa\';
ext:='*.*';
FindFirst(AppPath+ext,faAnyFile-faDirectory,SearchRec);
listbox1.Items.Add(SearchRec.Name);
while FindNext(SearchRec)=0 do
listbox1.Items.Add(SearchRec.Name);
listbox1.items为你需要的结果
end;

[peterzhu1999]

谢谢
我现在能够找到我需要的东西
我现在想做的事是在点击我找到的文件，能够打开这个文件

这个在WINDOWS下是很常见的啊

[peterzhu1999]

希望各位大哥能指点一二

在下以前是做C的，关于这个的编程一点都不会，麻烦帮一把

[荣爵]

说得这么清楚

我也接接分啦

[fj218]

正好我写了个类似程序，代码单元已经完成，但界面单元还未完成。我觉得查找文件不难，关键是支持通配符的问题。