VB Code:
  1. Const CSIDL_DESKTOP = &H0
  2. Const CSIDL_PROGRAMS = &H2
  3. Const CSIDL_CONTROLS = &H3
  4. Const CSIDL_PRINTERS = &H4
  5. Const CSIDL_PERSONAL = &H5
  6. Const CSIDL_FAVORITES = &H6
  7. Const CSIDL_STARTUP = &H7
  8. Const CSIDL_RECENT = &H8
  9. Const CSIDL_SENDTO = &H9
  10. Const CSIDL_BITBUCKET = &HA
  11. Const CSIDL_STARTMENU = &HB
  12. Const CSIDL_DESKTOPDIRECTORY = &H10
  13. Const CSIDL_DRIVES = &H11
  14. Const CSIDL_NETWORK = &H12
  15. Const CSIDL_NETHOOD = &H13
  16. Const CSIDL_FONTS = &H14
  17. Const CSIDL_TEMPLATES = &H15
  18. Const MAX_PATH = 260
  19. Private Type SH_ITEMID
  20.     cb As Long
  21.     abID As Byte
  22. End Type
  23. Private Type ITEMIDLIST
  24.     mkid As SH_ITEMID
  25. End Type
  26. Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hWnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long
  27. Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long
  28. Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
  29. Private Sub Form_Load()
  30.     'KPD-Team 1998
  31.     'URL: [url]http://www.allapi.net/[/url]
  32.     'E-Mail: [email][email protected][/email]
  33.     'Show an about window
  34.     ShellAbout Me.hWnd, App.Title, "Created by the KPD-Team 1999", ByVal 0&
  35.     'Set the graphical mode to persistent
  36.     Me.AutoRedraw = True
  37.     'Print the folders to the form
  38.     Me.Print "Start menu folder: " + GetSpecialfolder(CSIDL_STARTMENU)
  39.     Me.Print "Favorites folder: " + GetSpecialfolder(CSIDL_FAVORITES)
  40.     Me.Print "Programs folder: " + GetSpecialfolder(CSIDL_PROGRAMS)
  41.     Me.Print "Desktop folder: " + GetSpecialfolder(CSIDL_DESKTOP)
  42. End Sub
  43. Private Function GetSpecialfolder(CSIDL As Long) As String
  44.     Dim r As Long
  45.     Dim IDL As ITEMIDLIST
  46.     'Get the special folder
  47.     r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
  48.     If r = NOERROR Then
  49.         'Create a buffer
  50.         Path$ = Space$(512)
  51.         'Get the path from the IDList
  52.         r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)
  53.         'Remove the unnecessary chr$(0)'s
  54.         GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)
  55.         Exit Function
  56.     End If
  57.     GetSpecialfolder = ""
  58. End Function