Dll pour vb/vba (4)

Soyez le premier à donner votre avis sur cette source.

Vue 3 350 fois - Téléchargée 191 fois

Télécharger le projet
Commenter

Description

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (BruNews)