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:
145:
146:
147:
148:
149:

unit getAdvShortcut;

interface

uses
  ShlObj, ComObj, ActiveX, CommCtrl, Windows, SysUtils;

{...}

procedure getExecData(lnkName : String; var execName, execDir, execArgs : String);



implementation


{...}

type
  TCharArray = Array[0..MAX_PATH] of Char;


//Hier gefunden: http://www.swissdelphicenter.ch/de/showcode.php?id=970
type
  PShellLinkInfoStruct = ^TShellLinkInfoStruct;
  TShellLinkInfoStruct = record
    FullPathAndNameOfLinkFile: TCharArray;
    FullPathAndNameOfFileToExecute: TCharArray;
    ParamStringsOfFileToExecute: TCharArray;
    FullPathAndNameOfWorkingDirectroy: TCharArray;
    Description: TCharArray;
    FullPathAndNameOfFileContiningIcon: TCharArray;
    IconIndex: Integer;
    HotKey: Word;
    ShowCommand: Integer;
    FindData: TWIN32FINDDATA;
  end;

// Hat Mathias Simmack hier verwendet, um die hier demonstrierte Funktion zu vewrenden:
// http://www.delphi-forum.de/viewtopic.php?t=27628
const
  MsiDllName                = 'msi.dll';

  INSTALLSTATE_ABSENT       =  2;    // uninstalled
  INSTALLSTATE_LOCAL        =  3;    // installed on local drive
  INSTALLSTATE_SOURCE       =  4;    // run from source, CD or net
  INSTALLSTATE_SOURCEABSENT = -4;    // run from source, source is unavailable
  INSTALLSTATE_NOTUSED      = -7;    // component disabled
  INSTALLSTATE_INVALIDARG   = -2;    // invalid function argument
  INSTALLSTATE_UNKNOWN      = -1;    // unrecognized product or feature
type
  INSTALLSTATE              = LongInt;

  TMsiGetShortcutTarget     = function(szShortcutTarget, szProductCode,
    szFeatureId, szComponentCode: PAnsiChar): uint; stdcall;
  TMsiGetComponentPath      = function(szProduct, szComponent: PAnsiChar;
    lpPathBuf: PAnsiChar; pcchBuf: pdword): INSTALLSTATE; stdcall;
var
  MsiGetShortcutTarget      : TMsiGetShortcutTarget = nil;
  MsiGetComponentPath       : TMsiGetComponentPath  = nil;
  MsiDll                    : dword = 0;


//Hier gefunden: http://www.swissdelphicenter.ch/de/showcode.php?id=970
procedure GetLinkInfo(lpShellLinkInfoStruct: PShellLinkInfoStruct);
var
  ShellLink: IShellLink;
  PersistFile: IPersistFile;
  AnObj: IUnknown;
begin
  //Interface-Objekte holen
  AnObj       := CreateComObject(CLSID_ShellLink);
  ShellLink   := AnObj as IShellLink;
  PersistFile := AnObj as IPersistFile;

  // Datei öffnen und Objekt initialisieren
  PersistFile.Load(PWChar(WideString(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile)), 0);

  with ShellLink do
  begin
    // Pfad und Dateiname ermitteln
    GetPath(lpShellLinkInfoStruct^.FullPathAndNameOfFileToExecute,
      SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfLinkFile),
      lpShellLinkInfoStruct^.FindData,
      SLGP_UNCPRIORITY);

    // Arbeitsverzeichnis ermitteln
    GetWorkingDirectory(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy,
      SizeOf(lpShellLinkInfoStruct^.FullPathAndNameOfWorkingDirectroy));

    // Befehlszeilen-Argumente ermitteln
    GetArguments(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute,
      SizeOf(lpShellLinkInfoStruct^.ParamStringsOfFileToExecute));
  end;
end;

// Ermittelt den Namen der ausführbaren Datei (execName), das Arbeitsverzeichnis (execDir) und
// die Befehlszeilen-Argumente (execArgs) aus einer übergebenen Verknüpfung.
procedure getExecData(lnkName : String; var execName, execDir, execArgs : String);
var
  LinkInfo: TShellLinkInfoStruct;
  aFile : TCharArray;
  prodCode, featureId, compCode : TCharArray;
  aPath : TCharArray;
  pathLength : DWord;
begin
  FillChar(LinkInfo, SizeOf(LinkInfo), #0);
  StrCopy(@aFile, PChar(lnkName));
  LinkInfo.FullPathAndNameOfLinkFile := aFile;
  GetLinkInfo(@LinkInfo); //Informationen eines non-advertised Shortcut ermitteln
  execName := LinkInfo.FullPathAndNameOfFileToExecute;
  execDir := LinkInfo.FullPathAndNameOfWorkingDirectroy;
  execArgs := LinkInfo.ParamStringsOfFileToExecute;

  ZeroMemory(@prodCode, sizeOf(prodCode));
  ZeroMemory(@featureId, sizeOf(featureId));
  ZeroMemory(@compCode, sizeOf(compCode));
  if MsiGetShortcutTarget(aFile, prodCode, featureId, compCode) = ERROR_SUCCESS then //advertised shortcut?
  begin
    pathLength := sizeOf(aPath);
    ZeroMemory(@aPath, sizeOf(aPath));
    if MsiGetComponentPath(prodCode, compCode, aPath, @pathLength) = INSTALLSTATE_LOCAL then //Anwendung ausführbar?
       execName := aPath; //Pfad auf die ausführbare Datei setzen
  end;
end;

// Hat Mathias Simmack hier verwendet, um die hier demonstrierte Funktion zu vewrenden:
// http://www.delphi-forum.de/viewtopic.php?t=27628
initialization
  MsiDll                     := GetModuleHandle(MsiDllName);
  if(MsiDll = 0) then MsiDll := LoadLibrary(MsiDllName);

  if(MsiDll <> 0) then
  begin
    MsiGetShortcutTarget     := GetProcAddress(MsiDll, 'MsiGetShortcutTargetA');
    MsiGetComponentPath      := GetProcAddress(MsiDll, 'MsiGetComponentPathA');

    if(@MsiGetShortcutTarget = nil) or
      (@MsiGetComponentPath  = nil) then
    begin
      FreeLibrary(MsiDll);
      MsiDll := 0;
    end;
  end;

finalization
  if(MsiDll <> 0) then FreeLibrary(MsiDll);

end.