Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
        Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal _
        pszPath As String) As Long

Private Declare Function SHGetSpecialFolderLocation Lib _
        "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder _
        As Long, pidl As ITEMIDLIST) As Long

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
        "GetWindowsDirectoryA" (ByVal IpBuffer As String, ByVal _
        nSize As Long) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
        "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal _
        nSize As Long) As Long

Private Declare Function GetTempPath Lib "kernel32" Alias _
        "GetTempPathA" (ByVal nBufferLength As Long, ByVal _
        lpBuffer As String) As Long

Private Type ITEMID
  cb As Long
  abID As Byte
End Type

Private Type ITEMIDLIST
  mkid As ITEMID
End Type

Private Const R_DESKTOP = &H10
Private Const R_STARTMENÜ = &HB
Private Const R_PROGRAMME = &H2
Private Const R_EIGENE_DATEIEN = &H5
Private Const R_FAVORITEN = &H6
Private Const R_AUTOSTART = &H7
Private Const R_DOKUMENTE = &H8
Private Const R_SENDEN_AN = &H9
Private Const R_NETZWERKUMGEBUNG = &H13
Private Const R_FONTS = &H14
Private Const R_NEW_SHELL = &H15
Private Const R_TEMP_INTERNET = &H20

Private Const NOERROR = 0

Private Sub Form_Load()
  With Combo1
    .AddItem "R_DESKTOP"
    .AddItem "R_STARTMENÜ"
    .AddItem "R_PROGRAMME"
    .AddItem "R_EIGENE_DATEIEN"
    .AddItem "R_FAVORITEN"
    .AddItem "R_AUTOSTART"
    .AddItem "R_DOKUMENTE"
    .AddItem "R_SENDEN_AN"
    .AddItem "R_NETZWERKUMGEBUNG"
    .AddItem "R_FONTS"
    .AddItem "R_NEW_SHELL"
    .AddItem "R_TEMP_INTERNET"
    .AddItem "WINDIR"
    .AddItem "SYSDIR"
    .AddItem "TEMPDIR"
  End With
  Combo1.ListIndex = 0
End Sub

Private Sub Combo1_Click()
  Select Case Combo1.ListIndex
    Case 0
      Text1.Text = GetSpecialFolder(R_DESKTOP)
    Case 1
      Text1.Text = GetSpecialFolder(R_STARTMENÜ)
    Case 2
      Text1.Text = GetSpecialFolder(R_PROGRAMME)
    Case 3
      Text1.Text = GetSpecialFolder(R_EIGENE_DATEIEN)
    Case 4
      Text1.Text = GetSpecialFolder(R_FAVORITEN)
    Case 5
      Text1.Text = GetSpecialFolder(R_AUTOSTART)
    Case 6
      Text1.Text = GetSpecialFolder(R_DOKUMENTE)
    Case 7
      Text1.Text = GetSpecialFolder(R_SENDEN_AN)
    Case 8
      Text1.Text = GetSpecialFolder(R_NETZWERKUMGEBUNG)
    Case 9
      Text1.Text = GetSpecialFolder(R_FONTS)
    Case 10
      Text1.Text = GetSpecialFolder(R_NEW_SHELL)
    Case 11
      Text1.Text = GetSpecialFolder(R_TEMP_INTERNET)
    Case 12
      Text1.Text = WINDIR
    Case 13
      Text1.Text = SYSDIR
    Case 14
      Text1.Text = TEMPDIR
  End Select
End Sub

Function GetSpecialFolder(Num As Long) As String
  Dim Result As Long
  Dim Buff As String
  Dim idl As ITEMIDLIST

  Result = SHGetSpecialFolderLocation(Form1.hWnd, Num, idl)

  If Result = NOERROR Then
    Buff = Space$(512)
    Result = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal Buff)
    If Result Then
      GetSpecialFolder = _
            Left$(Buff, InStr(1, Buff, vbNullChar) - 1)
    End If
  End If
End Function

Function WINDIR() As String
  Dim x%, a%, temp$

  temp$ = Space$(255)
  x = GetWindowsDirectory(temp$, Len(temp$))
  WINDIR = Left$(temp$, x)
End Function

Function SYSDIR() As String
  Dim temp As String
  Dim vLen As Long

  temp = Space(255)
  vLen = GetSystemDirectory(temp, Len(temp))
  temp = Left(temp, vLen)
  SYSDIR = temp
End Function

Function TEMPDIR() As String
  Dim r As String
  Dim buffer As String
  Dim BufferLen As Long

  buffer = Space(255)
  r = GetTempPath(Len(buffer), buffer)
  TEMPDIR = Left(buffer, InStr(buffer, Chr(0)) - 1)
  If Right(TEMPDIR, 1) = "\" Then _
          TEMPDIR = Left(TEMPDIR, Len(TEMPDIR) - 1)
End Function