Delphi LoadUserProfile

来源:互联网 发布:大雄的生化危机 知乎 编辑:程序博客网 时间:2024/04/30 09:06
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;
0 0
原创粉丝点击