Discussion :

[Nicolas Coolman]

Hello,

J'ai bien lu l'excellente FAQ sur la gestion des fichiers mais je n'y ai pas trouvé la réponse à ma question.

Sous Windows, lorsque l'on pose le curseur de la souris sur un fichier de raccourci (par exemple essai.lnk), il s'affiche automatiquement la cible du fichier (c:\Program Files\...\essai.exe). C'est en langage Delphi le Hint du fichier.

Ma question est donc la suivante, comment peut-on récupérer la cible d'un fichier de raccourci sous Delphi 7 ?

Merci d'avance pour vos réponses.

[Aka Guymelef]

Bonjour,

après une petite recherche je n'ai pas trouvé d'API pour manipuler ce type de fichier, néanmoins j'ai trouvé un document qui détaille la structure d'un fichier lnk ici. C'est déjà mieux que rien mais ça va nécessiter du boulot pour pouvoir l'exploiter.

Bon courage.

[Nicolas Coolman]

Hello Aka Guymelef,

Merci pour le lien, je vais regarder tout cela.

A bientôt

[Nicolas Coolman]

Hello,

En cherchant j'ai fini par trouver exactement la fonction que je cherchais.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
{===========================================}
function GetTarget (const LinkFileName:String):String;
{===========================================}
var
   psl  : IShellLink;
   ppf  : IPersistFile;
   WidePath  : Array[0..260] of WideChar;
   Info      : Array[0..MAX_PATH] of Char;
   wfs       : TWin32FindData;
begin
   if UpperCase(ExtractFileExt(LinkFileName)) <> '.LNK' Then begin
       Result:='NOT a shortuct by extension!';
       Exit;
   end;
 
   CoCreateInstance(CLSID_ShellLink,
                  nil,
                  CLSCTX_INPROC_SERVER,
                  IShellLink,
                  psl);
   if psl.QueryInterface(IPersistFile, ppf) = 0 then begin
      MultiByteToWideChar(CP_ACP,
                       MB_PRECOMPOSED,
                       PChar(LinkFileName),
                       -1,
                       @WidePath,
                       MAX_PATH);
      ppf.Load(WidePath, STGM_READ);
      psl.GetPath(@info,
                 MAX_PATH,
                 wfs,
                 SLGP_UNCPRIORITY);
      Result := info;
   end
 
   else
      Result := '';
end;

Ensuite rien de plus facile pour retrouver la cible en appelant cette fonction avec le fichier de raccourci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
{===================================================}
procedure TForm1.BitBtn1Click(Sender: TObject);
{===================================================}
var
   sInfo : string;
 
begin
   sInfo := GetTarget('C:\Documents And Settings\All Users\Menu    Démarrer\Programmes\Démarrage\Adobe Gamma Loader.lnk');
   ShowMessage (sInfo);
end;

Ce exemple affiche un message avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

c:\Program Files\Fichiers Communs\Adobe\Calibration\Adobe Gamma Loader.exe

Voilà, j'espère que cela pourra servir à quelqu'un sur ce forum.

Vous pouvez lire l'article complet
http://delphi.about.com/od/windowssh.../aa072704a.htm


A bientôt...

[cincap]

Bonjour à toutes et à tous,

@ Nicolas Coolman, j'ai essayé ta fonction en copiant un fichier raccourci nommé test.lnk qui copié dans le même dossier que l'application reprenant ta fonction et j'obtiens un message d'erreur.

En cliquant sur ce raccourci, l'application maître s'ouvre !

Mais en cliquant sur le bouton de ma forme, erreur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
procedure TForm1.Button1Click(Sender: TObject);
var
   sInfo : string;
 
begin
   sInfo := GetTarget('C:\Data\Delphi\Raccourci\test.lnk');
   ShowMessage (sInfo);
 
end;

As tu une idée du pourquoi.

Merci,

@+,

Cincap

[evarisnea]

@ Nicolas Coolman, j'ai essayé ta fonction en copiant un fichier raccourci nommé test.lnk qui copié dans le même dossier que l'application reprenant ta fonction et j'obtiens un message d'erreur.

et quel est le message d'erreur ?

[cincap]

Bonjour à toutes et à tous,

@ evarisnea, j'obtiens le message d'erreur suivant avec l'exécutable :

Violation d'accès à l'adresse 00452529 dans le module 'Project1.exe'. Lecture de l'adresse 00000000.

Et dans Delphi en utilisant pas à pas :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
function GetTarget (const LinkFileName:String):String;
{===========================================}
var
   psl  : IShellLink;
   ppf  : IPersistFile;
   WidePath  : Array[0..260] of WideChar;
   Info      : Array[0..MAX_PATH] of Char;
   wfs       : TWin32FindData;
begin
   if UpperCase(ExtractFileExt(LinkFileName)) <> '.LNK' Then begin
       Result:='NOT a shortuct by extension!';
       Exit;
   end;

   CoCreateInstance(CLSID_ShellLink,
                  nil,
                  CLSCTX_INPROC_SERVER,
                  IShellLink,
                  psl);
   if psl.QueryInterface(IPersistFile, ppf) = 0 then begin
      MultiByteToWideChar(CP_ACP,
                       MB_PRECOMPOSED,
                       PChar(LinkFileName),
                       -1,
                       @WidePath,
                       MAX_PATH);
      ppf.Load(WidePath, STGM_READ);
      psl.GetPath(@info,
                 MAX_PATH,
                 wfs,
                 SLGP_UNCPRIORITY);
      Result := info;
   end

   else
      Result := '';end;

