Quelques api trés simple et utile

Soyez le premier à donner votre avis sur cette source.

Vue 23 103 fois - Téléchargée 2 394 fois

Description

Slt
Ci joint qq api avec Exemple d'utilisation (commenté..)
Elle sont trés simple et peuvent étre utilie :

- Flash Windows : Fait Clignoter la caption de la form
- Beep : Emet des sons par le speaker du Pc (Beep de vb marche po!!)
- Sleep : Fait attendre l'execution du code
- BlockInput : Desactive le clavier et la souris
- FindExecutable : Trouve le programme associé au fichier
- GetUserName : Donne le nom d'utilisateur de la session
- GetCursorPos : Donne la position de la souris
- SetCursorPos : Modifie la position de la souris
- PlaySound : Joue un fichier son
- SetComputerName : Change le nom de l'ordinateur
- SetVolumeLabel : Change le nom de volume d'un disque
- InetIsOffline : L'odi est il connecter a internet???
- GetDiskFreeSpace : Info Espace Disque
- GetTickCount : Donne le temps en sec depuis lequelle windows a démmarer
(GetTickcount peu etre utile pour calculer le temps qu'a pris une tache : on releve le temp T1 avant de lancer la procedure, et le temp T2 une fois la procedure fini. T2-T1 donne le temp écouler en secondes!!!)

Voila ce sont des api qui peuvent etre utile, mais ce sont vraiment des apis facile a utiliser (ideal pour debutant!!!)

Source / Exemple :


'Déclaration api SetVolumeLabel
Private Declare Function SetVolumeLabel Lib "kernel32" Alias "SetVolumeLabelA" (ByVal lpRootPathName As String, ByVal lpVolumeName As String) As Long
'Déclaration api SetCursorPos
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'Déclaration api SetComputerName
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
'Déclaration api PlaySound
Private Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwFlags As Long) As Long
'Déclaration api InetIsOffline
Private Declare Function InetIsOffline Lib "url.dll" (ByVal dwFlags As Long) As Long
'Déclaration api GetTickCount
Private Declare Function GetTickCount& Lib "kernel32" ()
'Déclaration api GetDiskFreeSpaceEx
Private Declare Function GetDiskFreeSpaceEx Lib "kernel32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long
'Déclaration api GetCursorPos
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    x As Long
    y As Long
End Type
'Déclaration api GetUserName
Private Const MAX_COMPUTERNAME_LENGTH As Long = 31
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'Déclaration api FindExecutable
Const MAX_FILENAME_LEN = 260
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
'Déclaration api blockinput (clavier souris)
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
'Décaration api Sleep
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'Déclaration api flash de la fenetre
Private Declare Function FlashWindow Lib "user32" (ByVal hwnd As Long, ByVal bInvert As Long) As Long
Const Invert = 1
'Déclaration Api Beep
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
'Api Flahwindows
Private Sub Command1_Click()
 Me.WindowState = 1
 Me.Caption = "Api FlashWindow"
If Timer1.Enabled = False Then Timer1.Enabled = True Else Timer1.Enabled = False
End Sub

Private Sub Command10_Click()
MsgBox "Etes vous connecté a internet? " + CStr(CBool(Not (InetIsOffline(0)))), vbInformation

End Sub

Private Sub Command11_Click()
PlaySound "C:\WINDOWS\MEDIA\TADA.WAV", ByVal 0&, SND_FILENAME Or SND_ASYNC

End Sub

Private Sub Command12_Click()
NvNom$ = InputBox("Nouveau nom du Pc ?", "SetComputerName...")
SetComputerName (NvNom$)
MsgBox "Au prochain redémarrage le nom de l'ordinateur sera : " & NvNom$
End Sub

Private Sub Command13_Click()
'recupére la position du pointeur avec api GetCursorPos
Dim Point As POINTAPI
GetCursorPos Point
'Repositionne le pointeur de la souris
SetCursorPos Point.x + 300, Point.y + 300
End Sub

Private Sub Command14_Click()
NvNom$ = InputBox("Nouveau nom pour le lecteur c: ?", "SetVolumeLabel")
SetVolumeLabel "c:\", NvNom$
End Sub

'Api Beep
Private Sub Command2_Click()
   Dim Cnt As Long
    For Cnt = 0 To 500 Step 10
        '0 a 500Hrz pendant 50ms
        Beep Cnt, 50
        DoEvents
    Next Cnt
End Sub

Private Sub Command3_Click()
MsgBox "L'api sleep va faire attendre le code pendant 5sec", vbInformation
Sleep 5000
MsgBox "Voila 5 secondes se sont écoulées...", vbExclamation
End Sub

Private Sub Command4_Click()
     
    DoEvents
    'bloque le clavier et la souris
    BlockInput True
    
    'Attent 10 sec
    Sleep 10000
  
    'débloque le clavier et la souris
    BlockInput False
     
End Sub

