| 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 | |
| |
zurück