+- delphi4arab منتديات دلفي للعرب (https://delphi4arab.net/forum)
+-- قسم : منتديات دلفي للعرب التعليمية (https://delphi4arab.net/forum/forumdisplay.php?fid=3)
+--- قسم : سؤال و جواب حول دلفي (https://delphi4arab.net/forum/forumdisplay.php?fid=15)
+--- الموضوع : البحث عن الملفات (/showthread.php?tid=2331)
البحث عن الملفات - King SofT - 20-08-2010
بسم الله الرحمان الرحيم
السلام عليكم
عندي كود سورس لبرنامج بحث عن ملفات حيث اكتب في المحرر(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 - 20-08-2010
السلام عليكم
أضف هذا التابع إلى برنامجك
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 - 20-08-2010
جرب فقط هذا التغير أعتقد أنه أسلس
if PosEX('.bmp', Sr.Name, 1)>0 then
ListBox1.Items.Add(Sr.Name);
البحث عن الملفات - kachwahed - 20-08-2010
وعليكم السلام ورحمة الله
الخوارزمية التي نقلتها من هنا:
كود :
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/showpost.php?p=15293&postcount=8
هناك المزيد ابحث في المنتدى
بالتوفيق.
البحث عن الملفات - King SofT - 20-08-2010
جزاكم الله خيرا اخوتي اجوبة شافية كعادتكم