Extract path of a windows shortcut

[fgsav]

Hi everyone and thanks for trying to help me  
I work under Windows XP and i'd like to get the path of a .lnk file.
I don't find anyway to do this except doing it myself with opendialog...
After searching the net I found a solution for delphi with IShellLink, but it seems there's no way to get it work under lazarus.
If someone has a suggestion...
THX !  :wink:

[totya]

This is my question is too... I want to load (and doesn't execute) a file from windows shortcut.

Thanks!

[lainz]

Use this unit taken from here: http://www.informit.com/articles/article.aspx?p=26940&seqNum=4

Code: Pascal  [Select][+][-]

1. unit WinShell;
2.  
3. interface
4.  
5. uses SysUtils, Windows, Registry, ActiveX, ShlObj;
6.  
7. type
8.  EShellOleError = class(Exception);
9.  
10.  TShellLinkInfo = record
11.   PathName: string;
12.   Arguments: string;
13.   Description: string;
14.   WorkingDirectory: string;
15.   IconLocation: string;
16.   IconIndex: integer;
17.   ShowCmd: integer;
18.   HotKey: word;
19.  end;
20.  
21.  TSpecialFolderInfo = record
22.   Name: string;
23.   ID: Integer;
24.  end;
25.  
26. const
27.  SpecialFolders: array[0..29] of TSpecialFolderInfo = (
28.   (Name: 'Alt Startup'; ID: CSIDL_ALTSTARTUP),
29.   (Name: 'Application Data'; ID: CSIDL_APPDATA),
30.   (Name: 'Recycle Bin'; ID: CSIDL_BITBUCKET),
31.   (Name: 'Common Alt Startup'; ID: CSIDL_COMMON_ALTSTARTUP),
32.   (Name: 'Common Desktop'; ID: CSIDL_COMMON_DESKTOPDIRECTORY),
33.   (Name: 'Common Favorites'; ID: CSIDL_COMMON_FAVORITES),
34.   (Name: 'Common Programs'; ID: CSIDL_COMMON_PROGRAMS),
35.   (Name: 'Common Start Menu'; ID: CSIDL_COMMON_STARTMENU),
36.   (Name: 'Common Startup'; ID: CSIDL_COMMON_STARTUP),
37.   (Name: 'Controls'; ID: CSIDL_CONTROLS),
38.   (Name: 'Cookies'; ID: CSIDL_COOKIES),
39.   (Name: 'Desktop'; ID: CSIDL_DESKTOP),
40.   (Name: 'Desktop Directory'; ID: CSIDL_DESKTOPDIRECTORY),
41.   (Name: 'Drives'; ID: CSIDL_DRIVES),
42.   (Name: 'Favorites'; ID: CSIDL_FAVORITES),
43.   (Name: 'Fonts'; ID: CSIDL_FONTS),
44.   (Name: 'History'; ID: CSIDL_HISTORY),
45.   (Name: 'Internet'; ID: CSIDL_INTERNET),
46.   (Name: 'Internet Cache'; ID: CSIDL_INTERNET_CACHE),
47.   (Name: 'Network Neighborhood'; ID: CSIDL_NETHOOD),
48.   (Name: 'Network Top'; ID: CSIDL_NETWORK),
49.   (Name: 'Personal'; ID: CSIDL_PERSONAL),
50.   (Name: 'Printers'; ID: CSIDL_PRINTERS),
51.   (Name: 'Printer Links'; ID: CSIDL_PRINTHOOD),
52.   (Name: 'Programs'; ID: CSIDL_PROGRAMS),
53.   (Name: 'Recent Documents'; ID: CSIDL_RECENT),
54.   (Name: 'Send To'; ID: CSIDL_SENDTO),
55.   (Name: 'Start Menu'; ID: CSIDL_STARTMENU),
56.   (Name: 'Startup'; ID: CSIDL_STARTUP),
57.   (Name: 'Templates'; ID: CSIDL_TEMPLATES));
58.  
59. function CreateShellLink(const AppName, Desc: string; Dest: Integer): string;
60. function GetSpecialFolderPath(Folder: Integer; CanCreate: Boolean): string;
61. procedure GetShellLinkInfo(const LinkFile: WideString;
62.  var SLI: TShellLinkInfo);
63. procedure SetShellLinkInfo(const LinkFile: WideString;
64.  const SLI: TShellLinkInfo);
65.  
66. implementation
67.  
68. uses ComObj;
69.  
70. function GetSpecialFolderPath(Folder: Integer; CanCreate: Boolean): string;
71. var
72.  FilePath: widestring;
73.  PFilePath: PWideChar; //array[0..MAX_PATH] of char;
74. begin
75.  SetLength(FilePath, MAX_PATH);
76.  PFilePath := Addr(FilePath[1]);
77.  { Get path of selected location }
78.  SHGetSpecialFolderPathW(0, PFilePath, Folder, CanCreate);
79.  Result := FilePath;
80. end;
81.  
82. function CreateShellLink(const AppName, Desc: string; Dest: Integer): string;
83. { Creates a shell link for application or document specified in }
84. { AppName with description Desc. Link will be located in folder }
85. { specified by Dest, which is one of the string constants shown }
86. { at the top of this unit. Returns the full path name of the  }
87. { link file. }
88. var
89.  SL: IShellLink;
90.  PF: IPersistFile;
91.  LnkName: WideString;
92. begin
93.  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
94.   IShellLink, SL));
95.  { The IShellLink implementer must also support the IPersistFile }
96.  { interface. Get an interface pointer to it. }
97.  PF := SL as IPersistFile;
98.  OleCheck(SL.SetPath(PChar(AppName))); // set link path to proper file
99.  if Desc <> '' then
100.   OleCheck(SL.SetDescription(PChar(Desc))); // set description
101.  { create a path location and filename for link file }
102.  LnkName := GetSpecialFolderPath(Dest, True) + '\' +
103.        ChangeFileExt(AppName, 'lnk');
104.  PF.Save(PWideChar(LnkName), True);     // save link file
105.  Result := LnkName;
106. end;
107.  
108. procedure GetShellLinkInfo(const LinkFile: WideString;
109.  var SLI: TShellLinkInfo);
110. { Retrieves information on an existing shell link }
111. var
112.  SL: IShellLink;
113.  PF: IPersistFile;
114.  FindData: TWin32FindData;
115.  AStr: array[0..MAX_PATH] of char;
116. begin
117.  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
118.   IShellLink, SL));
119.  { The IShellLink implementer must also support the IPersistFile }
120.  { interface. Get an interface pointer to it. }
121.  PF := SL as IPersistFile;
122.  { Load file into IPersistFile object }
123.  OleCheck(PF.Load(PWideChar(LinkFile), STGM_READ));
124.  { Resolve the link by calling the Resolve interface function. }
125.  OleCheck(SL.Resolve(0, SLR_ANY_MATCH or SLR_NO_UI));
126.  { Get all the info! }
127.  with SLI do
128.  begin
129.   OleCheck(SL.GetPath(AStr, MAX_PATH, FindData, SLGP_SHORTPATH));
130.   PathName := AStr;
131.   OleCheck(SL.GetArguments(AStr, MAX_PATH));
132.   Arguments := AStr;
133.   OleCheck(SL.GetDescription(AStr, MAX_PATH));
134.   Description := AStr;
135.   OleCheck(SL.GetWorkingDirectory(AStr, MAX_PATH));
136.   WorkingDirectory := AStr;
137.   OleCheck(SL.GetIconLocation(AStr, MAX_PATH, IconIndex));
138.   IconLocation := AStr;
139.   OleCheck(SL.GetShowCmd(ShowCmd));
140.   OleCheck(SL.GetHotKey(HotKey));
141.  end;
142. end;
143.  
144. procedure SetShellLinkInfo(const LinkFile: WideString;
145.  const SLI: TShellLinkInfo);
146. { Sets information for an existing shell link }
147. var
148.  SL: IShellLink;
149.  PF: IPersistFile;
150. begin
151.  OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER,
152.   IShellLink, SL));
153.  { The IShellLink implementer must also support the IPersistFile }
154.  { interface. Get an interface pointer to it. }
155.  PF := SL as IPersistFile;
156.  { Load file into IPersistFile object }
157.  OleCheck(PF.Load(PWideChar(LinkFile), STGM_SHARE_DENY_WRITE));
158.  { Resolve the link by calling the Resolve interface function. }
159.  OleCheck(SL.Resolve(0, SLR_ANY_MATCH or SLR_UPDATE or SLR_NO_UI));
160.  { Set all the info! }
161.  with SLI, SL do
162.  begin
163.   OleCheck(SetPath(PChar(PathName)));
164.   OleCheck(SetArguments(PChar(Arguments)));
165.   OleCheck(SetDescription(PChar(Description)));
166.   OleCheck(SetWorkingDirectory(PChar(WorkingDirectory)));
167.   OleCheck(SetIconLocation(PChar(IconLocation), IconIndex));
168.   OleCheck(SetShowCmd(ShowCmd));
169.   OleCheck(SetHotKey(HotKey));
170.  end;
171.  PF.Save(PWideChar(LinkFile), True);  // save file
172. end;
173.  
174. end.

