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

[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]

السلام عليكم

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

PHP كود :

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; 


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

PHP كود :

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.net/forum/showpos...ostcount=8
هناك المزيد ابحث في المنتدى

بالتوفيق.

[King SofT]

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