.

C'est étrange, mon raccourci fonctionne et le chemin est correct lors de la position du curseur.

@+,

Cincap

[SergioMaster]

problème de uses peut-être ? signalés dans la future FAQ mais pas dans ce thread . Tu n'indiques pas non plus tes versions de Windows et Delphi cela peut, peut-être , jouer

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
uses ... ShlObj, ActiveX;

[cincap]

@ SergioMaster, je travaille sous Windows XP pack3 et Delphi6, le uses est aussi correct.

Par contre j'ai remarqué que lorsque je crée un raccourci d'un programme, il affiche l'extension .exe au lieu de .lnk tout en étant un raccourci qui fonctionne.

J'ai testé toutes les possibilités et erreur sauf quand je change dans l'application extension ".lnk", le message d'alerte fonctionne.

@+,

Cincap

[Aka Guymelef]

Effectivement je viens de tester la source à mon tour (WinXP SP2 ; Delphi7) et j'ai également un plantage. Il semble qu'il n'arrive pas à instancier le IShellLink. J'avoue ne pas du tout connaître cette interface donc je ne sais pas s'il y a un pré-requis à avoir pour que ça fonctionne.

EDIT :

Ok j'ai trouvé, c'est un problème de CoInitialize. Sur la fiche il faut rajouter les sections :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
initialization
  CoInitialize(nil);
 
finalization
  CoUninitialize;

Pour que cela fonctionne correctement.

[SergioMaster]

mêmes manips (D3+XP) que Aka Guymelef avec mêmes résultats

de plus un programme compile sous vista (D3) (sans initialization ni finalization) tourne sur vista mais pas sur XP je rechange d'OS pour voir

[Edit]
OK , compilation D3,VISTA avec "initialization" et tout fonctionne aussi bien sous Vista que sous XP , je vais faire un test du programme sous W95 , j'en ai un sous la main , et le signaler au niveau de la FAQ , si ce n'est déjà fait

[reEdit]
fonctionne sous W95

[cincap]

@ Aka Guymelef, ou rajouter sur la fiche ces sections ?

Merci d'avoir trouvé une solution.

@+,

Cincap

[Aka Guymelef]

Tu peux les rajouter après ton code dans la fiche mais avant le "end."

[Cl@udius]

@ Aka Guymelef, ou rajouter sur la fiche ces sections ?

Tout à la fin de l'unité juste avant le end.

[edit] Grilled

[cincap]

Merci à tous, que des cracks sur ce forum.

@+,

Cincap

[Nicolas Coolman]

Hello, bonjour à tous,

Pas de plantages chez moi, mais un utilisateur de mon tool ZHPDiag (Partie de Zeb Help Process) a eu un plantage avec ce type de message. Je vais rajouter ces lignes et le contacter pour voir si son problème est maintenant réglé.

Merci pour tout et bonne journée.

[cincap]

Bonsoir à toutes et à tous,

Pour aller plus loin avec cette idée, j'ai rajouter un Tedit et comme cela, la fiche prends en compte le lien écrit dans ce Tedit et affiche le chemin.

Cela fonctionne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
 sInfo := 'Emplacement : '+ GetTarget(edit1.text);
 ShowMessage (sInfo);

Mais j'ai aussi utilisé un Tlistbox et une procédure drag and drop, je me suis dit que le lien (icone sur le bureau) placé par drag and drop dans le Tlistbox et reproduit dans le Tedit que cela fonctionnerait, mais non le message d'erreur prévu dans la fonction s'affiche alors que dans le Tedit le lien est correct comme si je l'avais écrit.

Result:='NOT a shortuct by extension!';

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
edit1.text := listbox1.items.text;

Quelqu'un a t'il une idée ?

Merci d'avance,

Cincap

[Nicolas Coolman]

Hello cincap,

J'ai testé avec une ListBox et cela fonctionne bien

1) Dans le Item de la ListBox :

- Vérifier qu'il n'y a aucune ligne vierge, au début et à la fin
- Vérifier que la ligne saisie correspond bien au chemin complet du type, par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
C:\Documents And Settings\All Users\Menu Démarrer\Programmes\Démarrage\Adobe Gamma Loader.lnk

- Vérifier aussi que la chaine ne comporte pas le caractère ' au début et à la fin

3) Pour accéder à la valeur de l'item, j'ai utilisé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ListBox1.Items[0]

4) Pour une 2° Ligne, il faudrait utiliser

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ListBox1.Items[1]

et ainsi de suite...

A bientôt.

[cincap]

Bonjour à toutes et à tous,

@ Nicolas Coolman, le test avec le Tlistbox n'est pas aussi simple, en effet, mon Tlistbox est vide et avec un drag and drop je place un icone de raccourci sur mon Tlistbox, le lien s'inscrit bien mais par contre, l'item n'indique pas le chemin, sans compter que je peux placer un 2ième icône, puis 3 ect.. sur mon Tlistbox.

Ceci dit, ce test est à l'origine de comprendre jusqu'ou pouvait aller ta fonction.

@+,

Cincap