The unit is somewhat changed to work with FPC.

And use as this:

Code: Pascal  [Select][+][-]

1. var
2.   data: TShellLinkInfo;
3. begin
4.   WinShell.GetShellLinkInfo('C:\Users\Public\Desktop\Downloads.lnk', data);
5.   ShowMessage(data.PathName);

[wp]

Found this in an old Delphi project. Windows-only, of course, but produces a valid result with Laz / fpc 3.0:

Code: Pascal  [Select][+][-]

1. uses
2.   Windows, ActiveX, ShlObj;
3.  
4. function GetShortcutTarget(const ShortcutFilename: string): string;
5. var
6.   Psl: IShellLink;
7.   Ppf: IPersistFile;
8.   WideName: array[0..MAX_PATH] of WideChar;
9.   pResult: array[0..MAX_PATH-1] of ansiChar;
10.   Data: TWin32FindData;
11. const
12.   IID_IPersistFile: TGUID = (
13.     D1:$0000010B; D2:$0000; D3:$0000; D4:($C0,$00,$00,$00,$00,$00,$00,$46));
14. begin
15.   CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkA, psl);
16.   psl.QueryInterface(IID_IPersistFile, ppf);
17.   MultiByteToWideChar(CP_ACP, 0, pAnsiChar(ShortcutFilename), -1, WideName, Max_Path);
18.   ppf.Load(WideName, STGM_READ);
19.   psl.Resolve(0, SLR_ANY_MATCH);
20.   psl.GetPath(@pResult, MAX_PATH, Data, SLGP_UNCPRIORITY);
21.   Result := StrPas(pResult);
22. end;

