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 : 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
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?