Цитата:
Сообщение от bambus
...определить путь по которому была запущена программа...
|
Код:
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;
Цитата:
...определить расположение ярлыка по которму была запущена программа...
|
он скорее всего на рабочем столе, узнать подробную инфу из него
Код:
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
Код:
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;
а дальше - вот пример сохранения/изменения координат ярлычков на рабочке
Код:
// 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() или
Код:
Form1.Left:= mouse.CursorPos.x;
Form1.Top:= mouse.CursorPos.y;
|