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 |