Liste des disques system ecrits dans fichier un .ini

**pierrotm777** · 13/01/2011, 14h20

Bonjour,

J'essaie d'adapter une petite fonction trouvée sur ce forum afin
d'obtenir la liste des disques disponibles dans un fichier .ini sous ce format:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
[DriveLetters]
DISK1=C:
DISK2=D:
DISK3=E:
DISK4=G:
DISK5=
DISK6=
DISK7=

J'ai donc modifié la fonction ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function ListeDisques()
  Dim iniFile As New ClsIniFile
  iniFile.FileName = App.Path & "\skin.ini"
  iniFile.ApplicationKey = "DriveLetters"
 
  Dim fso, d, txt As String, disknumber As Integer
  Set fso = CreateObject("Scripting.FileSystemObject")
    For Each d In fso.Drives
            disknumber = 0
            iniFile.SetValue "DISK" & disknumber + 1, UCase(d.DriveLetter) & ":"
    Next
    Set fso = Nothing
End Function

Mais je n'obtiens que le dernier disk listé , dans mon cas G: au lieu de la liste ci-dessus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
[DriveLetters]
DISK1=G:
DISK2=
DISK3=
DISK4=
DISK5=
DISK6=
DISK7=

Merci de votre aide par avance

**petit rabot** · 13/01/2011, 14h53

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
For Each d In fso.Drives
            disknumber = 0
            iniFile.SetValue "DISK" & disknumber + 1, UCase(d.DriveLetter) & ":"
    Next

A mon avis, tu devrais déplacer discknumber=0 au dessus de ta ligne For each, car à chaque fois tu remet 0 dans ta variable disknumber.

**pierrotm777** · 13/01/2011, 15h43

Effectivement,

J'ai modifié ainsi mais sans succés:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Public Function ListeDisques()
  Dim iniFile As New ClsIniFile
  iniFile.FileName = App.Path & "\skin.ini"
  iniFile.ApplicationKey = "DriveLetters"
 
  Dim fso, d, txt As String, disknumber As Integer
  Set fso = CreateObject("Scripting.FileSystemObject")
  disknumber = 0
    For Each d In fso.Drives
      iniFile.SetValue "DISK" & disknumber + 1, UCase(d.DriveLetter) & ":"
    Next
    Set fso = Nothing
End Function

**petit rabot** · 13/01/2011, 15h48

Essaye ceci, car ton disknumber est toujours égale à 0 i tu ne l'incrémente pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function ListeDisques()
  Dim iniFile As New ClsIniFile
  iniFile.FileName = App.Path & "\skin.ini"
  iniFile.ApplicationKey = "DriveLetters"
 
  Dim fso, d, txt As String, disknumber As Integer
  Set fso = CreateObject("Scripting.FileSystemObject")
  disknumber = 1
    For Each d In fso.Drives
      iniFile.SetValue "DISK" & disknumber, UCase(d.DriveLetter) & ":"
      disknumber=disknumber + 1
    Next
    Set fso = Nothing
End Function

**pierrotm777** · 13/01/2011, 15h52

C'est bien mieux , mais curieusement il me manque le premier disque C:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
[DriveLetters]
DISK1=D:
DISK2=E:
DISK3=G:
DISK4=
DISK5=
DISK6=

**petit rabot** · 13/01/2011, 15h57

Modifie la mise à 1 de disknumber par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

disknumber = 0

**pierrotm777** · 13/01/2011, 16h00

J'y avais déjà pensé et déjà modifié

**petit rabot** · 13/01/2011, 16h06

Peux tu poster ton projet en .rar ou .zip, ou envoies le moi par mp.

**pierrotm777** · 13/01/2011, 16h12

Je veux bien mais c'est une dll spécifique au logiciel RideRunner et sans lui tu ne poura l'utiliser !

**ThierryAIM** · 13/01/2011, 16h20

http://vb.developpez.com/faqvbs/?pag...2#fsolistdrive

**pierrotm777** · 13/01/2011, 16h22

Bon ,j'y comprend rien car maintenant cela fonctionne ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function ListeDisques()
  Dim iniFile As New ClsIniFile
  iniFile.FileName = App.Path & "\skin.ini"
  iniFile.ApplicationKey = "DriveLetters"
 
  Dim fso, d, txt As String, disknumber As Integer
  Set fso = CreateObject("Scripting.FileSystemObject")
  disknumber = 1
    For Each d In fso.Drives
      iniFile.SetValue "DISK" & disknumber, UCase(d.DriveLetter) & ":"
      disknumber = disknumber + 1
    Next
    Set fso = Nothing
