La dll (6,5 Ko) qui s'etend selon les demandes.
NOUVEAUTES:
- Ecritue registres CURENT_USER et LOCAL_MACHINE.
DEJA FOURNI:
Lecture registres CURENT_USER et LOCAL_MACHINE.
Determine si current user est administrateur.
Vitesse processeur.
Mesures en hautes precisions.
Selecteur de dossiers avec initialisation du dossier de depart.
Existe et taille fichier, place libre sur disque.
Source / Exemple :
' enlever chemin de "D:\bn2Vb.dll", juste pour tests perso
Declare Function bnIsWinNT Lib "D:\bn2Vb.dll" () As Long
Declare Function bnIsUserAdminNT Lib "D:\bn2Vb.dll" () As Long
Declare Function bnIsPrecisionOK Lib "D:\bn2Vb.dll" () As Long
Declare Function bnCpuSpeedMghz Lib "D:\bn2Vb.dll" () As Long
Declare Sub bnTicksStart Lib "D:\bn2Vb.dll" ()
Declare Function bnTicksResult Lib "D:\bn2Vb.dll" () As Double
Declare Sub bnMilliscndStart Lib "D:\bn2Vb.dll" ()
Declare Function bnMilliscndResult Lib "D:\bn2Vb.dll" () As Double
Declare Function bnRegLireStringCU Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, sDest As String) As Long
Declare Function bnRegLireStringLM Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, sDest As String) As Long
' valeurs de retour
' 0 - OK, sDest sera String valide, vide possible
' 1 - cle ou valeur inexistante ou impossible d'ouvrir ou autre
' 2 - type non string
' 3 - defaut de memoire
Declare Function bnRegLireDwordCU Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, lDest As Long) As Long
Declare Function bnRegLireDwordLM Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, lDest As Long) As Long
' valeurs de retour
' 0 - OK, lDest sera valide au retour
' <> 0 - impossible de lire, valeur non DWORD ou autre
Declare Function bnRegEcritStringCU Lib "D:\bn2Vb.dll" (ByVal sKey As String, ByVal sValue As String, ByVal sStr As String) As Long
Declare Function bnRegEcritStringLM Lib "D:\bn2Vb.dll" (ByVal sKey As String, ByVal sValue As String, ByVal sStr As String) As Long
Declare Function bnRegEcritDwordCU Lib "D:\bn2Vb.dll" (ByVal sKey As String, ByVal sValue As String, ByVal lVal As Long) As Long
Declare Function bnRegEcritDwordLM Lib "D:\bn2Vb.dll" (ByVal sKey As String, ByVal sValue As String, ByVal lVal As Long) As Long
' retourne <> 0 si erreur
Declare Function bnSelectDir Lib "D:\bn2Vb.dll" (sTitre As String, sDir As String) As Long
' retourne <> 0 - dossier choisi, sDir sort avec \ final
' retourne 0 - sDir ne change pas
Declare Function bnFileExists Lib "D:\bn2Vb.dll" (ByVal sFile As String) As Long
' retourne <> 0 si fichier existe
Declare Function bnFileSize Lib "D:\bn2Vb.dll" (ByVal sFile As String) As Double
' de 0 => (2^64)-1 qui est le maxi sur win32.
Declare Function bnGetDiskFreeSpace Lib "D:\bn2Vb.dll" (ByVal sRootFile As String) As Double
' peut passer "D:\" ou "C:" ou "D:\toto.txt", va idem.
Sub DireSiUserAdmin()
Dim res As Long, titre As String
titre = "ADMIN"
res = bnIsWinNT()
If res Then res = bnIsUserAdminNT()
If res Then
MsgBox "OUI", vbInformation, titre
Else
MsgBox "NON", vbExclamation, titre
End If
End Sub
Sub TestPrecision()
If bnIsPrecisionOK Then MsgBox "bnPrecisionOK"
End Sub
Sub DireCpuSpeed()
If bnIsPrecisionOK Then MsgBox bnCpuSpeedMghz
End Sub
Sub TestTicks()
Dim res As Double
If bnIsPrecisionOK = 0 Then Exit Sub
bnTicksStart
res = PerdreTemps(9500000)
MsgBox bnTicksResult
End Sub
Sub TestMillisecondes()
Dim res As Double
If bnIsPrecisionOK = 0 Then Exit Sub
bnMilliscndStart
res = PerdreTemps(9500000)
MsgBox bnMilliscndResult
End Sub
Sub litSringCurrentUser()
Dim lret As Long, sdst As String
lret = bnRegLireStringCU("Software\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders", "My Pictures", sdst)
If lret = 0 Then
Debug.Print sdst
Debug.Print Len(sdst)
Else: Debug.Print "ERROR " & lret
End If
lret = bnRegLireStringLM("SOFTWARE\Elaborate Bytes\CloneCD", "Install_Dir", sdst)
If lret = 0 Then
Debug.Print sdst
Debug.Print Len(sdst)
Else: Debug.Print "ERROR " & lret
End If
End Sub
Sub LireDwordLocalMachine()
Dim ldst As Long
If bnRegLireDwordLM("SOFTWARE\Ahead\Shared", "ResourceCounter", ldst) Then
Debug.Print "ERROR"
Else: Debug.Print ldst
End If
End Sub
Sub EcritStringLocalMachine()
Dim toIns As String
' toIns = "Un exemple"
If bnRegEcritStringLM("SOFTWARE\BruNews\Test", "MaStr", toIns) Then
MsgBox "ERROR"
Else: MsgBox "OK"
End If
End Sub
Sub EcritDwordCurrentUser()
If bnRegEcritDwordCU("SOFTWARE\BruNews\Test2", "MaStr", 278) Then
MsgBox "ERROR"
Else: MsgBox "OK"
End If
End Sub
Sub ChoisitDossier()
Dim strDir As String, sTitle As String
sTitle = "Dossier depuis Excel"
strDir = "D:\bosser"
If bnSelectDir(sTitle, strDir) Then Debug.Print strDir
If bnSelectDir(sTitle, strDir) Then Debug.Print strDir
End Sub
Sub ExisteFichier()
Dim strFile As String
strFile = "d:\NTT586.C"
If bnFileExists(strFile) Then
MsgBox "OUI"
Else: MsgBox "NON"
End If
End Sub
Sub TailleFichier()
Dim strFile As String
strFile = "d:\NTT586.C"
MsgBox strFile, vbInformation, bnFileSize(strFile)
End Sub
Sub LibreSurDisque()
Dim strFile As String
strFile = "h:"
MsgBox strFile, vbInformation, bnGetDiskFreeSpace(strFile)
End Sub
Function PerdreTemps(num As Long) As Double
Dim d As Double, i As Long
d = 1.5
While num
d = d + 1.5
d = d - 1
d = d + i
num = num - 1
Wend
PerdreTemps = d
End Function
Conclusion :
Tous les exemples sont faits sur Excel.
Postez moi vos demandes d'extensions.
Sera fait suivant disponibilite.
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.