type
LPPROFILEINFOA = ^ _PROFILEINFOA ;
_PROFILEINFOA = record
dwSize : DWORD ; // Set to sizeof(PROFILEINFO) before calling
dwFlags : DWORD ; // See flags above
lpUserName : LPSTR ; // User name (required)
lpProfilePath : LPSTR ; // Roaming profile path (optional, can be NULL)
lpDefaultPath : LPSTR ; // Default user profile path (optional, can be NULL)
lpServerName : LPSTR ; // Validating domain controller name in netbios format (optional, can be NULL but group NT4 style policy won't be applied)
lpPolicyPath : LPSTR ; // Path to the NT4 style policy file (optional, can be NULL)
hProfile : THandle ; // Filled in by the function. Registry key handle open to the root.
end ;
function LoadUserProfile ( hToken : THandle ; var lpProfileInfo : _PROFILEINFOA ) : BOOL ; stdcall ; external 'userenv.dll' name 'LoadUserProfileA' ;
function UnloadUserProfile ( hToken : THandle ; hProfile : THandle ) : BOOL ; stdcall ; external 'userenv.dll' ;
var
LoadUserProfileLog : String ;
//userprofile handles
h_Token : Cardinal ;
h_Profile : Cardinal ;
implementation
uses ComServ , SysUtils ;
class function TManager . LoadProfile ( ) : Boolean ;
var
h_Process : Cardinal ;
lpProfileInfo : _PROFILEINFOA ;
//username
UserName : string ;
UserNameLen : Dword ;
debugFile : TextFile ;
data : TDateTime ;
begin
h_Token : = 0 ;
h_Profile : = 0 ;
try
LoadUserProfileLog : = 'Before GetCurrentProcess()' #13 #10 ;
h_Process : = GetCurrentProcess ( ) ;
if ( OpenProcessToken ( h_Process , TOKEN_QUERY or TOKEN_IMPERSONATE or TOKEN_DUPLICATE , h_Token ) ) then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'After OpenProcessToken call' #13 #10 ;
UserNameLen : = 255 ;
SetLength ( userName , UserNameLen ) ;
If GetUserName ( PChar ( UserName ) , UserNameLen ) Then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'After GetUserName(): ' + Copy ( UserName , 1 , UserNameLen - 1 ) + #13 #10 ;
FillChar ( lpProfileInfo , SizeOf ( _PROFILEINFOA ) , #0 ) ;
LoadUserProfileLog : = LoadUserProfileLog + #9 'Po FillChar' #13 #10 ;
lpProfileInfo . dwSize : = SizeOf ( lpProfileInfo ) ;
lpProfileInfo . dwFlags : = PI_NOUI ;
lpProfileInfo . lpUserName : = PChar ( UserName ) ;
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile call' #13 #10 ;
if not LoadUserProfile ( h_Token , lpProfileInfo ) then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile error: ' + SysErrorMessage ( GetLastError ) + #13 #10 ;
h_Profile : = lpProfileInfo . hProfile ;
Result : = False ;
end
else
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile call success' #13 #10 ;
h_Profile : = lpProfileInfo . hProfile ;
Result : = True ;
end ;
end ;
end
except on E : Exception do
begin
LoadUserProfileLog : = LoadUserProfileLog + 'Initialize component error: ' + E . Message + #13 #10 ;
end ;
end ;
end ;
LPPROFILEINFOA = ^ _PROFILEINFOA ;
_PROFILEINFOA = record
dwSize : DWORD ; // Set to sizeof(PROFILEINFO) before calling
dwFlags : DWORD ; // See flags above
lpUserName : LPSTR ; // User name (required)
lpProfilePath : LPSTR ; // Roaming profile path (optional, can be NULL)
lpDefaultPath : LPSTR ; // Default user profile path (optional, can be NULL)
lpServerName : LPSTR ; // Validating domain controller name in netbios format (optional, can be NULL but group NT4 style policy won't be applied)
lpPolicyPath : LPSTR ; // Path to the NT4 style policy file (optional, can be NULL)
hProfile : THandle ; // Filled in by the function. Registry key handle open to the root.
end ;
function LoadUserProfile ( hToken : THandle ; var lpProfileInfo : _PROFILEINFOA ) : BOOL ; stdcall ; external 'userenv.dll' name 'LoadUserProfileA' ;
function UnloadUserProfile ( hToken : THandle ; hProfile : THandle ) : BOOL ; stdcall ; external 'userenv.dll' ;
var
LoadUserProfileLog : String ;
//userprofile handles
h_Token : Cardinal ;
h_Profile : Cardinal ;
implementation
uses ComServ , SysUtils ;
class function TManager . LoadProfile ( ) : Boolean ;
var
h_Process : Cardinal ;
lpProfileInfo : _PROFILEINFOA ;
//username
UserName : string ;
UserNameLen : Dword ;
debugFile : TextFile ;
data : TDateTime ;
begin
h_Token : = 0 ;
h_Profile : = 0 ;
try
LoadUserProfileLog : = 'Before GetCurrentProcess()' #13 #10 ;
h_Process : = GetCurrentProcess ( ) ;
if ( OpenProcessToken ( h_Process , TOKEN_QUERY or TOKEN_IMPERSONATE or TOKEN_DUPLICATE , h_Token ) ) then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'After OpenProcessToken call' #13 #10 ;
UserNameLen : = 255 ;
SetLength ( userName , UserNameLen ) ;
If GetUserName ( PChar ( UserName ) , UserNameLen ) Then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'After GetUserName(): ' + Copy ( UserName , 1 , UserNameLen - 1 ) + #13 #10 ;
FillChar ( lpProfileInfo , SizeOf ( _PROFILEINFOA ) , #0 ) ;
LoadUserProfileLog : = LoadUserProfileLog + #9 'Po FillChar' #13 #10 ;
lpProfileInfo . dwSize : = SizeOf ( lpProfileInfo ) ;
lpProfileInfo . dwFlags : = PI_NOUI ;
lpProfileInfo . lpUserName : = PChar ( UserName ) ;
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile call' #13 #10 ;
if not LoadUserProfile ( h_Token , lpProfileInfo ) then
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile error: ' + SysErrorMessage ( GetLastError ) + #13 #10 ;
h_Profile : = lpProfileInfo . hProfile ;
Result : = False ;
end
else
begin
LoadUserProfileLog : = LoadUserProfileLog + #9 'LoadUserProfile call success' #13 #10 ;
h_Profile : = lpProfileInfo . hProfile ;
Result : = True ;
end ;
end ;
end
except on E : Exception do
begin
LoadUserProfileLog : = LoadUserProfileLog + 'Initialize component error: ' + E . Message + #13 #10 ;
end ;
end ;
end ;