البحث عن الملفات

[King SofT]

بسم الله الرحمان الرحيم

السلام عليكم

عندي كود سورس لبرنامج بحث عن ملفات حيث اكتب في المحرر(edit1) اسم الملف متببوع بنوعه مثل image.bmp فيتم البحث عنه

السؤال : هل يمكنني ان اجعل هذا البرنامج يبحث عن كل ملفات jpeg او نوع نحدد دون كتابت الاسم
بمعنى ان اكتفي بكتابة .jpeg في edit1

procedure TForm1.Rechercher(Disq,Sh:String);
Var Sr: TSearchRec;
begin
//Recherche les répertoires
if FindFirst(Disq+'*.*',faAnyFile,Sr)=0 then //Commence la recherche
begin
if (Sr.Attr and faDirectory>0) and (Sr.Name[1]<>'.') then //Si on a trouve un dossier
Rechercher(Disq+Sr.Name+'\',Sh); //Appel la procédure "Rechercher"
while FindNext(Sr)=0 do //Tant que l'on trouve...
begin
if (Sr.Attr and faDirectory>0) and (Sr.Name[1]<>'.') then
Rechercher(Disq+Sr.Name+'\',Sh);
end;
FindClose(Sr); //Libère la mémoire allouée par FindFirst
end;

//Recherche le fichier dans les différents répertoires
if FindFirst(Disq+Sh,faAnyFile,Sr)=0 then
begin
if (Sr.Attr and faAnyFile)=Sr.Attr then
ListBox1.Items.Add(Disq+Sr.Name); //Affiche les fichiers dans le Memo1
while FindNext(Sr)=0 do
begin
if (Sr.Attr and faAnyFile)=Sr.Attr then
ListBox1.Items.Add(Disq+Sr.Name);
end;
FindClose(Sr);
end;

end;

[husseint]

السلام عليكم

أضف هذا التابع إلى برنامجك

function FindIn(S1, S2: String): Boolean;
var
Len : Integer;
I: Integer;
S: String;
begin
result:= False;
Len:= Length(S2);
for I:=1 to Length(S1) do
begin
S:= Copy(S1, I, Len);
if S = S2 then
begin
result:= True;
Break;
end;
end;
end;

أضف هذا السطر إلى الكود

procedure TForm1.Rechercher(Disq,Sh:String);
Var Sr: TSearchRec;
begin
//Recherche les répertoires
if FindFirst(Disq+'*.*',faAnyFile,Sr)=0 then //Commence la recherche
begin
if (Sr.Attr and faDirectory>0) and (Sr.Name[1]<>'.') then //Si on a trouve un dossier
Rechercher(Disq+Sr.Name+'\',Sh); //Appel la procédure "Rechercher"
while FindNext(Sr)=0 do //Tant que l'on trouve...
begin
if FindIn(Sr.Name, '.bmp') then
ListBox1.Items.Add(Sr.Name);
if (Sr.Attr and faDirectory>0) and (Sr.Name[1]<>'.') then
Rechercher(Disq+Sr.Name+'\',Sh);
end;
FindClose(Sr); //Libère la mémoire allouée par FindFirst
end;

[husseint]

جرب فقط هذا التغير أعتقد أنه أسلس

if PosEX('.bmp', Sr.Name, 1)>0 then
ListBox1.Items.Add(Sr.Name);

[kachwahed]

وعليكم السلام ورحمة الله
الخوارزمية التي نقلتها من هنا:
http://files.codes-sources.com/fichier.aspx?id=21894&f=WinAmp+Controler\WinAmpControlerMain.pas
صحيحة. فقط ينبغي عليك معرفة استخدامها:
procedure TForm1.Rechercher(Disq, Sh: string);
var
Sr: TSearchRec;
begin
//Recherche les répertoires
if FindFirst(Disq + '*.*', faAnyFile, Sr) = 0 then //Commence la recherche
begin
if (Sr.Attr and faDirectory > 0) and (Sr.Name[1] <> '.') then //Si on a trouve un dossier
Rechercher(Disq + Sr.Name + '\', Sh); //Appel la procédure "Rechercher"
while FindNext(Sr) = 0 do //Tant que l'on trouve...
begin
if (Sr.Attr and faDirectory > 0) and (Sr.Name[1] <> '.') then
Rechercher(Disq + Sr.Name + '\', Sh);
end;
FindClose(Sr); //Libère la mémoire allouée par FindFirst
end;

//Recherche le fichier dans les différents répertoires
if FindFirst(Disq + Sh, faAnyFile, Sr) = 0 then
begin
if (Sr.Attr and faAnyFile) = Sr.Attr then
ListBox1.Items.Add(Disq + Sr.Name); //Affiche les fichiers dans le ListBox1
while FindNext(Sr) = 0 do
begin
if (Sr.Attr and faAnyFile) = Sr.Attr then
ListBox1.Items.Add(Disq + Sr.Name);
end;
FindClose(Sr);
end;

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Rechercher('d:\Video\', '*.flv');
end;

بمعنى ان اكتفي بكتابة .jpeg في edit1
نعم، تكتب jpeg.*

مثال البحث عن الملفات:
http://www.delphi4arab.com/forum/showpost.php?p=15293&postcount=8
هناك المزيد ابحث في المنتدى

بالتوفيق.

[King SofT]

جزاكم الله خيرا اخوتي اجوبة شافية كعادتكم