Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ] > Код на шару!
Перезагрузить страницу

определить путь по которому была запущена программа

Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 25.01.2017, 10:21
bambus bambus вне форума
Прохожий
  
Регистрация: 25.01.2017
Сообщения: 1
Версия Delphi: RAD STUDIO 10.1
Репутация: 10
По умолчанию определить путь по которому была запущена программа
Добрый день!
Подскажите пожалуйста, а лучше привести часть кода, чтобы определить расположение ярлыка по которму была запущена программа.
Цель - получить координаты этого ярлыка, чтобы форма программы была расположена точь-в-точь в начальных координатах ярлыка.
Еще точнее - хочу сделать замену вложенным папкам для группировки программ на рабочем столе (по аналогии с андроидом).
Ответить с цитированием
  #2  
Старый 25.01.2017, 18:32
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
  
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию
Цитата:
Сообщение от bambus
...определить путь по которому была запущена программа...

Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
unit Unit1;
{©Drkb v.3(2007): www.drkb.ru}
interface
 
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
 
type
TForm1 = class(TForm)
   Button1: TButton;
end;
 
var
Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses TlHelp32;
 
function GetExeFilePath(ExeFileName: String): String;
var
hSnapshot, hSnapshot2: THandle;
Proc: TProcessEntry32;
m: TModuleEntry32;
begin
Result := '';
hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0);
try
   proc.dwSize := Sizeof(proc);
   if Process32First(hSnapshot, proc) then
   repeat
     if AnsiSameText(proc.szExeFile, ExeFileName) then
     begin
       hSnapshot2 := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE,
         proc.th32ProcessID);
       try
         m.dwSize := SizeOf(TModuleEntry32);
         if Module32First(hSnapshot2, m) then
         begin
           Result := m.szExePath;
           Exit;
         end;
       finally
         CloseHandle(hSnapshot2);
       end;
     end;
   until not Process32Next(hSnapshot, proc);
finally
   CloseHandle(hSnapshot);
end;
end;
Цитата:
...определить расположение ярлыка по которму была запущена программа...
он скорее всего на рабочем столе, узнать подробную инфу из него
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
uses ShlObj, ComObj, ActiveX, CommCtrl;
type
PShellLinkInfoStruct = ^TShellLinkInfoStruct;
TShellLinkInfoStruct = record
   FullPathAndNameOfLinkFile: array[0..MAX_PATH] of Char;
   FullPathAndNameOfFileToExecute: array[0..MAX_PATH] of Char;
   ParamStringsOfFileToExecute: array[0..MAX_PATH] of Char;
   FullPathAndNameOfWorkingDirectroy: array[0..MAX_PATH] of Char;
   Description: array[0..MAX_PATH] of Char;
   FullPathAndNameOfFileContiningIcon: array[0..MAX_PATH] of Char;
   IconIndex: Integer;
   HotKey: Word;
   ShowCommand: Integer;
   FindData: TWIN32FINDDATA;
end;
 
procedure GetLinkInfo(lpShellLinkInfoStruct: PShellLinkInfoStruct);
var
ShellLink: IShellLink;
PersistFile: IPersistFile;
AnObj: IUnknown;
begin
// access to the two interfaces of the object
AnObj       := CreateComObject(CLSID_ShellLink);
ShellLink   := AnObj as IShellLink;
PersistFile := AnObj as IPersistFile;
 
// Opens the specified file and initializes an object from the file contents.
PersistFile.Load(PWChar(WideString(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile)), 0);
 
with ShellLink do
begin
   // Retrieves the path and file name of a Shell link object.
   GetPath(lpShellLinkInfoStruct^.FullPathAndNameOfFileToExecute,
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile),
     lpShellLinkInfoStruct^.FindData,
     SLGP_UNCPRIORITY);
 
   // Retrieves the description string for a Shell link object.
   GetDescription(lpShellLinkInfoStruct^.Description,
     SizeOf(lpShellLinkInfoStruct^.Description));
 
   // Retrieves the command-line arguments associated with a Shell link object.
   GetArguments(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute,
     SizeOf(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute));
 
   // Retrieves the name of the working directory for a Shell link object.
   GetWorkingDirectory(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy,
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy));
 
   // Retrieves the location (path and index) of the icon for a Shell link object.
   GetIconLocation(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon,
     SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfFileContiningIcon),
     lpShellLinkInfoStruct^.IconIndex);
 
   // Retrieves the hot key for a Shell link object.
   GetHotKey(lpShellLinkInfoStruct^.HotKey);
 
   // Retrieves the show (SW_) command for a Shell link object.
   GetShowCmd(lpShellLinkInfoStruct^.ShowCommand);