Private Sub Command5_Click()
    Dim i As Integer, s2 As String
   Const sFile = "C:\Windows\system.ini"

   'Verification de l'existance du fichier
   If Dir(sFile) = "" Or sFile = "" Then
        MsgBox "fichier non trouvé", vbCritical
        Exit Sub
   End If
   'Creer un  buffer
   s2 = String(MAX_FILENAME_LEN, 32)
   'recherche le nom et le handle del' executable, associé avec ce fichier
   i = FindExecutable(sFile, vbNullString, s2)
   If i > 32 Then
      MsgBox Left$(s2, InStr(s2, Chr$(0)) - 1)
   Else
      MsgBox "Pas de programme associé!!!"
   End If
End Sub

Private Sub Command6_Click()
 Dim dwLen As Long
    Dim strString As String
    'Creer un  buffer
    dwLen = MAX_COMPUTERNAME_LENGTH + 1
    strString = String(dwLen, "X")
    'prend le nom
    GetUserName strString, dwLen
    'Affiche le nom utilisateur
    MsgBox strString

End Sub

Private Sub Command7_Click()
Dim Point As POINTAPI
GetCursorPos Point
MsgBox "Le curseur se trouve :" & Point.x & "," & Point.y

End Sub

Private Sub Command8_Click()
Dim r As Long, BytesFreeToCalller As Currency, TotalBytes As Currency
    Dim TotalFreeBytes As Currency, TotalBytesUsed As Currency
    'Le disque
    Const RootPathName = "C:\"
    Call GetDiskFreeSpaceEx(RootPathName, BytesFreeToCalller, TotalBytes, TotalFreeBytes)
    Me.Print
    Msg = "Espace Total: " & Format$(TotalBytes * 10000, "###,###,###,##0") & " bytes" & vbCrLf & _
    "Espace Libre :" & Format$(TotalFreeBytes * 10000, "###,###,###,##0") & " bytes" & vbCrLf & _
    "Espace Utilisable :" & Format$(BytesFreeToCalller * 10000, "###,###,###,##0") & " bytes" & vbCrLf & _
    "Espace Utilisé :" & Format$((TotalBytes - TotalFreeBytes) * 10000, "###,###,###,##0") & " bytes"
    'Affichage
    MsgBox Msg

End Sub

Private Sub Command9_Click()
Dim Mn As Long
Mn = GetTickCount / 60000
MsgBox "Windows est démarrer depuis " & Mn & " minutes."

End Sub

Private Sub Form_Load()

End Sub

Private Sub Timer1_Timer()
Static Sec As Integer
Sec = Sec + 1
If Sec = 10 Then Timer1.Enabled = False: Me.WindowState = 0: Me.Caption = "Quelques Api..."
     FlashWindow Me.hwnd, Invert
End Sub

Conclusion :


Tous est dans le Zip!!!!!

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
34
Date d'inscription
lundi 9 mai 2011
Statut
Membre
Dernière intervention
21 mai 2012

je veux savoir s'il y a une API permettant la modification des paramétres régional
Messages postés
2
Date d'inscription
lundi 14 août 2006
Statut
Membre
Dernière intervention
7 septembre 2008

Mon commentaire n'est pas vraiment pour ce code , mais pour le site VBfrance , il y a de vrai petit trésor la dedans et de véritable petit génie j'ai été très impresionné félicitation
et que ce site dure encore bien longtemps c'est d'une aide incroyable encore félicitation a tout le monde .
Messages postés
169
Date d'inscription
samedi 10 décembre 2005
Statut
Membre
Dernière intervention
18 juin 2017

Bonjour et merci pour ton travail. C'est intéressant pour ceux qui comme moi veulent faire connaissance avec les API.
Ton Code fonctionne bien.
A plus.
Messages postés
15
Date d'inscription
mardi 11 avril 2006
Statut
Membre
Dernière intervention
8 mai 2006

J'ai besoin de certains api qui permettent de récuperer les informations systeme d'un ordinateur tel que marque et numéro de série d'un disque dur,d'une carte réseau et d'un modem
pouvez vous m'aidez?
Messages postés
77
Date d'inscription
samedi 9 novembre 2002
Statut
Membre
Dernière intervention
6 juillet 2014

Pour lancer l'application, on utilise shell.

Public Declare Function FindExecutableA Lib "shell32.dll" (ByVal lpFile As String, ByVal lpdirectory As String, ByVal lpResult As String) As Long
Public Const MAX_FILENAME_LEN = 256

Sub LanceApplication(nomfic$)
' Lance une application à partir du nom de fichier passé en paramètre
' par exemple un fichier doc lance Word, un fichier htm lance Internet Explorer
Dim i%
Dim a
Dim = s2$, application$
s2$ = String(MAX_FILENAME_LEN, 32) & Chr$(0)
i% = FindExecutableA(nomfic$ & Chr$(0), vbNullString, s2)
If i% > 32 Then
application$ = Left$(s2$, InStr(s2$, Chr$(0)) - 1)
a = Shell(application$ & " " & Chr$(34) & nomfic$ & Chr$(34), 3)
End If
End Sub
Afficher les 31 commentaires

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.