PDA

View Full Version : مشکل با جستجوی فایل



مجتبی جوادی
شنبه 27 مهر 1392, 08:44 صبح
دوستان درود
من دنبال برنامه ای برای جستجوی فایل ها میگشتم و دوستان زحمت کشیدند و چند نمونه را توضیح داده اند که تقریبا همه آنها شبیه هم هستند . خودم هم در سایت های خارجی چند نمونه پیدا کرم ولی همه این کدها دارای یک مشکل مشترک هستند و آن اینکه داخل پوشه هایی با نام فارسی را جستجو نمی کنند ! ممنون میشم اگر کسی از این موضوع اطلاع داره توضیح بده.
با تشکر

یوسف زالی
شنبه 27 مهر 1392, 11:49 صبح
جستجو می کنند!
نمونه کد رو بگذارید بگم چطوری..

مجتبی جوادی
شنبه 27 مهر 1392, 19:44 عصر
مثلا کد زیر
procedure TMainFrm.FileSearch(const PathName, FileName : string;ID: integer);
var
Rec: TSearchRec;
Path: string;
begin
Path := IncludeTrailingPathDelimiter(PathName);
if FindFirst(Path + FileName, faAnyFile - faDirectory , Rec) = 0 then
begin
try
repeat
ListBox1.Items.Add(Path + Rec.Name);
FoundsCount := FoundsCount + 1;
Application.ProcessMessages;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end;
if CheckBox1.Checked then
if FindFirst(Path + '*.*', faDirectory, Rec) = 0 then
begin
try
repeat
if ((Rec.Attr and faDirectory) <> 0) and (Rec.Name<>'.') and (Rec.Name<>'..') then
begin
FileSearch(Path + Rec.Name, FileName);
Application.ProcessMessages;
end;
until FindNext(Rec) <> 0;
finally
FindClose(Rec);
end;
end;
end;

یوسف زالی
شنبه 27 مهر 1392, 20:04 عصر
شما باید از ورژن های یونیکد توابع استفاده کنید.
برای مثال تابع FindFirst از تابع FindFirstFile استفاده می کنه که ورژن های مختلفی داره:



function FindFirstFile; external kernel32 name 'FindFirstFileA';
function FindFirstFileEx; external kernel32 name 'FindFirstFileExA';
function FindFirstFileA; external kernel32 name 'FindFirstFileA';
function FindFirstFileExA; external kernel32 name 'FindFirstFileExA';
function FindFirstFileW; external kernel32 name 'FindFirstFileW';
function FindFirstFileExW; external kernel32 name 'FindFirstFileExW';

مجتبی جوادی
شنبه 27 مهر 1392, 20:11 عصر
ممنون میشم اگه یک نمونه کوچک را بیشتر توضیح بدهید

یوسف زالی
شنبه 27 مهر 1392, 23:49 عصر
شما باید توابع رو برای ورژن های یونیکد بازنویسی کنید. تابعی رو که گفتم یکیش بود، FindNext بعدیش هست.
با نگه داشتن کنترل روی این کلمه رو کلیک روش، می رید به تعریف تابع.
باید تابعی دقیقا عین همین بنویسید با این تفاوت که از FindFirstFileW استفاده کنه و ورودی رشته هاش WideString باشه..
موفق باشید.

مجتبی جوادی
دوشنبه 29 مهر 1392, 19:08 عصر
دورد دوباره
آقا من هر کاری کردم نتونستم انجام بدم لطفا راهنمایی بیشتر کنید
با سپاس از شما

مجتبی جوادی
چهارشنبه 01 آبان 1392, 13:13 عصر
درود دوباره
لطفا اگر کسی میتونه کمک کنه
من کد زیر را هم نوشتم ولی فقط فایلها و پوشه های Root را جستجو می کند
procedure FindMyFile(FList: TString; fPath: string; fName: string);
var
Se : PWideChar;
Handle : THandle;
FFData: WIN32_FIND_DATAW;
begin
Se:=PWideChar(fPath+fName);
FFData.dwFileAttributes := FILE_ATTRIBUTE_DIRECTORY;
Handle := FindFirstFileW(Se,FFData);
if Handle<>INVALID_HANDLE_VALUE then
try
repeat
FList.Add(FFData.cFileName);
until FindNextFileW(Handle,FFData)=False;
finally
Windows.FindClose(Handle);
end;
end;

با سپاس

SayeyeZohor
چهارشنبه 01 آبان 1392, 20:22 عصر
http://forum.delphiarea.com/download/file.php?avatar=2_1261219853.jpg
kambiz@delphiarea.com
http://www.delphiarea.com

