Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2003.06.19;
Скачать: CL | DM;

Вниз

Срочный вопрос !!!! Как получить путь к Program Files ?   Найти похожие ветки 

 
SiJack ©   (2003-06-06 09:18) [0]

Может кто навскидку подскажет функцию ?


 
Внук ©   (2003-06-06 09:37) [1]

GetEnvironmentVariable("ProgramFiles",...)


 
SVM (Perm)   (2003-06-06 09:52) [2]

SHGetFolderPath


 
McSimm2   (2003-06-06 10:06) [3]


function GetProgramFilesDirByKeyStr(KeyStr: string): string;
var
dwKeySize: DWORD;
Key: HKEY;
dwType: DWORD;
begin
if
RegOpenKeyEx( HKEY_LOCAL_MACHINE, PChar(KeyStr), 0, KEY_READ, Key ) =
ERROR_SUCCESS
then
try
RegQueryValueEx( Key, "ProgramFilesDir", nil, @dwType, nil, @dwKeySize );
if (dwType in [REG_SZ, REG_EXPAND_SZ]) and (dwKeySize > 0) then
begin
SetLength( Result, dwKeySize );
RegQueryValueEx( Key, "ProgramFilesDir", nil, @dwType,
PByte(PChar(Result)),
@dwKeySize );
end
else
begin
RegQueryValueEx( Key, "ProgramFilesPath", nil, @dwType, nil, @dwKeySize
);
if (dwType in [REG_SZ, REG_EXPAND_SZ]) and (dwKeySize > 0) then
begin
SetLength( Result, dwKeySize );
RegQueryValueEx( Key, "ProgramFilesPath", nil, @dwType,
PByte(PChar(Result)),
@dwKeySize );
end;
end;
finally
RegCloseKey( Key );
end;
end;

function GetProgramFilesDir: string;
const
DefaultProgramFilesDir = "%SystemDrive%\Program Files";
var
FolderName: string;
dwStrSize: DWORD;
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
FolderName :=
GetProgramFilesDirByKeyStr("Software\Microsoft\Windows
NT\CurrentVersion");
end;
if Length(FolderName) = 0 then
begin
FolderName :=
GetProgramFilesDirByKeyStr("Software\Microsoft\Windows\CurrentVersion");
end;
if Length(FolderName) = 0 then FolderName := DefaultProgramFilesDir;
dwStrSize := ExpandEnvironmentStrings( PChar(FolderName), nil, 0 );
SetLength( Result, dwStrSize );
ExpandEnvironmentStrings( PChar(FolderName), PChar(Result), dwStrSize );
end;



 
SiJack ©   (2003-06-06 10:14) [4]

спасибо за помощь



Страницы: 1 вся ветка

Текущий архив: 2003.06.19;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.065 c
14-60352
TRh
2003-05-28 15:42
2003.06.19
Восстанавливаем исходники


3-60032
vvvvv
2003-05-27 16:26
2003.06.19
Можно-ли через ADO упаковать *.mdb ?


7-60443
Bug
2003-04-16 10:22
2003.06.19
версия ОС.


6-60287
xman
2003-04-16 10:36
2003.06.19
Речь


1-60237
Сергей Ю.
2003-06-03 20:04
2003.06.19
Порядок окон