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; |
Partager