Festplatten-Nummer, Bildschirmauflösung, Windows-Laufzeit

...und Computername auslesen

Festplatten-Nummer, Bildschirmauflösung, Windows-Laufzeit und Computername auslesen:
GetVolumeInformationA, GetDeviceCaps, GetTickCount, StrFromTimeInterval, GetComputerName&, GetUserName
Prozedur im Modul
'Festplatten-Nummer auslesen
Declare Function GetVolumeInformationA Lib "kernel32" _
(ByVal lpRootPathName As String, _
ByVal lpVolumeNameBuffer As String, _
ByVal nVolumeNameSize As Long, _
lpVolumeSerialNumber As Long, _
lpMaximumComponentLength As Long, _
lpFileSystemFlags As Long, _
ByVal lpFileSystemNameBuffer As String, _
ByVal nFileSystemNameSize As Long) As Long
'Bildschirmauflösung auslesen
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, _
ByVal nIndex As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
Const HORZRES = 8
Const VERTRES = 10
'Windows-Laufzeit ermitteln
Declare Function GetTickCount Lib "kernel32" () As Long
'Millisekunden in Echzeit umwandeln
Declare Function StrFromTimeInterval Lib "shlwapi" Alias _
"StrFromTimeIntervalA" (ByVal pszout As String, _
ByVal cchMax As Long, ByVal dwTimeMS As Long, _
ByVal dwDigits As Long) As Long
'Computername auslesen
Declare Function GetComputerName& Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lbbuffer As String, nSize As Long)
'User-Name aus Registry auslesen
Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) As Long
'Festplatten-Nummer auslesen
Sub SerienNummer()
Dim SerialNumber As Long
GetVolumeInformationA "C:\", vbNullString, 0, SerialNumber, 0, 0, vbNullString, 0
frmTest.Label1.Caption = SerialNumber
End Sub
'Bildschirmauflösung auslesen
Function ScreenResolution()
Dim Rval As Long, Dc As Long
Dim HSize As Long, VSize As Long
Dc = GetDC(0&)
HSize = GetDeviceCaps(Dc, HORZRES)
VSize = GetDeviceCaps(Dc, VERTRES)
Rval = ReleaseDC(0, Dc)
ScreenResolution = HSize & "x" & VSize
frmTest.Label2.Caption = ScreenResolution
End Function
'Windows-Laufzeit ermitteln
Function WindowsTime()
WindowsTime = GetTickCount
frmTest.Label3.Caption = WindowsTime
End Function
'Millisekunden in Echzeit umwandeln
Sub Time_String()
Dim ms As Long, TimeStr As String
TimeStr = Space(64)
ms = WindowsTime
StrFromTimeInterval TimeStr, Len(TimeStr) - 1, ms, 5
frmTest.Label4.Caption = TimeStr
End Sub
'Computername auslesen
Function cptName()
Dim z As String * 64
Call GetComputerName(z, 64)
cptName = z
frmTest.Label5.Caption = cptName
End Function
'User-Name aus Registry auslesen
Sub ShowUserName()
Dim Buffer As String * 100, BuffLen As Long
BuffLen = 100
GetUserName Buffer, BuffLen
If Not Buffer <> "" Then
frmTest.Label6.Caption = Left(Buffer, BuffLen - 1)
Else
frmTest.Label6.Caption = "My name is rabbit"
End If
End Sub
Prozedur im Formular
'Festplatten-Nummer auslesen
Private Sub cmdNumber_Click()
SerienNummer
End Sub
'Bildschirmauflösung auslesen
Private Sub cmdScreen_Click()
ScreenResolution
End Sub
'Windows-Laufzeit ermitteln
Private Sub cmdTime_Click()
WindowsTime
End Sub
'Millisekunden in Echzeit umwandeln
Private Sub cmdEchtzeit_Click()
Time_String
End Sub
'Computername auslesen
Private Sub cmdCompName_Click()
cptName
End Sub
'User-Name aus Registry auslesen
Private Sub cmdUserName_Click()
ShowUserName
End Sub
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt