SystemPath




Option Explicit

'Costanti ed API neccessarie

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

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

'Per le Directory WINXX e SYSTEM :

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer 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

Function DossierSpecial(ByVal CSIDL As Long) As String
'Recupera le cartelle c:\windows, c:\windows\recent...


Dim r As Long
Dim sPath As String
Dim IDL As ITEMIDLIST
Const NOERROR = 0
Const MAX_LENGTH = 260

r = SHGetSpecialFolderLocation(Form1.hWnd, CSIDL, IDL)

If r = NOERROR Then
sPath = Space$(MAX_LENGTH)
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal sPath)

If r Then
DossierSpecial = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If

End If

End Function

Private Sub Command1_Click()

Dim i As Integer
Dim pScelta As Integer
Dim NumRep As Integer

'Buffer Windows e System

Dim str As String * 128
Dim pSystem As Integer

'indice del button selezionato

For i = 1 To 20
If Option1(i).Value = True Then pScelta = i
Next i

If pScelta <= 18 Then
Select Case pScelta
Case 1: NumRep = 0
Case 2: NumRep = 2
Case 3: NumRep = 5
Case 4: NumRep = 6
Case 5: NumRep = 7
Case 6: NumRep = 8
Case 7: NumRep = 9
Case 8: NumRep = 11
Case 9: NumRep = 16
Case 10: NumRep = 19
Case 11: NumRep = 20
Case 12: NumRep = 21
Case 13: NumRep = 25
Case 14: NumRep = 26
Case 15: NumRep = 27
Case 16: NumRep = 32
Case 17: NumRep = 33
Case 18: NumRep = 34
End Select
MsgBox DossierSpecial(NumRep)
Else
If pScelta = 19 Then 'Si Windows
pSystem = GetWindowsDirectory(str, 128)
MsgBox Left(str, pSystem)
ElseIf pScelta = 20 Then 'Si System
pSystem = GetSystemDirectory(str, 128)
MsgBox Left(str, pSystem)
End If
End If

End Sub










( systempath.html )- by Paolo Puglisi - Modifica del 17/12/2023