Problème d'appel à une fonction de Shell32.dll sous win server 2008
Bonjour,
J'ai du code qui sert à faire appel à la fonction SHGetKnownFolderPath de la librairie Shell32.dll afin de récupérer le chemin d'un répertoire dans lequel l'utilisateur a les droits d'écriture. Ce code fonctionne très bien sous Vista mais sous windows Server 2008, cela renvoie une erreur. Pour essayer de trouver d'où vient le problème, j'ai exporter ce code dans une appli minimaliste en mettant des try except et des raise un peu partout (comme vous allez le voir) afin de comprendre ce qui se passe:
Code:
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
| const
FOLDERID_LOCALAPPDATALOW : TGUID =
(D1:$A520A1A4; D2:$1780; D3:$4FF6; D4:($BD,$18,$16,$73,$43,$C5,$AF,$16));
procedure TfMain.bLanceTestClick(Sender: TObject);
var
sSrcFolder,
sDesFolder: string;
{ SOUS-PROC
Renvoie le repertoire VISTA LOCALLOW
23/05/2008 - 10.00 - BDO
}
function SHGetKnownFolderPath(const rfid: TGUID): WideString;
var
Shell: HModule;
Fn: function(const rfid: TGUID; dwFlags: DWord; hToken: THandle;
out ppszPath: PWideChar): HResult; stdcall;
ret: HResult;
buffer: PWideChar;
begin
// Chargement de la library shell32
try
Shell := LoadLibrary('shell32.dll');
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : LoadLibrary(shell32.dll)');
end;
// Vérification du chargement
try
Win32Check(Shell <> 0);
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : Win32Check(Shell <> 0)');
end;
try
// Chargement de la fonction SHGetKnownFolderPath de la library Shell32
try
@Fn := GetProcAddress(Shell, 'SHGetKnownFolderPath');
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : GetProcAddress(Shell, SHGetKnownFolderPath) ');
end;
// Vérification du chargement
{try
Win32Check(Assigned(Fn));
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : Win32Check(Assigned(Fn))');
end; }
// Execution de la fonction chargée
if Assigned(Fn) then
begin
try
ret := Fn(rfid, 0, 0, buffer);
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : Fn(rfid, 0, 0, buffer) ');
end;
case ret of
S_OK :
begin
// Vérification de la valeur de retour
try
OleCheck(ret);
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : OleCheck(ret) ');
end;
Result := buffer;
end;
S_FALSE : raise Exception.Create(' HRESULT = S_FALSE ');
STG_E_INVALIDFUNCTION : raise Exception.Create(' HRESULT = STG_E_INVALIDFUNCTION ');
E_FAIL : raise Exception.Create(' HRESULT = E_FAIL ');
STG_E_FILENOTFOUND : raise Exception.Create(' HRESULT = STG_E_FILENOTFOUND Code = ' + IntToStr(HResultCode(ret)));
STG_E_PATHNOTFOUND : raise Exception.Create(' HRESULT = STG_E_PATHNOTFOUND Code = ' + IntToStr(HResultCode(ret)));
STG_E_TOOMANYOPENFILES : raise Exception.Create(' HRESULT = STG_E_TOOMANYOPENFILES Code = ' + IntToStr(HResultCode(ret)));
STG_E_ACCESSDENIED : raise Exception.Create(' HRESULT = STG_E_ACCESSDENIED Code = ' + IntToStr(HResultCode(ret)));
STG_E_INSUFFICIENTMEMORY : raise Exception.Create(' HRESULT = STG_E_INSUFFICIENTMEMORY Code = ' + IntToStr(HResultCode(ret)));
STG_E_NOMOREFILES : raise Exception.Create(' HRESULT = STG_E_NOMOREFILES Code = ' + IntToStr(HResultCode(ret)));
STG_E_DISKISWRITEPROTECTED : raise Exception.Create(' HRESULT = STG_E_DISKISWRITEPROTECTED Code = ' + IntToStr(HResultCode(ret)));
STG_E_SEEKERROR : raise Exception.Create(' HRESULT = STG_E_SEEKERROR Code = ' + IntToStr(HResultCode(ret)));
STG_E_LOCKVIOLATION : raise Exception.Create(' HRESULT = STG_E_LOCKVIOLATION Code = ' + IntToStr(HResultCode(ret)));
STG_E_FILEALREADYEXISTS : raise Exception.Create(' HRESULT = STG_E_FILEALREADYEXISTS Code = ' + IntToStr(HResultCode(ret)));
STG_E_INVALIDPARAMETER : raise Exception.Create(' HRESULT = STG_E_INVALIDPARAMETER Code = ' + IntToStr(HResultCode(ret)));
STG_E_MEDIUMFULL : raise Exception.Create(' HRESULT = STG_E_MEDIUMFULL Code = ' + IntToStr(HResultCode(ret)));
STG_E_INVALIDNAME : raise Exception.Create(' HRESULT = STG_E_INVALIDNAME Code = ' + IntToStr(HResultCode(ret)));
else raise Exception.Create(' Other HRESULT Code = ' + IntToStr(HResultCode(ret)));
end;
end
else
raise Exception.Create(' Not Assigned(Fn) ');
finally
try
CoTaskMemFree(buffer);
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : CoTaskMemFree(buffer) ');
end;
try
FreeLibrary(Shell);
Except
on e : Exception do
raise Exception.Create(e.Message + ' Code : FreeLibrary(Shell) ');
end;
end;
end;
// FIN SOUS-PROC
begin
// Si on est sous Vista
try
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 5) then
begin
// On récupère le repertoire qui contient les fichiers à deplacer
sSrcFolder := SHGetKnownFolderPath(FOLDERID_LOCALAPPDATALOW);
ShowMessage(sSrcFolder + 'Win32Platform : ' + IntToStr(Win32Platform) + ' Win32MajorVersion : ' + IntToStr(Win32MajorVersion) );
{sSrcFolder := IncludeTrailingPathDelimiter(sSrcFolder) + 'CptaNet\Maj\';
// On récupère le chemin de destination des fichiers
sDesFolder := cfgiIwa.sPathExeCompta + 'maj\';
// On les déplace tous
FileMove(['*.*'], sSrcFolder, sDesFolder); }
end
else
ShowMessage('Win32Platform : ' + IntToStr(Win32Platform) + ' Win32MajorVersion : ' + IntToStr(Win32MajorVersion) );
Except
on e : Exception do
ShowMessage('Erreur: ' + e.Message + ' Last error : ' + IntToStr(GetLastError));
end;
end; |
Lorsque j'ai le problème (donc sur un server 2008), le message remonté indique que la valeur de retour du HResult (ret) est de 2 ce qui ne correspond à rien dans l'aide Delphi, on passe donc dans le Else du case et je ne sais pas comment m'en sortir....
Je n'ai pas moyen d'installer Delphi sur ce server et d'après la personne qui utilise le server, cela ne semble pas planter pour tous les utilisateurs......
Une idée pour me sauver la vie?
