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.
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.