mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-16 00:30:44 +01:00
Added getappconfig calls
This commit is contained in:
michael
parent
370f47e611
commit
6bf44ccc0f
@ -23,6 +23,7 @@ interface
|
||||
|
||||
{$DEFINE HAS_SLEEP}
|
||||
{$DEFINE HAS_OSERROR}
|
||||
{$DEFINE HAS_OSCONFIG}
|
||||
{$DEFINE HASUNIX}
|
||||
|
||||
uses
|
||||
@ -631,6 +632,54 @@ begin
|
||||
Result:=fpgetErrNo;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Application config files
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
|
||||
Function GetHomeDir : String;
|
||||
|
||||
begin
|
||||
Result:=GetEnvironmentVariable('HOME');
|
||||
If (Result<>'') then
|
||||
Result:=IncludeTrailingPathDelimiter(Result);
|
||||
end;
|
||||
|
||||
Function GetAppConfigDir(Global : Boolean) : String;
|
||||
|
||||
begin
|
||||
If Global then
|
||||
Result:=SysConfigDir
|
||||
else
|
||||
Result:=GetHomeDir+ApplicationName;
|
||||
end;
|
||||
|
||||
Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
|
||||
|
||||
begin
|
||||
if Global then
|
||||
begin
|
||||
Result:=IncludeTrailingPathDelimiter(SysConfigDir);
|
||||
if SubDir then
|
||||
Result:=IncludeTrailingPathDelimiter(Result+ApplicationName);
|
||||
Result:=Result+ApplicationName+ConfigExtension;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if SubDir then
|
||||
begin
|
||||
Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
|
||||
Result:=Result+ApplicationName+ConfigExtension;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=GetHomeDir;
|
||||
Result:=Result+'.'+ApplicationName;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Initialization code
|
||||
****************************************************************************}
|
||||
@ -638,13 +687,17 @@ end;
|
||||
Initialization
|
||||
InitExceptions; { Initialize exceptions. OS independent }
|
||||
InitInternational; { Initialize internationalization settings }
|
||||
SysConfigDir:='/etc'; { Initialize system config dir }
|
||||
Finalization
|
||||
DoneExceptions;
|
||||
end.
|
||||
{
|
||||
|
||||
$Log$
|
||||
Revision 1.43 2004-07-03 21:50:31 daniel
|
||||
Revision 1.44 2004-08-05 07:32:51 michael
|
||||
Added getappconfig calls
|
||||
|
||||
Revision 1.43 2004/07/03 21:50:31 daniel
|
||||
* Modified bootstrap code so separate prt0.as/prt0_10.as files are no
|
||||
longer necessary
|
||||
|
||||
|
||||
@ -35,7 +35,7 @@ uses
|
||||
|
||||
{$DEFINE HAS_SLEEP}
|
||||
{$DEFINE HAS_OSERROR}
|
||||
|
||||
{$DEFINE HAS_OSCONFIG}
|
||||
{ Include platform independent interface part }
|
||||
{$i sysutilh.inc}
|
||||
|
||||
@ -800,6 +800,143 @@ function LoadLibrary(lpLibFileName : pchar):THandle;
|
||||
function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
|
||||
stdcall;external 'kernel32' name 'GetProcAddress';
|
||||
|
||||
Const
|
||||
CSIDL_PROGRAMS = $0002; { %SYSTEMDRIVE%\Program Files }
|
||||
CSIDL_PERSONAL = $0005; { %USERPROFILE%\My Documents }
|
||||
CSIDL_FAVORITES = $0006; { %USERPROFILE%\Favorites }
|
||||
CSIDL_STARTUP = $0007; { %USERPROFILE%\Start menu\Programs\Startup }
|
||||
CSIDL_RECENT = $0008; { %USERPROFILE%\Recent }
|
||||
CSIDL_SENDTO = $0009; { %USERPROFILE%\Sendto }
|
||||
CSIDL_STARTMENU = $000B; { %USERPROFILE%\Start menu }
|
||||
CSIDL_MYMUSIC = $000D; { %USERPROFILE%\Documents\My Music }
|
||||
CSIDL_MYVIDEO = $000E; { %USERPROFILE%\Documents\My Videos }
|
||||
CSIDL_DESKTOPDIRECTORY = $0010; { %USERPROFILE%\Desktop }
|
||||
CSIDL_NETHOOD = $0013; { %USERPROFILE%\NetHood }
|
||||
CSIDL_TEMPLATES = $0015; { %USERPROFILE%\Templates }
|
||||
CSIDL_COMMON_STARTMENU = $0016; { %PROFILEPATH%\All users\Start menu }
|
||||
CSIDL_COMMON_PROGRAMS = $0017; { %PROFILEPATH%\All users\Start menu\Programs }
|
||||
CSIDL_COMMON_STARTUP = $0018; { %PROFILEPATH%\All users\Start menu\Programs\Startup }
|
||||
CSIDL_COMMON_DESKTOPDIRECTORY = $0019; { %PROFILEPATH%\All users\Desktop }
|
||||
CSIDL_APPDATA = $001A; { %USERPROFILE%\Application Data (roaming) }
|
||||
CSIDL_PRINTHOOD = $001B; { %USERPROFILE%\Printhood }
|
||||
CSIDL_LOCAL_APPDATA = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming) }
|
||||
CSIDL_COMMON_FAVORITES = $001F; { %PROFILEPATH%\All users\Favorites }
|
||||
CSIDL_INTERNET_CACHE = $0020; { %USERPROFILE%\Local Settings\Temporary Internet Files }
|
||||
CSIDL_COOKIES = $0021; { %USERPROFILE%\Cookies }
|
||||
CSIDL_HISTORY = $0022; { %USERPROFILE%\Local settings\History }
|
||||
CSIDL_COMMON_APPDATA = $0023; { %PROFILESPATH%\All Users\Application Data }
|
||||
CSIDL_WINDOWS = $0024; { %SYSTEMROOT% }
|
||||
CSIDL_SYSTEM = $0025; { %SYSTEMROOT%\SYSTEM32 (may be system on 95/98/ME) }
|
||||
CSIDL_PROGRAM_FILES = $0026; { %SYSTEMDRIVE%\Program Files }
|
||||
CSIDL_MYPICTURES = $0027; { %USERPROFILE%\My Documents\My Pictures }
|
||||
CSIDL_PROFILE = $0028; { %USERPROFILE% }
|
||||
CSIDL_PROGRAM_FILES_COMMON = $002B; { %SYSTEMDRIVE%\Program Files\Common }
|
||||
CSIDL_COMMON_TEMPLATES = $002D; { %PROFILEPATH%\All Users\Templates }
|
||||
CSIDL_COMMON_DOCUMENTS = $002E; { %PROFILEPATH%\All Users\Documents }
|
||||
CSIDL_COMMON_ADMINTOOLS = $002F; { %PROFILEPATH%\All Users\Start Menu\Programs\Administrative Tools }
|
||||
CSIDL_ADMINTOOLS = $0030; { %USERPROFILE%\Start Menu\Programs\Administrative Tools }
|
||||
CSIDL_COMMON_MUSIC = $0035; { %PROFILEPATH%\All Users\Documents\my music }
|
||||
CSIDL_COMMON_PICTURES = $0036; { %PROFILEPATH%\All Users\Documents\my pictures }
|
||||
CSIDL_COMMON_VIDEO = $0037; { %PROFILEPATH%\All Users\Documents\my videos }
|
||||
CSIDL_CDBURN_AREA = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning }
|
||||
CSIDL_PROFILES = $003E; { %PROFILEPATH% }
|
||||
|
||||
CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet) }
|
||||
|
||||
|
||||
Type
|
||||
PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall;
|
||||
|
||||
Var
|
||||
SHGetFolderPath : PFNSHGetFolderPath = Nil;
|
||||
CFGDLLHandle : THandle = 0;
|
||||
|
||||
Procedure InitDLL;
|
||||
|
||||
Var
|
||||
P : Pointer;
|
||||
|
||||
begin
|
||||
CFGDLLHandle:=LoadLibrary('shell32.dll');
|
||||
if (CFGDLLHandle<>0) then
|
||||
begin
|
||||
P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
|
||||
If (P=Nil) then
|
||||
begin
|
||||
FreeLibrary(CFGDLLHandle);
|
||||
CFGDllHandle:=0;
|
||||
end
|
||||
else
|
||||
SHGetFolderPath:=PFNSHGetFolderPath(P);
|
||||
end;
|
||||
If (P=Nil) then
|
||||
begin
|
||||
CFGDLLHandle:=LoadLibrary('shfolder.dll');
|
||||
if (CFGDLLHandle<>0) then
|
||||
begin
|
||||
P:=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA');
|
||||
If (P=Nil) then
|
||||
begin
|
||||
FreeLibrary(CFGDLLHandle);
|
||||
CFGDllHandle:=0;
|
||||
end
|
||||
else
|
||||
ShGetFolderPath:=PFNSHGetFolderPath(P);
|
||||
end;
|
||||
end;
|
||||
If (@ShGetFolderPath=Nil) then
|
||||
Raise Exception.Create('Could not determine SHGetFolderPath Function');
|
||||
end;
|
||||
|
||||
Function GetSpecialDir(ID : Integer) : String;
|
||||
|
||||
Var
|
||||
APath : Array[0..MAX_PATH] of char;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
if (CFGDLLHandle=0) then
|
||||
InitDLL;
|
||||
If (SHGetFolderPath<>Nil) then
|
||||
begin
|
||||
if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then
|
||||
Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0]));
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetAppConfigDir(Global : Boolean) : String;
|
||||
|
||||
begin
|
||||
If Global then
|
||||
Result:=DGetAppConfigDir(Global) // or use windows dir ??
|
||||
else
|
||||
begin
|
||||
Result:=GetSpecialDir(CSIDL_LOCAL_APPDATA)+ApplicationName;
|
||||
If (Result='') then
|
||||
Result:=DGetAppConfigDir(Global);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String;
|
||||
|
||||
begin
|
||||
if Global then
|
||||
begin
|
||||
Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global));
|
||||
if SubDir then
|
||||
Result:=IncludeTrailingPathDelimiter(Result+'Config');
|
||||
Result:=Result+ApplicationName+ConfigExtension;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False));
|
||||
if SubDir then
|
||||
Result:=Result+'Config\';
|
||||
Result:=Result+ApplicationName+ConfigExtension;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Initialization
|
||||
InitExceptions; { Initialize exceptions. OS independent }
|
||||
@ -810,10 +947,15 @@ Finalization
|
||||
DoneExceptions;
|
||||
if kernel32dll<>0 then
|
||||
FreeLibrary(kernel32dll);
|
||||
if CFGDLLHandle<>0 then
|
||||
FreeLibrary(CFGDllHandle);
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 2004-06-13 10:49:50 florian
|
||||
Revision 1.35 2004-08-05 07:28:37 michael
|
||||
Added getappconfig calls
|
||||
|
||||
Revision 1.34 2004/06/13 10:49:50 florian
|
||||
* fixed some bootstrapping problems as well as some 64 bit stuff
|
||||
|
||||
Revision 1.33 2004/02/13 10:50:23 marco
|
||||
|
||||
Loading…
Reference in New Issue
Block a user