RÉCUPÉRATION DU RÉPERTOIRE DE WINDOWS
madVinz
-
12 nov. 2001 à 22:56
z980x Messages postés 897 Date d'inscription jeudi 6 juin 2002 Statut Membre Dernière intervention 26 juillet 2007 - 21 juin 2004 à 18:16
z980x Messages postés 897 Date d'inscription jeudi 6 juin 2002 Statut Membre Dernière intervention 26 juillet 2007 - 21 juin 2004 à 18:16
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/698-recuperation-du-repertoire-de-windows
https://codes-sources.commentcamarche.net/source/698-recuperation-du-repertoire-de-windows
21 juin 2004 à 18:16
Msgbox PRGetRepertoireWindows
(Je sais, "tout le monde connait", mais ca peut toujours aider)
3 févr. 2004 à 15:11
21 août 2003 à 12:33
' API pour la récupération répertoire Windows,
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'-------------------------------------------
' Récupération du répertoire Windows
'
' Création : webcyril - Février 2001 feat. yomm
'-------------------------------------------
Function PRGetRepertoireWindows() As String
Dim WindowsDir As String * 255
Dim Longueur as Integer
' récupération du répertoire d'installation de Windows par API
Longueur = GetWindowsDirectory(WindowsDir, Len(WindowsDir))
PRGetRepertoireWindows = Left(WindowsDir, Longueur)
End Function
19 mars 2002 à 17:20
A+
12 nov. 2001 à 22:56
Option Explicit
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
Private Const gintMAX_SIZE% = 255 ' Taille maximum de la mémoire tampon
Private Const gstrNULL$ = "" ' Chaîne vide
Private Const gstrSEP_DIR$ = "" ' Séparateur de dossier
Private Const gstrSEP_URLDIR$ = "/" ' Séparateur séparant les dossiers dans les adresses URL.
'-----------------------------------------------------------
' FONCTION: GetWindowsDir
'
' Appelle une fonction API de Windows API pour obtenir le
' dossier et s'assure que le séparateur de dossier est présent
' en fin de ligne.
'
' Renvoie: Le dossier de Windows.
'-----------------------------------------------------------
'
Public Function GetWindowsDir() As String
Dim strBuf As String
strBuf = Space$(gintMAX_SIZE)
'
' Obtient le dossier de Windows et ajuste le tampon à la
' longueur exacte renvoyée, et ajoute un séparateur de
' dossier (barre oblique inverse) si l'API n'a rien renvoyé.
'
If GetWindowsDirectory(strBuf, gintMAX_SIZE) > 0 Then
strBuf = StripTerminator$(strBuf)
AddDirSep strBuf
GetWindowsDir = strBuf
Else
GetWindowsDir = gstrNULL
End If
End Function
'-----------------------------------------------------------
' FONCTION: GetWindowsSysDir
'
' Appelle une fonction API de Windows pour obtenir le dossier
' système de Windows et s'assure que le dernier séparateur
' de dossier est ajouté.
'
' RENVOIE: le dossier système de Windows.
'-----------------------------------------------------------
'
Public Function GetWindowsSysDir() As String
Dim strBuf As String
strBuf = Space$(gintMAX_SIZE)
'
' Obtient le dossier système et ajuste le tampon à la longueur
' exacte renvoyée, et ajoute un séparateur de dossier (barre
' oblique inverse) si l'API n'a rien renvoyé.
'
If GetSystemDirectory(strBuf, gintMAX_SIZE) > 0 Then
strBuf = StripTerminator(strBuf)
AddDirSep strBuf
GetWindowsSysDir = strBuf
Else
GetWindowsSysDir = gstrNULL
End If
End Function
'-----------------------------------------------------------
' FONCTION: StripTerminator
'
' Renvoie une chaîne sans aucun zéro à la fin. En général,
' il s'agit d'une chaîne renvoyée par un appel à une API de
' Windows.
'
' ENTRÉE: [strString] - la chaîne dans laquelle sont supprimés les zéros.
'
' Renvoie: La valeur de la chaîne passée, moins les zéros de la fin.
'-----------------------------------------------------------
'
Private Function StripTerminator(ByVal strString As String) As String
Dim intZeroPos As Integer
intZeroPos = InStr(strString, Chr$(0))
If intZeroPos > 0 Then
StripTerminator = Left$(strString, intZeroPos - 1)
Else
StripTerminator = strString
End If
End Function
'-----------------------------------------------------------
' PROCÉDURE: AddDirSep
' Ajoute un séparateur de chemin de dossier (barre oblique
' inverse) à la fin de la ligne, sauf s'il y en a déjà un.
'
' ENTRÉE/SORTIE: [strPathName] - chemin où ajouter le séparateur.
'-----------------------------------------------------------
'
Private Sub AddDirSep(strPathName As String)
If Right(Trim(strPathName), Len(gstrSEP_URLDIR)) <> gstrSEP_URLDIR And _
Right(Trim(strPathName), Len(gstrSEP_DIR)) <> gstrSEP_DIR Then
strPathName = RTrim$(strPathName) & gstrSEP_DIR
End If
End Sub
(de lexemple dinstall)