Informations diverses sur windows par api

Télécharger le projet
Commenter

Description

Ce programme vous permet de récupérer de nombreuses infos sur Windows, telles que la durée du double-clic, le nom d'utilisateur, des infos sur les lecteurs, la totale!

Tout est dans le zip!

Source / Exemple : 


Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetDoubleClickTime Lib "user32" () As Long
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function SetComputerName Lib "kernel32" Alias "SetComputerNameA" (ByVal lpComputerName As String) As Long
Private Declare Function SetDoubleClickTime Lib "user32" (ByVal wCount As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Declare Function RemoveDirectory Lib "kernel32" Alias "RemoveDirectoryA" (ByVal lpPathName As String) As Long
Private Type POINTAPI
        x As Long
        y As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128      '  Maintenance string for PSS usage
End Type

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Private Sub cmdchngdblclktm_Click()
Dim a As String
a = InputBox("Nouvelle durée du double-clic" & vbCrLf & "(en ms)", "Changement de durée du double-clic")
Dim num As Long
num = Val(a)
Debug.Print num
If num > 0 Then
fnt = SetDoubleClickTime(num)
Label2 = "Durée du double-clic" & " " & num & "ms"
End If

End Sub

Private Sub Command1_Click()
nom$ = InputBox("Entrez le nouveau nom de votre ordinateur", "Changement de nom...")
If Len(nom$) <> 0 Then
e = SetComputerName(nom$)
rep$ = MsgBox("La modification aura lieu au prochain redémarrage" & vbCrLf & "Redémarrer maintenant?", vbInformation + vbYesNo, "Le changement de nom a réussi.")
If rep$ = vbYes Then
a = ExitWindowsEx(2, 0)
End
End If

Label1 = "Nom de votre ordinateur: " & nom$
End If
End Sub

Private Sub Command2_Click()

Dim logi As String * 255
Dim nblect As Integer
r = GetLogicalDriveStrings(255, logi)

nblect = Int(r / 4)

Dim lect(1 To 255) As String
b = 0
For a = 1 To r Step 4
b = b + 1
lect(b) = Mid(logi, a, 3)

Next

Dim info(1 To 255) As String

Dim drv(1 To 255) As Integer

For a = 1 To nblect
drv(a) = GetDriveType(lect(a))

Select Case (drv(a))
Case 2
info(a) = "Disque amovible"
Case 3
info(a) = "Disque dur fixe"
Case 4
info(a) = "Disque distant (réseau)"
Case 5
info(a) = "Disque CD-ROM"
Case Else
info(a) = "Inconnu"
End Select

inf$ = inf$ + "Lecteur " & "'" & lect(a) & "'" & " : " & info(a) & vbCrLf

Next

m$ = "            " & nblect & "  lecteurs :" & vbCrLf & vbCrLf
m$ = m$ + inf$

MsgBox m$, vbInformation + vbOKOnly, "Plus d'informations sur les lecteurs"

End Sub

Private Sub Command3_Click()
Dim lon As Long
lon = 255
Dim chem As String * 255
a& = GetTempPath(lon, chem)
chemi = Left$(chem, a&)

RemoveDirectory "c:\temp\"
Kill ("c:\temp\*.*")

End Sub

Private Sub Form_Load()
Dim lo As Long
lo = 255
Dim stri As String * 255
a = GetComputerName(stri, lo)
Label1 = Label1 + " " + "'" + Left(stri, lo) + "'"

a = GetDoubleClickTime()
Label2 = Label2 & " " & a & "ms"

Dim chemin As String * 255
k = GetTempPath(255, chemin)
Label3 = Label3 + chemin

Dim us As Long
us = 255
Dim user As String * 255
a = GetUserName(user, us)
utilisateur = Left(user, us - 1)

Label4 = Label4 + " '" + utilisateur + "'"
 
Dim logi As String * 255
r = GetLogicalDriveStrings(255, logi)
logi = Trim(logi)

For a = 1 To Len(logi)
If Asc(Mid(logi, a, 1)) = 0 Then Mid(logi, a, 1) = "   "
Next

Label6 = Label6 + " " + logi
Debug.Print "'" + logi + "'"

Largeur% = Screen.Width \ Screen.TwipsPerPixelX
Hauteur% = Screen.Height \ Screen.TwipsPerPixelY
Label7 = "Résolution de l'écran : " & Largeur% & " x" & Hauteur%

Dim os As OSVERSIONINFO

os.dwOSVersionInfoSize = Len(os)  ' set the size of the structure
retval = GetVersionEx(os)  ' read Windows's version information

Label9 = "Vous êtes sous Windows version " & os.dwMajorVersion & "." & os.dwMinorVersion

End Sub

Private Sub Timer1_Timer()
temps = Int(GetTickCount() / 1000)
h = Int(temps / 3600)
mn = Int((temps - 3600 * h) / 60)
s = temps - 3600 * h - 60 * mn

Label5 = "Windows est lancé depuis:" & h & " h " & mn & " mn " & s & " s"

End Sub

Private Sub Timer2_Timer()
Dim curs As POINTAPI
a& = GetCursorPos(curs)
'Stop

Label8 = "Position de la souris: " & "(" & curs.x & ";" & curs.y & ")"

End Sub

Conclusion :


Voyez plutôt le zip.
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 (cs_Nico)