Adresáře s profily uživatelů
Postup:
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()
Dim sBuffer As String, Ret As Long, hToken As Long
Me.AutoRedraw = True
'Zjištění
adresáře s profilem All Users
sBuffer = String(255, 0)
GetAllUsersProfileDirectory sBuffer, 255
Me.Print StripTerminator(sBuffer)
'Zjištění
adresáře defaultního profilu
sBuffer = String(255, 0)
GetDefaultUserProfileDirectory sBuffer, 255
Me.Print StripTerminator(sBuffer)
'Zjištění
adresáře s profily
sBuffer = String(255, 0)
GetProfilesDirectory sBuffer, 255
Me.Print StripTerminator(sBuffer)
'Zjištění
adresáře s profilem aktuálního uživatele
sBuffer = String(255, 0)
OpenProcessToken GetCurrentProcess, TOKEN_QUERY, hToken
GetUserProfileDirectory hToken, sBuffer, 255
Me.Print StripTerminator(sBuffer)
End Sub
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