نمایش نام و پسوند فایل انتخاب شده

[hector2000]

سلام
می خواهم برنامه ای بنویسم که با کلیک بر روی هر فایلی در ویندوز اسم ان و پسوندش را در یک لیبل نمایش دهد.
یک کدی دارم که میتونم کپشن پنجره فعال را نمایش دهد ولی من در اصل می خواهم نام و پسوند فایل کلیک شده در پنجره فعال را نمایش دهم

function ActiveCaption: string;



var

  Handle: THandle;

  Len: LongInt;

  Title: string;



begin

  Result := '';

  Handle := GetForegroundWindow;

  if Handle <> 0 then

  begin

    Len := GetWindowTextLength(Handle) + 1;

    SetLength(Title, Len);

    GetWindowText(Handle, PChar(Title), Len);

    ActiveCaption := TrimRight(Title);

  end;

end;



procedure TForm1.Timer1Timer(Sender: TObject);

begin

  Label1.Caption := ActiveCaption;

end;

[Mask]

کلیک یا دابل کلیک؟

[hector2000]

منظورم ایتم فعال است.(کلیک شده)
در این تاپیک این مبحث چند سال پیش مطرح شده ولی متاسفانه به نتیجه خاصی نرسید .
من تصمیم نداشتم تاپیک چند سال پیش را زنده کنم چون خیلی از لینکهای ان دیگر معتبر نیست
برنامه ای که در پست اول بصورت کامپایل شده قرار دادند دقیقا همانی است که می خواهم ولی متاسفانه فایلهای مورد نظرش دیگر پیدا نمی شود
همچنین در آخرین پست این لینک گذاشته شده که اصلا در دلفی اجرا نمی شود.
در این لینک هم این کار به نظر با توضیحات در زبان سی ++ انجام شده ولی متاسفانه باید به دلفی تبدیل شود
خواستم یکبار برای همیشه این مساله را با کمک دوستان و به امید خدا به نتیجه برسانیم

[hp1361]

منظورم ایتم فعال است.(کلیک شده)
در این تاپیک این مبحث چند سال پیش مطرح شده ولی متاسفانه به نتیجه خاصی نرسید .
من تصمیم نداشتم تاپیک چند سال پیش را زنده کنم چون خیلی از لینکهای ان دیگر معتبر نیست
برنامه ای که در پست اول بصورت کامپایل شده قرار دادند دقیقا همانی است که می خواهم ولی متاسفانه فایلهای مورد نظرش دیگر پیدا نمی شود
همچنین در آخرین پست این لینک گذاشته شده که اصلا در دلفی اجرا نمی شود.
در این لینک هم این کار به نظر با توضیحات در زبان سی ++ انجام شده ولی متاسفانه باید به دلفی تبدیل شود
خواستم یکبار برای همیشه این مساله را با کمک دوستان و به امید خدا به نتیجه برسانیم

سلام

مثال و یونیتی که در لینک اشاره شده توسط شما گذاشته شده رو روی ویندوز 10تست کردم و درست کار کرد.

2016-12-13_11-12-11.jpg

مشکل شما کجاست؟ یونیت توابع هم که موجود بود. گفتین فایل هاش نیست منظورتون چیه؟

موفق باشیم

[hp1361]

