Microsoft Office Access 2007-Programmierung - Das Handbuch

Informationen über das aktuelle System ermitteln

API-Programmierung; GetWindowsDirectory-, GetSystemDirectory-, GlobalMemoryStatus-, GetDeviceCaps-,

GetSystemInfo-Funktion;

Um etwas über das System zu erfahren, müssen wir schon die API bemühen. Unter den vielen abrufbaren

Informationen sind für uns im Wesentlichen die folgenden Angaben interessant:

■ Arbeitsspeicher und freier Arbeitsspeicher

■ Auslagerungsdatei

■ die Systemressourcen (GDI, USER)

■ das Windows-Verzeichnis und das System-Verzeichnis

■ die Prozessoranzahl

■ die Bildschirmauflösung

■ Datum und Uhrzeit

Oberfläche

Unser Formular bestücken wir mit einem Listenfeld für die Anzeige der Parameter sowie einer Befehlsschalt-

fläche zum Beenden des Programms.

API-Programmierung

Der Aufwand zur Ermittlung von Systeminformationen in einer 32-Bit-Systemumgebung ist etwas höher

als bisher gewohnt, dafür lassen sich aber auch mehr Informationen abrufen.

Binden Sie zunächst die folgenden Typen/Konstanten und API-Funktionen in das Projekt ein:

Type MEMORYSTATUS

dwLength As Long

dwMemoryLoad As Long

dwTotalPhys As Long

dwAvailPhys As Long

dwTotalPageFile As Long

dwAvailPageFile As Long

dwTotalVirtual As Long

dwAvailVirtual As Long

End Type

Global memory As MEMORYSTATUS

Declare Sub GlobalMemoryStatus Lib "kernel32" (lpBuffer As _ MEMORYSTATUS)

Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _

(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" _

(ByVal lpBuffer As String, ByVal nSize As Long) As Long

Type SYSTEM_INFO

dwOemID As Long

875

Praxisbeispiele

HINWEIS

Kapitel 13: Programmschnittstellen

dwPageSize As Long

lpMinimumApplicationAddress As Long

lpMaximumApplicationAddress As Long

dwActiveProcessorMask As Long

dwNumberOfProcessors As Long

dwProcessorType As Long

dwAllocationGranularity As Long

dwReserved As Long

End Type

Global systeminfo As SYSTEM_INFO

Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)

Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _

(ByVal lpDriverName As String, ByVal lpDeviceName As Any, _

ByVal lpOutput As Any, ByVal lpInitData As Any) As Long

Public Const SIZEPALETTE = 104

Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Die Funktions-Aufrufe

Dim Puffer As String * 255

Dim i As Integer, zw As String, dWords As Long

Dim dc As Long, ta As String

Dim BitPix As Long

ta = ";"""

Initialisieren Sie den Parameter dwLength mit der Größe der Struktur. Der Grund liegt in der späteren

Erweiterbarkeit (zusätzliche Systeminformationen).

memory.dwLength = Len(memory)

Speicherinformationen gewinnen:

GlobalMemoryStatus memory

additem "phys. Speicher " & ta & Format(memory.dwTotalPhys, _

"###,###,###,###,###,###") & " Byte"

additem "phys. Speicher frei" & ta & Format(memory.dwAvailPhys, _

"###,###,###,###,###,###") & " Byte"

additem "Auslagerungsspeicher" & ta & Format(memory.dwTotalPhys, _

"###,###,###,###,###,###") & " Byte"

additem "Auslagerungsspeicher frei" & ta _

& Format(memory.dwAvailPhys, "###,###,###,###,###,###") & " Byte"

Windowsverzeichnis bestimmen:

Puffer = Space$(255)

i = GetWindowsDirectory(Puffer, 255)

addItem "Windowsverzeichnis" & ta & Left(Puffer, i)

876

Systemverzeichnis bestimmen:

Puffer = Space$(255)

i = GetSystemDirectory(Puffer, 255)

addItem "Systemverzeichnis" & ta & Left$(Puffer, i)

Prozessoranzahl bestimmen:

GetSystemInfo systeminfo

addItem "Prozessoren" & ta & Str(systeminfo.dwNumberOfProcessors)

Die Farbauflösung und die Bildschirmauflösung erhalten wir über einen Gerätekontext:

dc = GetDC(0)

BitPix = GetDeviceCaps(dc, 12)

If BitPix > 24 Then BitPix = 24

additem "Farben" & ta & CStr(GetDeviceCaps(dc, 14) * 2 ^ BitPix)

ReleaseDC 0, dc

addItem "Bildschirmauflösung" & ta & CStr(GetDeviceCaps(dc, 8)) & "x" & CStr(GetDeviceCaps(dc, 10))

DeleteDC dc

Datum und Uhrzeit:

addItem "Datum" & ta & CStr(Date)

addItem "Uhrzeit" & ta & CStr(Time)

Eine Hilfsfunktion für die Anzeige:

Sub additem(s As String)

If list1.RowSource <> "" Then

list1.RowSource = list1.RowSource & ";""" & s & """"

Else

list1.RowSource = list1.RowSource & """" & s & """"

End If

End Sub

Test

Nach dem Start dürften bereits alle Informationen angezeigt werden:

Abbildung 13.33 Die abgefragten Systeminformationen

877

Praxisbeispiele