معرفة إذا ما كان البرنامج يشتغل من الإختصار أو من مسار آخر

[أبو معاذ]

السلام عليكم ورحمة الله وبركاته ،
بكل بساطة أنشئ إختصار على سطح المكتب لتنفيذ برنامجي .
لكن عند بعض الزبائن يقوم بحذف الاختصار و يقوم بنسخ ولصق البرنامج مباشرة على سطح المكتب ،
لذلك  الأمر التالي :
ExtractFilePath(Application.ExeName)
لا يعطي المجلد المرغوب فيها و الذي يحوي على قاعدة البيانات + ملافات أخرى لازمة لتشغيل البرنامج.
وإنما التعليمة السابقة تعطي مجلد سطح المكتب.  
لذلك أرغب في كيفية معرفة إذا كان البرنامج ينفذ من اختصاره على سطح المكتب أو من غير ذلك.
جزاكم الله خيرا.

[محمد الدرة]

اعمل في البرنامج اول مرة يشتغل يتم تحديد مسار قاعدة البيانات ويتم حفظها في الرجستري او ملفINI وبعدها يتم التشييك على المسار

[أبو معاذ]

اعمل في البرنامج اول مرة يشتغل يتم تحديد مسار قاعدة البيانات ويتم حفظها في الرجستري او ملفINI وبعدها يتم التشييك على المسار

شكرا على الرد ،
المشكلة ليس في تعيين مسار قاعدة البيانات ، فالمسار أعينه في ملف نصي مشفر.
لكن أظنني وجدت الحل و لو كان بسيطا.
الحال هو معرفة إذا كان ملفا (وليكن ملف نصي)  موجودا إذا التطبيق يشتغل ، وفي حالة عدم وجود الملف التطبيف لا يشتغل.

كود :

 if FileExists(ExtractFilePath(Paramstr(0))+'toto.txt') then       showmessage('OK')  else  showmessage('Not OK');

[محمد عبد العزيز]

السلام عليكم ورحمة الله

كما ورد في مقدمة مدلة دلفي العدد 8 لا تجعل برنامجك صخرة صماء
ابحث عنه في نفس مكان الملف التنفيذي
ان لم تجده في Program Files
ان لم تجد في C حاول في الD ان وجد
ان جربت كل ما سبق اظهر رسالة للمستخدم تساله أين توجد قاعدة البيانات
عندما تجدها احفظ مكانها في الRegistry او مسار ثابت

[أبو معاذ]

شكرا على تفاعلكم ،
لكن المقصود هو معرفة إذا كان البرنامج ينفذ من مجلد التنصيب (من اختصاره على سطه المكتب ) أو أن الزبون قام بنسخ الملف التنفيذي مباشرة على سطح المكتب .
وجدت حلا آخر ربما يستفيد منه الإخوة ،
هو البحث على كلمة Desktop  داخل مسار الملف التنفيذي ،
إذا وجدت الكلمة فمعنى ذلك أن البرنامج موجود مباشرة على سطح المكتب ،
وإذا لم توجد الكلمة ، معنى ذلك أن البرنامج نُفذ من اختصاره على سطح المكتب.

كود :

  if Pos('Desktop', ExtractFilePath(Paramstr(0))) = 0 then      ShowMessage('ليس إختصار على  سطح المكتب')   else     ShowMessage('هذا اختصار على سطح المكتب');

[Agmcz]

وعليكم السلام
معرفة إذا تم تشغيل من إختصار أو لا

PHP كود :

// https://stackoverflow.com/questions/36267584/delphi-where-is-the-shortcut-that-started-the-application

program GetShortCutTest;

{$APPTYPE CONSOLE}

uses
  Windows;

const
  STARTF_TITLEISLINKNAME = $800;

function GetShortcutName(out LinkName: string): Boolean;
var
  si: TStartupInfo;
begin
  Result := False;
  FillChar(si, SizeOf(TStartupInfo), 0);
  GetStartupInfo(si);
  if (si.dwFlags and STARTF_TITLEISLINKNAME) <> 0 then
  begin
    Result := True;
    LinkName := PChar(si.lpTitle);
  end;
end;

var
  sLink: string;

begin
  if GetShortcutName(sLink) then
    WriteLn('Shortcut: ' + sLink)
  else
    WriteLn('Not run from shortcut.');

  ReadLn;
end. 


[أبو معاذ]

وعليكم السلام
معرفة إذا تم تشغيل من إختصار أو لا

PHP كود :

// https://stackoverflow.com/questions/36267584/delphi-where-is-the-shortcut-that-started-the-application

program GetShortCutTest;

{$APPTYPE CONSOLE}

uses
  Windows;

const
  STARTF_TITLEISLINKNAME = $800;

function GetShortcutName(out LinkName: string): Boolean;
var
  si: TStartupInfo;
begin
  Result := False;
  FillChar(si, SizeOf(TStartupInfo), 0);
  GetStartupInfo(si);
  if (si.dwFlags and STARTF_TITLEISLINKNAME) <> 0 then
  begin
    Result := True;
    LinkName := PChar(si.lpTitle);
  end;
end;

var
  sLink: string;

begin
  if GetShortcutName(sLink) then
    WriteLn('Shortcut: ' + sLink)
  else
    WriteLn('Not run from shortcut.');

  ReadLn;
end.

جزاك الله خيرا على المشاركة،
لقد رأيت هذا الكود من قبل ، لكننه لم يشتغل معي في دلفي 7 


[Agmcz]

وهل اشتغل معك الان؟

[أبو معاذ]

بيض الله وجهك.
نعم يشتغل 100%100