URGENT - Getting PC personal Settings in VB ie userprofile

[GaryB1]

Hi Can anyone help

I am trying to get the command prompt %userprofile% variable into VB 6.0

this returns .....

c:\winnt\profiles\<username> or
c:\document and settings\<username>

I understand there is Kernel32.dll and advapi32.dll

I have used GetWindowsDirectory but all this returns is c:\winnt for NT and c:\document and settings\ for Win 2000 and XP but I need it working for all OS.

I had thought of getting the system OS and then inserting "\profile\" it but thats not great programming.


Any help is welcome.

Gary

[manavo11]

I guess the GetUserProfileDirectory API is what you want? An example :

Private Const TOKEN_QUERY = (&H8)
Private Declare Function GetAllUsersProfileDirectory Lib "userenv.dll" Alias "GetAllUsersProfileDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetDefaultUserProfileDirectory Lib "userenv.dll" Alias "GetDefaultUserProfileDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetProfilesDirectory Lib "userenv.dll" Alias "GetProfilesDirectoryA" (ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetUserProfileDirectory Lib "userenv.dll" Alias "GetUserProfileDirectoryA" (ByVal hToken As Long, ByVal lpProfileDir As String, lpcchSize As Long) As Boolean
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: [url]http://www.allapi.net/[/url]
    'E-Mail: [email][email protected][/email]
    Dim sBuffer As String, Ret As Long, hToken As Long
    'set the graphics mode of this form to 'persistent'
    Me.AutoRedraw = True
    'create a string buffer
    sBuffer = String(255, 0)
    'retrieve the all users profile directory
    GetAllUsersProfileDirectory sBuffer, 255
    'show the result
    Me.Print StripTerminator(sBuffer)
    'create a string buffer
    sBuffer = String(255, 0)
    'retrieve the user profile directory
    GetDefaultUserProfileDirectory sBuffer, 255
    'show the result
    Me.Print StripTerminator(sBuffer)
    'create a string buffer
    sBuffer = String(255, 0)
    'retrieve the profiles directory
    GetProfilesDirectory sBuffer, 255
    'show the result
    Me.Print StripTerminator(sBuffer)
    'create a string buffer
    sBuffer = String(255, 0)
    'open the token of the current process
    OpenProcessToken GetCurrentProcess, TOKEN_QUERY, hToken
    'retrieve this users profile directory
    GetUserProfileDirectory hToken, sBuffer, 255
    'show the result
    Me.Print StripTerminator(sBuffer)
End Sub
'strips off the trailing Chr$(0)'s
Function StripTerminator(sInput As String) As String
    Dim ZeroPos As Long
    ZeroPos = InStr(1, sInput, Chr$(0))
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function

[GaryB1]

thankyou most helpful

[manavo11]

You're welcome