[lainz]

I fixed the first code, it works too.

[totya]

Hi!

Thanks guys for the answers!

lainz: "Your" code can open anything, even link with UTF8 filename, and the destination is UTF8 filename, but the result (.PathName) is DOS format, for example: any~1.xls, this is ugly, but as I said it't working.

wp: Your code doesn't work with UTF8 filename.

Thanks again!

Edit:

The (test) filename is:

öüóőúéáí_ÖÜÓŐÚÉÁÍ_仙は、一度死ぬことができます.xls

[lainz]

There is a line with a parameter that asks for short filename. Try to change that.

[totya]

There is a line with a parameter that asks for short filename. Try to change that.

Unfortunatelly No SLGP_LONGPATH in the param list

Edit: But as I see, there is code on the net convert to longpath from the short path..

[totya]

Hi guys, I created working procedures to convert from DOS path, tested with UTF8 filenames, for example:

öüóőúéáí_ÖÜÓŐÚÉÁÍ_仙は、一度死ぬことができます.xls

Code: Pascal  [Select][+][-]

1. unit unit_WindowsUtils;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Windows, LazUTF8;
9.  
10. function Windows_ExtractLongPathName (const ShortPath: string): string;
11.  
12. implementation
13.  
14. function Windows_GetLongPathNameWide (ShortPath: PWideChar;
15.                                       LongPath: PWideChar;
16.                                       Buffer: DWord): DWord; stdcall; external kernel32 name 'GetLongPathNameW';
17.  
18. // Convert DOS Path to UTF8 Path
19. // by totya, 2016.10.14.
20. function Windows_ExtractLongPathName (const ShortPath: string): string;
21. const
22.   MaxPathUnicode = 32767; // https://msdn.microsoft.com/en-us/library/windows/desktop/aa364980
23. var
24.   Buffer: array [0..MaxPathUnicode] of WideChar;
25.   Required: DWord;
26. begin
27.   Result:= '';
28.  
29.   Required:= Windows_GetLongPathNameWide (PWideChar(UTF8ToUTF16(ShortPath)), Buffer{%H-}, Length(Buffer));
30.  
31.   if Required > 0 then
32.     Result:=UTF16ToUTF8(StrPas(Buffer));
33. end;
34.  
35. end.
36.  

[petevick]

I know this is an oldish topic, but I've just used the code posted by Lainz in the 3rd reply above, and had to change line 129 from this.....

Code: Pascal  [Select][+][-]

1.   OleCheck(SL.GetPath(AStr, MAX_PATH, FindData, SLGP_SHORTPATH));

to this......

Code: Pascal  [Select][+][-]

1.   OleCheck(SL.GetPath(AStr, MAX_PATH, FindData, SLGP_RAWPATH));

....as SLGP_SHORTPATH was returning a shortened path string such as "C:\PROGA~1\FOLDER\" whereas SLGP_RAWPATH returns the full path string such as "C:\PROGRAM FILES\FOLDER\". Apart from that it works like a charm, thanks Lainz.

[lainz]

I can't even remember writing that reply 

Nice it works.