1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
| Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0
Private Declare Function WNetGetConnection Lib "mpr.dll" Alias "WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Command1_Click()
Dim SAD As String, ST As String
SAD = CHDSKS
If SAD <> "" Then
Do
ST = Mid$(SAD, 1, InStr(SAD, vbNullChar) - 1)
SAD = Mid$(SAD, InStr(SAD, vbNullChar) + 1)
Select Case types(ST)
Case "amovible", "Local", "CD Rom":
List1.AddItem ST & " " & types(ST) & _
IIf(Dir(ST, vbVolume) <> "", " et prêt", " mais non prêt")
Case "Réseau":
List1.AddItem ST & " réseau"
List1.AddItem " UNC Path : " & GUP(Left$(ST, Len(ST) - 1))
End Select
Loop While SAD <> ""
End If
End Sub
Private Function GUP(DL As String) As String
On Local Error GoTo GUPERR
Dim Msg As String, LR As Long, Nomloc As String, NomLoin As String, NomLoinC As Long
Nomloc = DL
NomLoin = String$(255, Chr$(32))
NomLoinC = Len(NomLoin)
LR = WNetGetConnection(Nomloc, NomLoin, NomLoinC)
Select Case LR
Case ERROR_BAD_DEVICE
Msg = "Error: Bad Device"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Error: Connection Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "Error: Extended Error"
Case ERROR_MORE_DATA
Msg = "Error: More Data"
Case ERROR_NOT_SUPPORTED
Msg = "Error: Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "Error: No Network Available or Bad Path"
Case ERROR_NO_NETWORK
Msg = "Error: No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Error: Not Connected"
Case NO_ERROR
End Select
If Len(Msg) Then
MsgBox Msg, vbInformation
Else
GUP = Left$(NomLoin, NomLoinC)
End If
GUPE:
Exit Function
GUPERR:
MsgBox Err.Description, vbInformation
Resume GUPE
End Function
Private Function CHDSKS() As String
Dim LR As Long, LT As Long, CHDs As String * 255
LT = Len(CHDs)
LR = GetLogicalDriveStrings(LT, CHDs)
CHDSKS = Left(CHDs, LR)
End Function
Private Function types(CHDNM As String) As String
Dim LR As Long
Dim CHD As String
LR = GetDriveType(CHDNM)
Select Case LR
Case DRIVE_UNKNOWN
CHD = "Type inconnu"
Case DRIVE_ABSENT
CHD = "N'existe pas"
Case DRIVE_REMOVABLE
CHD = "amovible"
Case DRIVE_FIXED
CHD = "Local"
Case DRIVE_REMOTE
CHD = "Réseau"
Case DRIVE_CDROM
CHD = "CD Rom"
Case DRIVE_RAMDISK
CHD = "Ram Disk"
End Select
types = CHD
End Function |
