厚德载物

GetUserDirectoryExample.LSS

‘LS.UserDirectoryEx.BE.6:

Option Public
Option Declare

%REM ************************** Purpose **************************
This little script library contains a function and some C API calls that allow you to
determine the user’s personal directory in Windows – where their things like the Document and
Settings directories are, etc. Very handy.

There are three Win32 C API calls in Declarations that are called in the getUserDirectoryPath function.
To use the function you simply pass in an empty string var on the function, and it returns the user’s
profile directory in that var. The function itself returns a 0 if there are no errors, and a non-0 if there
are errors.

The StripTerminator function is used to removed the null terminators and trailing spaces from the string buffer
used by the C API call.

%END REM

Const TOKEN_QUERY = (&H8)
Declare Function GetUserProfileDirectory Lib "userenv.dll" Alias "GetUserProfileDirectoryA" (Byval hToken As Long, Byval lpProfileDir As String, lpcchSize As Long) As Boolean
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function OpenProcessToken Lib "advapi32" (Byval ProcessHandle As Long, Byval DesiredAccess As Long, TokenHandle As Long) As Long

Function getUserDirectoryPath(userDir As String) As Long
 On Error Goto errHandler
 Dim htoken As Long
 
 REM this little bit is to make sure we’re on a Win platform – if not, throw an error
 Dim s As New NotesSession
 If Lcase(Left(s.Platform, 3)) <> "win" Then Error 1001, "WINDOWS ONLY – this function is for windows only, sorry."
 
 userDir = String(255, 0) ‘ build a string buffer to pass to the C API function
 OpenProcessToken GetCurrentProcess, TOKEN_QUERY, hToken ‘ get handle token – C API call
 Call GetUserProfileDirectory(hToken, userDir, 255) ‘ get profile directory – C API call
 userDir = StripTerminator(userDir) ‘ function to strip extra spaces and null terminator
 
getOut:
 Exit Function
errHandler:
 On Error Goto 0
 userDir = ""
 getUserDirectoryPath = Err ‘ return the error number on the function
 Error Err, Error$ & " [in " & Lsi_info(2) & "]"
 Resume getOut        
End Function
Function StripTerminator(sInput As String) As String
 On Error Goto errHandler
 Dim ZeroPos As Long
 ZeroPos = Instr(1, sInput, Chr$(0))
 If ZeroPos > 0 Then
  StripTerminator = Left$(sInput, ZeroPos – 1)
 Else
  StripTerminator = sInput
 End If
getOut:
 Exit Function
errHandler:
 On Error Goto 0
 Error Err, Error$ & " [in " & Lsi_info(2) & "]"
 Resume getOut        
End Function