La dll qui s'etend selon les demandes, 6 Ko.
NOUVEAUTES:
- Existe le fichier ?
- Taille du fichier sur 64 bits, Double pour VB.
- Place libre sur disque sur 64 bits, Double pour VB.
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.
Source / Exemple :
' enlever chemin de D:\bn2Vb.dll, seulement 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 bnLireStringCU Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, sDest As String) As Long
Declare Function bnLireStringLM 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 bnLireDwordCU Lib "D:\bn2Vb.dll" (sKey As String, sValue As String, lDest As Long) As Long
Declare Function bnLireDwordLM 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 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 jusque (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.
' EXEMPLES
Sub DireSiUserAdmin()
Dim res As Long, titre As String
titre = "ADMIN"
res = bnIsWinNT() ' test avant OBLIGATOIRE
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 = bnLireStringCU("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 = bnLireStringLM("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 bnLireDwordLM("SOFTWARE\Ahead\Shared", "ResourceCounter", ldst) Then
Debug.Print "ERROR"
Else: Debug.Print ldst
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:\toto.txt"
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.