end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
const
br = #13#10;
var
LinkInfo: TShellLinkInfoStruct;
s: string;
begin
FillChar(LinkInfo, SizeOf(LinkInfo), #0);
LinkInfo.FullPathAndNameOfLinkFile := 'C:\WINNT\Profiles\user\Desktop\FileName.lnk';
GetLinkInfo(@LinkInfo);
with LinkInfo do
   s := FullPathAndNameOfLinkFile + br +
     FullPathAndNameOfFileToExecute + br +
     ParamStringsOfFileToExecute + br +
     FullPathAndNameOfWorkingDirectroy + br +
     Description + br +
     FullPathAndNameOfFileContiningIcon + br +
     IntToStr(IconIndex) + br +
     IntToStr(LoByte(HotKey)) + br +
     IntToStr(HiByte(HotKey)) + br +
     IntToStr(ShowCommand) + br +
     FindData.cFileName + br +
     FindData.cAlternateFileName;
Memo1.Lines.Add(s);
end;
Цитата:
...Цель - получить координаты этого ярлыка...
сначало нужно получить дескриптор рабочего стола, который представляет из себя обычный ListView
Код:
1
2
3
4
5
6
7
8
9
10
11
function GetDesktopListViewHandle: THandle;
var
S: String;
begin
Result := FindWindow('ProgMan', nil);
Result := GetWindow(Result, GW_CHILD);
Result := GetWindow(Result, GW_CHILD);
SetLength(S, 40);
GetClassName(Result, PChar(S), 39);
if PChar(S) <> 'SysListView32' then Result := 0;
end;
а дальше - вот пример сохранения/изменения координат ярлычков на рабочке
Код:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
// For NT, Win2k, XP:
//-------------------------------------------
// Unit to save/restore the positions of desktop icons to/from the registry)
unit dipsdef;
interface
uses Windows, CommCtrl;
const
RegSubKeyName = 'Software\LVT\Desktop Item Position Saver';
 
procedure RestoreDesktopItemPositions;
procedure SaveDesktopItemPositions;
 
implementation
 
uses uvirtalloc, registry;
 
procedure SaveListItemPosition(LVH : THandle; RemoteAddr : Pointer);
var
lvi : TLVITEM;
lenlvi : integer;
nb : integer;
buffer : array [0..MAX_PATH] of char;
Base : Pointer;
Base2 : PByte;
i, ItemsCount : integer;
Apoint : TPoint;
key : HKEY;
Dummy : integer;
begin
ItemsCount := SendMessage(LVH, LVM_GETITEMCOUNT, 0, 0);
Base := RemoteAddr;
lenlvi := SizeOf(lvi);
FillChar(lvi, lenlvi, 0);
lvi.cchTextMax := 255;
lvi.pszText := Base;
inc(lvi.pszText, lenlvi);
WriteToRemoteBuffer(@lvi, Base, 255);
Base2 := Base;
inc(Base2, Lenlvi);
RegDeleteKey(HKEY_CURRENT_USER, RegSubKeyName);
RegCreateKeyEx(HKEY_CURRENT_USER, PChar(RegSUbKeyName), 0,nil,
   REG_OPTION_NON_VOLATILE, KEY_SET_VALUE, nil, key,nil);
for i := 0 to ItemsCount - 1 do
begin
   nb := SendMessage(LVH, LVM_GETITEMTEXT, i, LParam(Base));
   ReadRemoteBuffer(Base2, @buffer, nb + 1);
   FillChar(Apoint, SizeOf(Apoint), 0);
   WriteToRemoteBuffer(@APoint, Base2, SizeOf(Apoint));
   SendMessage(LVH, LVM_GETITEMPOSITION, i, LParam(Base) + lenlvi);
   ReadRemoteBuffer(Base2, @Apoint, SizeOf(Apoint));
   RegSetValueEx(key, @buffer, 0, REG_BINARY, @Apoint, SizeOf(APoint));
end;
RegCloseKey(key);
end;
 
procedure RestoreListItemPosition(LVH : THandle; RemoteAddr : Pointer);
type
TInfo = packed record
   lvfi : TLVFindInfo;
   Name : array [0..MAX_PATH] of char;
end;
var
SaveStyle : Dword;
Base : Pointer;
Apoint : TPoint;
key : HKey;
idx : DWord;
info : TInfo;
atype : Dword;
cbname, cbData : Dword;
itemidx : DWord;
begin
SaveStyle := GetWindowLong(LVH, GWL_STYLE);
if (SaveStyle and LVS_AUTOARRANGE) = LVS_AUTOARRANGE then
   SetWindowLong(LVH, GWL_STYLE, SaveStyle xor LVS_AUTOARRANGE);
RegOpenKeyEx(HKEY_CURRENT_USER, RegSubKeyName, 0, KEY_QUERY_VALUE, key);
FillChar(info, SizeOf(info), 0);
Base := RemoteAddr;
idx := 0;
cbname := MAX_PATH;
cbdata := SizeOf(APoint);
while (RegEnumValue(key, idx, info.Name, cbname, nil, @atype, @Apoint, @cbData) <>   ERROR_NO_MORE_ITEMS) do
begin
   if (atype = REG_BINARY) and (cbData = SizeOf(Apoint)) then
   begin
     info.lvfi.flags := LVFI_STRING;
     info.lvfi.psz := Base;
     inc(info.lvfi.psz, SizeOf(info.lvfi));
     WriteToRemoteBuffer(@info, Base, SizeOf(info.lvfi) + cbname + 1);
     itemidx := SendMessage(LVH, LVM_FINDITEM, - 1, LParam(Base));
     if itemidx > -1 then
       SendMessage(LVH, LVM_SETITEMPOSITION, itemidx, MakeLong(Apoint.x, Apoint.y));
   end;
   inc(idx);
   cbname := MAX_PATH;
   cbdata := SizeOf(APoint);
end;
RegCloseKey(key);
SetWindowLong(LVH, GWL_STYLE, SaveStyle);
end;
 
function GetSysListView32: THandle;
begin
Result := FindWindow('Progman', nil);
Result := FindWindowEx(Result, 0, nil, nil);
Result := FindWindowEx(Result, 0, nil, nil);
end;
 
procedure SaveDesktopItemPositions;
var
pid : integer;
rembuffer : PByte;
hTarget : THandle;
begin
hTarget := GetSysListView32;
GetWindowThreadProcessId(hTarget, @pid);
if (hTarget = 0) or (pid = 0) then   Exit;
rembuffer := CreateRemoteBuffer(pid, $FFF);
if Assigned(rembuffer) then
begin
   SaveListItemPosition(hTarget, rembuffer);
   DestroyRemoteBuffer;
end;
end;
 
procedure RestoreDesktopItemPositions;
var
hTarget : THandle;
pid : DWord;
rembuffer : PByte;
begin
hTarget := GetSysListView32;
GetWindowThreadProcessId(hTarget, @pid);
 
if (hTarget = 0) or (pid = 0) then  Exit;
rembuffer := CreateRemoteBuffer(pid, $FFF);
if Assigned(rembuffer) then
begin
   RestoreListItemPosition(hTarget, rembuffer);
   DestroyRemoteBuffer;
end;
end;
 
end.

З.Ы.
Цитата:
...чтобы форма программы была расположена точь-в-точь в начальных координатах ярлыка...
при показе формы подставить ей координаты относительно GetCursorPos() или
Код:
1
2
Form1.Left:= mouse.CursorPos.x;
Form1.Top:= mouse.CursorPos.y;
Ответить с цитированием
Ответ

« Предыдущая тема | Следующая тема »

Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра
Линейный вид Линейный вид

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения
BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:53.

Обратная связь - Главная страница сайта Delphi Sources - Вверх

 

Сайт

Форум

FAQ

Соглашения

Прочее
 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025