Current Windows Desktop Path

[ScottyC]

Hi! Does anybody know of a way to extract the current desktop path from the system? I know that in NT for example, each user can have a different desktop path. It also varies between the standard location in Win95 and WinNT, and I would like to be able to find out the correct path for the current user.

Can anybody help me?

[MartinLiss]

Private Const g_sNULL$ = ""             'Empty string
Private Const g_sSepDir$ = "\"          'Directory separator character
Private Const g_sQuote$ = """"

Enum genErrors
    genUnknownError = vbObjectError + 512 + 1000
End Enum

Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Property Get WindowsDir() As String
'-----------------------------------------------------------
' FUNCTION: GetWindowsDir
'
' Calls the windows API to get the windows directory and
' ensures that a trailing dir separator is present
'
' Returns: The windows directory
'-----------------------------------------------------------
'
    Dim sBuffer As String

    sBuffer = Space$(255)
    
    On Error GoTo ErrorRoutine
    '
    'Get the windows directory and then trim the buffer to the exact length
    'returned and add a dir sep (backslash) if the API didn't return one
    '
    If GetWindowsDirectory(sBuffer, 255) > 0 Then
        sBuffer = StripTerminator$(sBuffer)
        AddDirSep sBuffer

        WindowsDir = UCase16(sBuffer)
    Else
        WindowsDir = g_sNULL
    End If
    
    Exit Property
    
ErrorRoutine:
    Err.Raise genUnknownError, "CUtil::WindowsDir", Err.Description
    
End Property
'-----------------------------------------------------------
' SUB: AddDirSep
' Add a trailing directory path separator (back slash) to the
' end of a pathname unless one already exists
'
' IN/OUT: [strPathName] - path to add separator to
'-----------------------------------------------------------
Private Sub AddDirSep(strPathName As String)
    If Right$(RTrim$(strPathName), Len(g_sSepDir)) <> g_sSepDir Then
        strPathName = RTrim$(strPathName) & g_sSepDir
    End If
    
End Sub

Private Sub Form_Load()
MsgBox WindowsDir
End Sub
'-----------------------------------------------------------
' FUNCTION: StripTerminator
'
' Returns a string without any zero terminator.  Typically,
' this was a string returned by a Windows API call.
'
' IN: [strString] - String to remove terminator from
'
' Returns: The value of the string passed in minus any
'          terminating zero.
'-----------------------------------------------------------
Private Function StripTerminator(ByVal strString As String) As String
    Dim nZeroPos As Integer

    nZeroPos = InStr(strString, Chr$(0))
    If nZeroPos > 0 Then
        StripTerminator = Left$(strString, nZeroPos - 1)
    Else
        StripTerminator = strString
    End If
    
End Function
Private Function UCase16(ByVal str As String)
'-----------------------------------------------------------
' FUNCTION: UCase16
'
' Returns the upper-case conversion of a string
'   under 16 bits, or else returns an unmodified
'   copy of the string under 32 bits.
'
' IN: [str] - String to copy/upper-case
'
'-----------------------------------------------------------
#If Win16 Then
    UCase16 = UCase$(str)
#Else
    UCase16 = str
#End If

End Function

An to use it:

MsgBox WindowsDir

------------------
Marty

[This message has been edited by MartinLiss (edited 01-01-2000).]

[Clunietp]

Marty, how does that get the Desktop directory?

I have some code here that I dug up from MS and trial and error. I put it into a class module, but you can put this in a standard module or form, you will have to change the API declare (public/private) depending on which....

The catch: requires IE4 and above.

Public Enum fFolderNames
    f_STARTMENUPROGRAMS = &H2
    f_MYDOCUMENTS = &H5
    f_FAVORITES = &H6
    f_STARTUP = &H7
    f_RECENT = &H8
    f_SENDTO = &H9
    f_DESKTOP = &H10
    f_NETHOOD = &H13
    f_FONTS = &H14
    f_SHELLNEW = &H15
    f_ALLUSERSSTARTMENU = &H16
    f_ALLUSERSPROGRAMS = &H17
    f_ALLUSERSSTARTUP = &H18
    f_ALLUSERSDESKTOP = &H19
    f_TEMPINTERNETFILES = &H20
    f_COOKIES = &H21
    f_HISTORY = &H22
    f_WINDIR = &H24
    f_SYSDIR = &H25
    f_PROGRAMFILES = &H26
    f_MYPICTURES = &H27
End Enum

Private Declare Function SHGetFolderPath Lib "ShFolder" Alias "SHGetFolderPathA" & _
(ByVal hwnd As Long, ByVal f As Long, ByVal TOKENHANDLE As Long, & _
ByVal FLAGS As Long, ByVal lpPath As String) As Long

Public Function GetFolderPath(FolderName As fFolderNames) As String
        
    Dim Path As String * 260
    Dim ret As Long
    ret = SHGetFolderPath(0, FolderName, 0, 0, Path)
    GetFolderPath = Path
    
End Function

Usage: MSGBOX GetFolderPath(f_DESKTOP)

Tom

[This message has been edited by Clunietp (edited 01-02-2000).]

[MartinLiss]

I guess I misread the original question. My code yields the path to the system folder. C:\WINNT for example.

------------------
Marty

[ScottyC]

Cheers for the help guys!