End Function

En tou cas merci beaucoup de votre aide

**petit rabot** · 13/01/2011, 16h22

Mets des arrêts dans le déroulement de ta lecture pour voir ce que ton programme lit. Tu en mets un sur chaque ligne suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    For Each d In fso.Drives
      iniFile.SetValue "DISK" & disknumber, UCase(d.DriveLetter) & ":"
      disknumber=disknumber + 1
    Next

**ThierryAIM** · 13/01/2011, 16h45

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Dim iniFile As New ClsIniFile

elle est bâtie comment ta class ??

**pierrotm777** · 13/01/2011, 16h58

Envoyé par ThierryAIM

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

  Dim iniFile As New ClsIniFile

elle est bâtie comment ta class ??

Et bien cela donne cela:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
107
108
109
Option Explicit
 
'Windows API calls
 
'This writes an entry in the INI file
'It takes as parameters the section name of the INI file,
'the name of the entry, its value and the INI filename
Private Declare Function WritePrivateProfileString _
    Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationKey As String, _
    ByVal lpKeyName As Any, _
    ByVal lsString As Any, _
    ByVal lplFilename As String) As Long
 
'This reads an entry in the INI file
'It takes as parameters the section name of the INI file,
'the name of the entry, its default value
'the string returned, its length and the INI filename.
Private Declare Function GetPrivateProfileString _
    Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationKey As String, _
    ByVal lpKeyName As String, _
    ByVal lpDefault As String, _
    ByVal lpReturnedString As String, _
    ByVal nSize As Long, _
    ByVal lpFileName As String) As Long
 
'Variable for the filename
Private m_strFile As String
 
'Variable for the section name
Private m_AppKey As String
 
Private Sub Class_Initialize()
 
    m_strFile = ""
    m_AppKey = ""
 
End Sub
 
Public Property Get FileName() As String
 
    FileName = m_strFile
 
End Property
 
Public Property Let FileName(ByVal strFile As String)
 
    m_strFile = Trim(strFile)
 
End Property
 
Public Property Get ApplicationKey() As String
 
    ApplicationKey = m_AppKey
 
End Property
 
Public Property Let ApplicationKey(ByVal strAppKey As String)
 
    m_AppKey = Trim(strAppKey)
 
End Property
 
Private Function Asc2String(str As String) As String
'Remove all unnecessary characters from the returned string
 
Dim I As Integer
Dim strOP As String
Dim intAsc As Integer
 
    str = Trim(str)
    strOP = ""
    For I = 1 To Len(str)
        intAsc = Asc(Mid(str, I, 1))
        If intAsc > 31 Then strOP = strOP & Chr(intAsc)
    Next
    Asc2String = strOP
 
End Function
 
Public Function GetValue(ByVal keyName As String, ByVal strDefault As String) As String
'Returns the key value
 
Dim strVal As String * 1000
Dim ret As Long
 
    ret = GetPrivateProfileString(m_AppKey, keyName, strDefault, strVal, Len(strVal), m_strFile)
    If ret <> 0 Then
        GetValue = Asc2String(strVal)
    Else
        GetValue = ""
    End If
 
End Function
 
Public Function SetValue(ByVal keyName As String, ByVal strValue As String) As Boolean
'Sets the key value, returns True if succeeds
 
Dim ret As Long
 
    ret = WritePrivateProfileString(m_AppKey, keyName, strValue, m_strFile)
    If ret = 0 Then
        SetValue = False
        Exit Function
    End If
    SetValue = True
 
End Function

**pierrotm777** · 13/01/2011, 17h01

Afin d'être sûre de lister que les disques présents j'ai rajouté cette petite boucle
juste avant le 'For Each' pour effacer une précédente mise à jour

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    For I = 1 To 12
      iniFile.SetValue "DISK" & I, "*"
    Next I

**ThierryAIM** · 13/01/2011, 17h54

testé sur mon pc

[DriveLetters]
DISK1=C:
DISK2=D:
DISK3=E:
DISK4=F:
DISK5=Y:
DISK6=Z:

Liste des disques system ecrits dans fichier un .ini

VB 6 et antérieur

Discussions similaires

Partager

Partager