من بعد كلي گشت زني تو نت كامپوننت TFindFileW v4.12 - TNT Unicode Controls Version از دوست عزيز آقاي Kambiz R. Khojasteh "كامبيز خجسته" رو پيدا كردم
FindFile Component Version 4.12 August 10, 2010 (http://www.delphiarea.com/products/delphi-components/findfile/)

متاسفانه بايد براي استفاده از سورس كد ايشون بايد از يك كامپوننت TNT Unicode Controls استفاده كنيم كه اگه اشتباه نكنم براي دلفي نسخه xe4 نتونستم پيدا كنم مجبور شدم با يك كم دست كاري و استفاده از چند تا فانكشن هاي TNT Unicode Controls سورس رو اجرا كنم :گیج:

نتيجه كار :
دمو به صورت جستجوي معمولي و جستجوي Unicode دانلود : 112150
پكيج FindFileWv4.12 جهت دانلود : 112151

یوسف زالی
چهارشنبه 01 آبان 1392, 21:42 عصر
اووووووووووه..
چقد سختش کردید،


function StrMatch(const str, mask: AnsiString) : boolean;
var cs, cm : PAnsiChar;
ms, mm : PAnsiChar;
b1 : boolean;
begin
cm := PAnsiChar(mask);
result := (cm[0] = '*') and (cm[1] = #0);
if not result then begin
cs := PAnsiChar(str);
ms := cs;
mm := cm;
b1 := false;
while (cm^ <> #0) or (cs^ <> #0) do begin
if cm^ = #0 then
exit;
if cs^ = #0 then begin
while cm^ <> #0 do begin
if cm^ <> '*' then
exit;
inc(cm);
end;
break;
end;
case cm^ of
'*': if cm[1] <> #0 then begin
b1 := true;
inc(cm);
ms := cs + 1;
mm := cm;
end else
break;
'?': begin
inc(cs);
inc(cm);
end;
else if cm^ <> cs^ then begin
if b1 then begin
cm := mm;
cs := ms;
inc(ms);
end else
exit;
end else begin
inc(cs);
inc(cm);
end;
end;
end;
result := true;
end;
end;

procedure Surf(Path, Find: string; Lst: TStrings);
var
F: TSearchRec;
begin
if FindFirst(Path + '\*', faAnyFile, F) = 0 then
begin
if DirectoryExists(Path + '\' + F.Name) then
begin
if (F.Name <> '.') and (F.Name <> '..') then
Surf(Path + '\' + F.Name, Find, Lst);
end
else if StrMatch(UpperCase(F.Name), UpperCase(Find)) then
Lst.Add(Path + '\' + F.Name);

while FindNext(F) = 0 do
if DirectoryExists(Path + '\' + F.Name) then
begin
if (F.Name <> '.') and (F.Name <> '..') then
Surf(Path + '\' + F.Name, Find, Lst);
end
else if StrMatch(UpperCase(F.Name), UpperCase(Find)) then
Lst.Add(Path + '\' + F.Name);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Surf('d:\temp', '*', Memo1.Lines);
end;


StrMatch برگرفته از سورس MadShi می باشد و تابع بعدی کار من. بنابراین خیلی خیلی احتمال داره تابعی که نوشتم رو بهینه تر بتونید کنید.

اینجا رو ببینید:
http://help.madshi.net/StringCompare.htm
چندین بار تست کردم، کار می کنه.
یکمی تلاش می کردید با یونیکد ورژن می تونستید به جاهای خوبی برسید ها! ولی این قطعه کد کارتون رو راه می ندازه.
موفق باشید.

سید جان عیدت مبارک!
شیرینی ما یادت نره :چشمک:

مجتبی جوادی
یک شنبه 05 آبان 1392, 09:14 صبح
درود بر دوستان
از اینکه زحمت کشیدید سپاسگزارم
من با کامپوننتی که جناب سید قرار داده بودند و با کمی تغییرات مشکلم حل شد ولی برای اینکه آقا یوسف هم زحمت کشیده بودند کد ایشان را هم امتحان کردم . خوب بود ولی یک ایراد دارد و آن اینکه اسم پوشه های فارسی را در مسیرشان ثبت نمی کند یعنی در داخل memo فقط نام فایل به اضافه درایو مورد جستجو را ثبت می کند که نشان می دهد فایل جستجو شده در داخل root میباشد و این اشتباه است درصورتی که فایل در داخل یک پوشه با نام فارسی قرارداد.

مجتبی جوادی
یک شنبه 05 آبان 1392, 10:41 صبح
درود دوباره
من این مشکل را در FileCopy هم پیدا کردم . فایلهایی که در پوشه هایی با نام فارسی هستند هم کپی نمی شوند! آیا دوستان در این مورد هم اطلاع دارند
با سپاس از شما