Discussion :

[bvsud]

Bonjour à tous

J'ai besoin de savoir si un .LNK pointe vers un fichier ou un répertoire. Je veux donc vérifier ce point en lisant le nom du fichier ou répertoire pointé par le lien.

Consulté (notamment) ces adresses :
http://www.developpez.net/forums/d54...nk-raccourcis/

http://www.developpez.net/forums/d34...contenu-d-lnk/

J'ai retenu ce code :
Ds les USUS : ShlObj, ActiveX, ComObj;

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
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
const
   TAILLE_BUFFER = 1024;
   IID_IPersistFile: TGUID = (D1: $0000010B; D2: $0000; D3: $0000; D4: ($C0, $00, $00, $00, $00, $00, $00, $46));

type
   ArrayChar = array[0..TAILLE_BUFFER] of Char;

Var  // globales
  // POUR LIRE LE F.LNK -------------------------
  PersistFile: IPersistFile;
  FileNameW: array[0..MAX_PATH] of WideChar;
  ShellLink: IShellLink;
  fd: TWin32FindData;
  ProLink: ArrayChar;
  I: Word;
  J: Integer;
  // --------------------------------------------



procedure TForm1.Btn_LireClick(Sender: TObject);
Var
  Nom_F_Lnk : String;
  Lst_Test_Fn : TStringList;

begin

  Nom_F_LNK := 'GLOSSAIRES.lnk';  // Le fichier .LNK est ds le répertoire courant
  Form1.Lab_Aff_F_Lnk.Caption := UpperCase(Nom_F_LNK);

  Lst_Test_Fn := Lire_Infos_F_LNK(Nom_F_LNK);
  Lst_Test_Fn.SaveToFile('Z-RESULTAT.TMP');

end;


Function Lire_Infos_F_LNK(szChemin: String): TStringList;
Var
  Nom_F_Lnk : string;
  Lst_Retour : TStringList;

begin

      Lst_Retour := TStringList.Create;
      CoInitialize(nil);
      try
         OleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkA, ShellLink));
         try
            OleCheck(ShellLink.QueryInterface(IID_IPersistFile, PersistFile));
            try
               MultiByteToWideChar(CP_ACP, 0, @szChemin[1], -1, FileNameW, MAX_PATH);
               OleCheck(PersistFile.Load(FileNameW, STGM_READ));		// C'est là que ça plante
               ShellLink.GetPath(ProLink, Max_Path, fd, SLGP_UNCPRIORITY);
               Lst_Retour.Add(ProLink);
            finally
            end;
         finally
         end;
      finally
         CoUninitialize;
      end;
end;

Plantage avec le message (Erreur 2) "Fichier spécifié introuvable". Pourquoi ?

[ShaiLeTroll]

Mon code est très proche du tien sauf le transtypage en PChar bien plus simple en XE2

Essaye mon code remplaçant IID_IShellLinkW par IID_IShellLinkA si tu es en D7

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
39
40
41
42
 
Winapi.Windows, Winapi.ShellApi, Winapi.ShlObj, Winapi.Messages, Winapi.ActiveX,
  System.Classes, System.SysUtils;
 
type
  /// <summary>TSLTShellLink encapsule l'utilisation de l'interface IShellLink</summary>
  TSLTShellLink = class(TObject)
  public
    class function ExtractTarget(const AShellLinkFileName: TFileName): TFileName;
  end;
 
{ TSLTShellLink }
 
//------------------------------------------------------------------------------
class function TSLTShellLink.ExtractTarget(const AShellLinkFileName: TFileName): TFileName;
// Voir la fonction cachée "GetFileNameFromLink" dans Vcl.ExtDlgs
// Ne pase inclure Winapi.Ole2 qui contient IID_IPersistFile, cela devient trop pénible les conflits entre TGUID de Delphi et TGUID de Winapi.Ole2
const
  IID_IPersistFile: TGUID = '{0000010B-0000-0000-C000-000000000046}';
var
  LResult: HRESULT;
  LSHellLink: IShellLink;
  LPersistFile: IPersistFile;
  LFindData: TWin32FindData;
  FileName: array[0..MAX_PATH - 1] of Char;
begin
  Result := '';
  LResult := CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IID_IShellLinkW, LShellLink);
  if LResult = S_OK then
  begin
    if Supports(LShellLink, IID_IPersistFile, LPersistFile) then
    begin
      LResult := LPersistFile.Load(PChar(AShellLinkFileName), STGM_READ);
      if LResult = S_OK then
      begin
        LResult := LSHellLink.GetPath(FileName, MAX_PATH, LFindData, SLGP_UNCPRIORITY);
        if LResult = S_OK then
          Result := Trim(FileName);
      end;
    end;
  end;
end;

[bvsud]

Bonjour, Shaire.

XE7 . Mais je vais le tenter tout de même. Merci

[Lung]

J'ai testé sous XE7, et ça marche bien !

[bvsud]

Bonsoir à tous

@Shaire : ça march nickel.

Voici le code tel que je l'exploite :

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
 
 
Procedure Test_Fn_Shaire_Le_Troll;
Var
  Nom_F_LNK : string;
  Nom_F_Pointe : string;
 
begin
 
  Nom_F_LNK := 'Circoncision.lnk';
  Nom_F_pointe := TSLTShellLink.ExtractTarget(Nom_F_LNK);
  Form1.Lab_Aff_Retour_Fn_Shaire.Caption := Nom_F_Pointe;
 
  if Tst_F_Est_Un_Rep(Nom_F_pointe) = True then Form1.Lab_Aff_Si_Directory.Caption := 'OUI'  // Tst_F_Est_Un_Rep : fonction avec test des bits en ASM
  Else Form1.Lab_Aff_Si_Directory.Caption := 'NON';
 
end;

Merci

[Papy214]

ça irait bien dans la faq ce bout de code ;-)