گویا توابع مورد نیاز به دلفی اضافه شده(نسخه دلفی بنده XE8 می باشد.

برنامه نوشته شده با استفاده از یونیت آقای مهری و بدون یونیت های اشاره شده در تاپیک مذکور که بدرستی روی سیستم من(ویندوز 10 64 بیتی) کار میکنه رو به پیوست ارسال می کنم.

2016-12-13_11-32-41.jpg

موفق باشیم

[hector2000]

نسخه دلفی من 7 است و توابعی که اقای مهری اشاره کردن در ان وجود ندارد.
اگر ممکن است این توابع را برای دانلود بگذارید
موقع کامپایل این ارور را می دهد
[Fatal Error] GEAP.pas(8): File not found: 'ShLwApi.dcu'

ایا دوستان این کد را هم می توانند اجرا کنند؟

[Mahmood_M]

خوشبختانه سورس یونیتهای دلفی در دسترس هست و می تونید نسخه جدید یونیتها رو به پروژه تون اضافه کنید
پروژه ویرایش شده همراه با فایل اجرایی ضمیمه شد
در دلفی XE 6 و ویندوز 8 تست شد و مشکلی نبود

[hector2000]

ممنونم.
در موقع اجرا این ارور پیش می اید
[Fatal Error] ShlObj_New.pas(28): File not found: 'Winapi.Windows.dcu'

فکر کنم این پروژه در دلفی 7 دیگه قابل اجرا نیست

جناب مهری من توابعی که در پست اولتون گفته بودید پیدا کردم و به پروژه ام اضافه کردم ولی این ارور زیر پیش می اید
[Error] GEAP.pas(142): Types of actual and formal var parameters must be identical

خط کد 142:
StrRetToBuf(@Str, Pointer(pidlItem), Result, MAX_PATH);

شما این پروژه را اولین بار در دلفی 7 نوشتید؟

[Mahmood_M]

توابع مورد نیاز به یونیتهای جدید دلفی اضافه شده، من نسخه جدید یونیتها رو به پرژه اضافه کردم، اما این یونیتها به صورت داخلی از یونتهای دیگه استفاده کردن، اون دو یونیت رو باز کنید و پیشوند WinApi رو از نام یونیتهایی که درونشون Use شدن حذف کنید، احتمالا مشکل اول حل خواهد شد
البته نام برخی یونیتهای دیگه هم تغییر کرده باشه، چون در حال حاضر دلفی 7 روی سیستم ندارم که تست کنم
برای مشکل دوم، پیغام خطا به دلیل اختلاف نوع Char در دلفی 7 و نسخه های جدید هستش، در دلفی 7 یونیکد پشتیبانی نمیشه و نوع Char از نوع AnsiChar تعریف شده ولی در نسخه های جدید نوع Char برای پشتیبانی از یونیکد به WideChar تغییر کرده، متناسب با همین قضیه، توابعی که از نوع Char استفاده میکنند برای نوع WideChar بهینه سازی و تصحیح شدن
پیغام خطای دوم هم ظاهرا به همین دلیل نمایش داده میشه و به این دلیله که متغیر Result برای استفاده در تابع جدید باید از نوع WideChar باشه اما در دلفی 7 متغیر Result از نوع AnsiChar هست
مقدار MChar که به صورت آرایه ای از Char به عنوان یک Type تعریف شده رو به صورت آرایه ای از WideChar تغییر بدید ببینید مشکل حل میشه :

TMChar = array[0..MAX_PATH] of WideChar;

پ.ن : پیشنهاد می کنم از دلفی 7 دل بکنید و از نسخه های جدید استفاده کنید

[Mahmood_M]

تغییرات رو اعمال کردم، پروژه جدید رو ضمیمه کردم، تست کنید ببینید کامپایل میشه ؟

[hector2000]

ممنونم از لطفی که به بنده دارید.
در مثالی که گذاشتید ارور زیر پدیدار میشود:
[Fatal Error] ShlObj_New.pas(29): File not found: 'ObjectArray.dcu'

تغییرات در مورد tmchar باعث ارور زیر شد
[Error] GEAP.pas(57): Incompatible types: 'TMChar' and 'PAnsiChar'

خط 57 کد:
if not SHGetPathFromIDList(pidlFolder, Result) then
ارور بعدی با همین عنوان ولی این خط:
StrCopy(Result, '<?? ???????>');

[hector2000]

این سوال را در این سایت نیز مطرح کردم و دوستی از یک شیوه جدید برای این کار استفاده کرده که البته باز هم در دلفی 7 قابل اجرا نیست.ایا دوستان نظری در این مورد دارند؟

[Mahmood_M]

اگر همون یونیتهای مجموعه JEDI رو گیر بیارید برای دلفی 7 ، می تونید از همون نسخه اولیه که قرار داده شده توی تاپیک استفاده کنید، مشکل اصلی در پشتیبانی Unicode هست که به صورت داخلی درون توابع هم اعمال شده، بررسی و تغییر خود توابع استفاده شده کار زمان بریه و مهمتر از اون اینکه دلفی 7 روی سیستم ندارم تا بتونم تست کنم
چرا از نسخه هی جدید دلفی استفاده نمی کنید ؟

[hector2000]

سلام.ممنونم از شما دوست عزیز
من تمام یونیتهای مجموعه jedi را پیدا کرده و استفاده کردم و این ارورها بعد از بکارگیری از ان ایجاد شده.
ارورهای اول مربوط به پروژه دوم شما است که لطف کردید و قرار دادید و ارورهای دوم مربوط به اولین پروژه است
من فکر نمی کنم پروژه اول را با دلفی 7 نوشته باشید.چون در این محیط به ارور منجر میشود.
متاسفانه از دلفی 2007 به بعد حجم فایلهای کامپایل شده به شدت افزایش می یابد و من با این مساله مشکل دارم.همچنین یکسری توابعی دارم که تنها با این نسخه بدرستی کار می کند و نتوانستم با نسخه های جدید منطبقش کنم.

[Mask]

اقای مهری. ای کاش این مانیتورینگ روی انتخاب فایل بر روی دسکتاپ هم کار میکرد.

[hector2000]

بعد از اجرای فایل اجرایی افای مهری هر پنجره ای که بسته میشود یک ارور ظاهر میشود.ایا سایر دوستان هم این مساله را تایید می کنند؟

[hector2000]

بالاخره بعد از کلی کند و کاش و تحقیق موفق شدم این برنامه را بنویسم.(البته با کمک دوستان در سایتهای خارجی)

ابتدا می بایستی از طریق منوی Component Menu اکنیو اکس Microsoft Internet Controls را به پروژتون اضافه کرد با انجام این کار یونیت SHDocVW_TLB به پروژه الحاق میشه و می بایستی در بخش use نام SHDocVW_TLB و activex را اضافه کرد. در ادامه می بایستی دو تابع زیر را به برنامه اضافه کنید:


function isexplorerwindow(exwnd: hwnd): boolean;
var
p:array[0..max_path]of Char;
begin
GetClassName(exwnd, p, SizeOf(p));
result :=((strcomp(p,'CabinetWClass')=0)or(strcomp(p,'ExploreWClass')=0));
end;


function getexplorerselectedfile(exwnd: hwnd; nr: integer): string;
var
pvShell: IShellWindows;
pvWeb2: IWebBrowser2;
ovIE: OleVariant;
psp: IServiceProvider;
psb: IShellBrowser;
isw: IShellView;
ido: IDataObject;
FmtEtc: TFormatEtc;
Medium: TStgMedium;
dwcount: integer;
n: integer;
p:array[0..max_path]of Char;
s: string;
found: boolean;
begin
found :=false;
result :='';
s :='';
try
pvShell := CoShellWindows.Create;
for dwcount :=0to Pred(pvShell.count)do
begin
ovIE := pvShell.Item(dwcount);
if(ovIE.hwnd = exwnd)or((exwnd =0)and isexplorerwindow(ovIE.hwnd))then
begin
found :=true;
if(IDispatch(ovIE).QueryInterface(IWebBrowser2, pvWeb2)= S_OK)then
begin
psp :=(pvWeb2 as IServiceProvider);
psp.QueryService(IID_IShellBrowser, IID_IShellBrowser, psb);
psb.QueryActiveShellView(isw);
if isw.GetItemObject(SVGIO_SELECTION, IDataObject, pointer(ido))= S_OK then
begin
try
FmtEtc.cfFormat := CF_HDROP;
FmtEtc.ptd :=nil;
FmtEtc.dwAspect := DVASPECT_CONTENT;
FmtEtc.lindex :=-1;
FmtEtc.tymed := TYMED_HGLOBAL;
ido.GetData(FmtEtc, Medium);
GlobalLock(Medium.hGlobal);
try
n := DragQueryFile(Medium.hGlobal,$FFFFFFFF,nil,0);
if nr < n then
begin
DragQueryFile(Medium.hGlobal, nr, p, max_path);
s := strpas(p);
end;
finally
DragFinish(Medium.hGlobal);
GlobalUnLock(Medium.hGlobal);
end;
finally
ReleaseStgMedium(Medium);
end;
end;
pvWeb2 :=nil;
end;
end;
ovIE := Unassigned;
if found then
break;
end;
pvShell :=nil;
finally
result := s;
end;
end;
در بخش use هم این متن میبایستی اضافه شود


USES SHDocVW_TLB, ShlObj, activex, shellapi;

حالا تو فرم برنامه یک button و یک memo اضافه کنید و کد زیر را در event فشرده شدن دکمه قرار دهید


PROCEDURE TForm2.Button1Click(Sender: TObject);
VAR
wnd, exwnd: hwnd;
n: integer;
s: STRING;
BEGIN
exwnd :=0;
wnd := getwindow(getdesktopwindow, gw_child);
REPEAT
IF isexplorerwindow(wnd)THEN
BEGIN
exwnd := wnd;
break;
END;
wnd := getwindow(wnd, gw_hwndnext);
UNTIL(wnd =0)OR(exwnd <>0);
IF exwnd <>0THEN
BEGIN
n :=0;
REPEAT
s := getexplorerselectedfile(exwnd, n);
memo1.Lines.Add(s);
inc(n);
UNTIL s ='';
END;
END;

برنامه با فشردن شدن دکمه نام فایل انتخاب شده در پنجره فعال را در memo اضافه می کند.
خواستم بخشهای برنامه نویسی را در تگ code قرار دهم ولی کل متن به هم می ریخت.در هر صورت ببخشید کدها را به این صورت گذاشتم
موفق باشید