Foro de elhacker.net

Option Explicit
'---------------------------------------------------------------------------------------
' Module    : mNativeGetDrives
' Author    : Karcrack
' Date      : 09/09/2009
' Purpose   : Alternative to GetLogicalDrives/GetLogicalDriveStrings/GetDriveType
'               using NATIVE APIs!!!!
' Thanks    : SkyWeb -> Tester =P
' ChangeLog :
'           - First release                                             090909
'           - Improved, now with structure and added NtGetDriveType     100909
'---------------------------------------------------------------------------------------
 
'NTDLL
Private Declare Function NtQueryInformationProcess Lib "NTDLL" (ByVal hProcess As Long, ByVal ProcessInformationClass As Long, ProcessInformation As Any, ByVal ProcessInformationLength As Long, ReturnLength As Long) As Long
 
Private Type PROCESS_DEVICEMAP_INFORMATION
    DriveMap                As Long
    DriveType(1 To 32)      As Byte
End Type
 
Private Const ProcessDeviceMap = 23
 
Public Function NtGetLogicalDrives() As Long
    Dim tPDC                    As PROCESS_DEVICEMAP_INFORMATION
 
    If NtQueryInformationProcess(-1, ProcessDeviceMap, tPDC, Len(tPDC), ByVal 0&) = 0 Then
        NtGetLogicalDrives = tPDC.DriveMap
    End If
End Function
 
Public Function NtGetLogicalDrivesStrings() As String
    Dim lUnits                  As Long
    Dim i                       As Long
 
    lUnits = NtGetLogicalDrives
 
    For i = 0 To 25
        If lUnits And 2 ^ i Then
            NtGetLogicalDrivesStrings = NtGetLogicalDrivesStrings & Chr$(Asc("A") + i) & ":\" & Chr$(0)
        End If
    Next i
End Function
 
Public Function NtGetDriveType(ByVal nDrive As String) As Long
    Dim tPDC                    As PROCESS_DEVICEMAP_INFORMATION
    Dim lNumb                   As Long
 
    If NtQueryInformationProcess(-1, ProcessDeviceMap, tPDC, Len(tPDC), ByVal 0&) = 0 Then
        lNumb = Asc(Left$(UCase$(nDrive), 1)) - Asc("A")
        If Not lNumb > 31 Then
            NtGetDriveType = tPDC.DriveType(lNumb + 1)
        End If
    End If
End Function

http://www.advancevb.com.ar/wp-content/2009/09/mNativeGetVersion.zip