Discussion :

[Alcatîz]

Bonjour à toutes et à tous !

Je suis à la recherche d'une unité pour Virtual Pascal ou Free Pascal contenant les fonctions de gestion des objets COM (CoInitialize, CoCreateinstance, etc) ou, plus généralement, l'API de la bibliothèque OLE32.DLL.

Les délais auxquels je suis astreint me laisseront peu de temps pour réécrire une unité entière. S'il en existe une dans le domaine public, ça m'aiderait beaucoup. Et je n'ai rien trouvé pour l'instant.

Merci d'avance !

[Alcatîz]

Je vais essayer de me débrouiller avec l'unité WinShell de Free Pascal et quelques sources en Delphi.

[Alcatîz]

Voilà, j'avance : j'ai porté une partie de l'unité WinShell de Free Pascal en Virtual Pascal.
Ce que je veux faire en fait est résoudre un fichier .lnk pour y modifier les différents chemins d'accès, via l'interface IShellLink.

Mais je reste bloqué sur la fonction CoCreateInstance, qui me renvoie un code d'erreur 80070057h signifiant qu'un ou plusieurs arguments sont erronés. J'ai pourtant comparé mon code à divers sources en Free Pascal, Delphi et C : je ne vois pas de différence

J'ai essayé plusieurs conventions d'appel de la fonction (StdCall, CDecl...) mais c'est toujours la même erreur qui est renvoyée.
Si vous pouviez jeter un coup d'oeil, ce serait sympa. L'erreur est peut-être grosse comme une maison mais je ne la vois pas.

Déclarations :

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
Type
  PGUID = ^TGUID;
  TGUID = Packed Record
            Data1 : DWord;
            Data2 : SmallWord;
            Data3 : SmallWord;
            Data4 : Array [0..7] of Byte;
          end;
  PIID = PGUID;
  TIID = TGUID;
  CLSID = TGUID;
  LPCLSID = ^CLSID;
  TCLSID = CLSID;
  PCLSID = ^CLSID;
 
  PIShellLink = ^IShellLink;
  PIShellLinkVtbl = ^IShellLinkVtbl;
  IShellLink = Packed Record
                 Vtbl : PIShellLinkVtbl;
               end;
  IShellLinkVtbl = Packed Record
                     {&StdCall+}
                     QueryInterface : Function (const this : PIShellLink; const iid: TIID; var obj): HResult;
                     AddRef : Function (const this : PIShellLink) : ULONG;
                     Release : Function (const this : PIShellLink) : ULONG;
                     GetPath : Function (const this : PIShellLink; pszFile : LPSTR; cchMaxPAth : INT; var fd : TWin32FindData; Flags : DWORD) : hResult;
                     GetIDList : Function (const this : PIShellLink; var pidl : LPITEMIDLIST) : hResult;
                     SetIDList : Function (const this : PIShellLink; pidl : LPITEMIDLIST) : hResult;
                     GetDescription : Function (const this : PIShellLink; pszName : LPSTR; cchMaxName : INT) : hResult;
                     SetDescription : Function (const this : PIShellLink; pszName : LPSTR) : hResult;
                     GetWorkingDirectory : Function (const this : PIShellLink; pszDir : LPSTR; cchMaxName : INT) : hResult;
                     SetWorkingDirectory : Function (const this : PIShellLink; pszDir : LPSTR) : hResult;
                     GetArguments : Function (const this : PIShellLink; pszArgs : LPSTR; cchMaxName : INT) : hResult;
                     SetArguments : Function (const this : PIShellLink; pszArgs : LPSTR) : hResult;
                     GetHotkey : Function (const this : PIShellLink; var wHotKey : Word) : hResult;
                     SetHotkey : Function (const this : PIShellLink; wHotKey : Word) : hResult;
                     GetShowCmd : Function (const this : PIShellLink; var iShowCmd : INT) : hResult;
                     SetShowCmd : Function (const this : PIShellLink; iShowCmd : INT) : hResult;
                     GetIconLocation : Function (const this : PIShellLink; pszIconPath : LPSTR; cchIconPath : INT; var iIcon : INT) : hResult;
                     SetIconLocation : Function (const this : PIShellLink; pszIconPath : LPSTR; iIcon : INT) : hResult;
                     SetRelativePath : Function (const this : PIShellLink; pszPathRel : LPSTR; wReserved : DWORD) : hResult;
                     Resolve : Function (const this : PIShellLink; hwnd : HWND; fFlags : DWORD) : hResult;
                     SetPath : Function (const this : PIShellLink; pszFile : LPSTR) : hResult;
                     {&StdCall-}
                   end;
 
 
Function CoInitialize (pvReserved : Pointer) : hResult; external 'ole32' name 'CoInitialize';
Procedure CoUninitialize; external 'ole32' name 'CoUninitialize';
Function SHGetMalloc (ppMalloc : PPIMalloc) : hResult; external 'shell32' name 'SHGetMalloc';
Function CoCreateInstance (rclsid : TCLSID; pUnkOuter : PIUnknown; dwClsContext : LongInt; riid : TIID; var ppv) : hResult; external 'ole32' name 'CoCreateInstance';

Programme appelant :

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
 
Var hRes : hResult;
    ShellLink : pIShellLink;
 
 
  hRes := CoInitialize(Nil);
  if hRes = s_OK
     then
       begin
         WriteLn('OK');
         Write('Initialisation de l''interface IShellLink : ');
         hRes := CoCreateInstance(CLSID_ShellLink,Nil,CLSCTX_INPROC_SERVER,IID_IShellLink,ShellLink);
         if hRes = s_OK
            then
              begin
                WriteLn('OK');
                Write('Initialisation de l''interface IPersistFile : ');
                hRes := ShellLink^.Vtbl^.QueryInterface(ShellLink,IID_IPersistFile,PersistFile);
 
                ... etc etc
 
                ShellLink^.Vtbl^.Release(ShellLink);
              end
            else
              WriteLn('Erreur : ',hRes);   <-- Code d'erreur $80070057 !!!
         CoUninitialize;
       end
     else
       WriteLn('Erreur : ',hRes);

P.S. Je ne pose pas la question pour l'instant sur le forum Développement Windows car il me semble que c'est plutôt un problème de déclaration ou de syntaxe pascal.

[Alcatîz]

Ouf ! Il s'agit bien d'un problème de syntaxe.
Pour être prises en compte, les directives {&StdCall+} et {&StdCall-} doivent se trouver dans la partie interface d'une unité et non dans la partie implémentation.

[M.Dlb]

[Alcatîz]

C'est trop d'honneur ! (mais merci !)