Die Community zu .NET und Classic VB.
Menü

Tipp-Upload: VB 5/6 0099: Notebook an Dockingstation?

 von 

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

  • Sonstiges
  • System

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
Notebook, Dockingstation, IsDocked, GetCurrentHWProfile, HW_PROFILE_INFO, DOCK_INFO,

Der Vorschlag wurde erstellt am: 11.09.2007 23:43.
Die letzte Aktualisierung erfolgte am 23.02.2008 16:47.

Zurück zur Übersicht

Beschreibung  

Wenn es in einem Programm erforderlich ist, zu wissen, ob ein Computer an eine Dockingstation angedockt ist, hilft die API-Funktion GetCurrentHWProfile. Den Schalter [Abdocken] findet man links neben [Abmelden] und [Ausschalten]. Wird er angeklickt, kann man das Notebook gefahrlos abdocken und weiterarbeiten. Damit dies ordnungsgemäß funktioniert, braucht man einen ACPI-fähigen Rechner.

Siehe dazu auch:

In der Registry:
"HKEY_LOCAL_MACHINE\System\CurrentControlSet\Control\IDConfigDB\Hardware Profiles"

In der MSDN:
* zur Funktion GetCurrentHwProfile: http://msdn2.microsoft.com/en-us/library/ms724311.aspx
* zur Struktur HW_PROFILE_INFO: http://msdn2.microsoft.com/en-us/library/ms724479.aspx

Schwierigkeitsgrad

Schwierigkeitsgrad 1

Verwendete API-Aufrufe:

GetCurrentHwProfileA (GetCurrentHwProfile), GetCurrentHwProfileW (GetCurrentHwProfile)

Download:

Download des Beispielprojektes [3,31 KB] 

' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.

' Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
' Ansonsten viel Spaß und Erfolg mit diesem Source!

' ------------- Anfang Projektdatei Projekt1.vbp -------------

' --------- Anfang Formular "Form1" alias Form1.frm  ---------

' Steuerelement: Textfeld "Text1"

Option Explicit

' #Const DefUnicode = 1 'siehe Projekteigenschaften -> Erstellen

Private Sub Form_Load()

    Dim m As String
    m = m & "Der Computer ist " & IIf(IsComputerDocked, vbNullString, "nicht ") & "angedockt."
    MsgBox m

    Dim hwpi As New HardwareProfileInfo

    Text1.Text = hwpi.ToString

End Sub

Private Function IsComputerDocked() As Boolean

    Dim hwpi As THWProfileInfo
    Dim s As String
    Dim rv As Long
    rv = GetCurrentHwProfile(hwpi)
    MsgBox CStr(rv)

    With hwpi
        MsgBox CStr(.dwDockInfo)

        #If DefUnicode Then
            s = .szHwProfileGuid
        #Else
            s = StrConv(.szHwProfileGuid, vbUnicode)
        #End If

        MsgBox s

        #If DefUnicode Then
            s = .szHwProfileName
        #Else
            s = StrConv(.szHwProfileName, vbUnicode)
        #End If

        MsgBox s

        If .dwDockInfo And DOCKINFO_UNDOCKED Then
            IsComputerDocked = False
        Else

            If .dwDockInfo And DOCKINFO_DOCKED Then
                IsComputerDocked = True
            Else

                '
            End If
        End If

    End With

End Function

' ---------- Ende Formular "Form1" alias Form1.frm  ----------

' --- Anfang Klasse "HardwareProfileInfo" alias HardwareProfileInfo.cls  ---

Option Explicit

' #Const DefUnicode = 1 'siehe Projekteigenschaften -> Erstellen
Private mHWProfileInfo As THWProfileInfo
Private mRetVal As Long
Private mStrConv As VbStrConv

Private Sub Class_Initialize()

    #If DefUnicode Then
        mStrConv = 0
    #Else
        mStrConv = vbUnicode
    #End If
    mRetVal = GetCurrentHwProfile(mHWProfileInfo)

End Sub

Public Property Get IsDocked() As Boolean

    IsDocked = Not ((mHWProfileInfo.dwDockInfo And DOCKINFO_UNDOCKED) = DOCKINFO_UNDOCKED)

End Property

Public Property Get HWProfileGUID() As String

    HWProfileGUID = ByteArrToString(mHWProfileInfo.szHwProfileGuid)

End Property

Public Property Get HWProfileName() As String

    HWProfileName = ByteArrToString(mHWProfileInfo.szHwProfileName)

End Property

Private Function ByteArrToString(aStrVal() As Byte) As String

    Dim npos As Long

    ByteArrToString = StrConv(aStrVal, mStrConv)
    npos = InStr(1, ByteArrToString, vbNullChar)
    npos = IIf(npos > 1, npos - 1, Len(ByteArrToString))
    ByteArrToString = Left$(ByteArrToString, npos)

End Function

Public Function ToString() As String

    Dim s As String
    s = s & "Der Computer ist " & IIf(IsDocked, vbNullString, "nicht ") & "angedockt." & vbCrLf
    s = s & "HWProfileGUID: " & HWProfileGUID & vbCrLf
    s = s & "HWProfileName: " & HWProfileName & vbCrLf
    ToString = s

End Function

' --- Ende Klasse "HardwareProfileInfo" alias HardwareProfileInfo.cls  ---

' ------- Anfang Modul "ModSystem" alias ModSystem.bas -------

Option Explicit

' #Const DefUnicode = 1 'siehe Projekteigenschaften -> Erstellen
' Der Computer ist Abgedockt
' Dieses Flag ist immer für Desktop-PC's gesetzt, da diese nicht angedockt
' werden können.
Public Const DOCKINFO_UNDOCKED As Long = (&H1)

' Der Computer ist Angedockt
Public Const DOCKINFO_DOCKED As Long = (&H2)

' If this flag is set, GetCurrentHwProfile retrieved the current docking state
' from information provided by the user in the Hardware Profiles page of the
' System control panel application.
' If there is no such value or the value is set to 0, this flag is set
Public Const DOCKINFO_USER_SUPPLIED As Long = (&H4)

' The computer is docked, according to information provided by the user.
Public Const DOCKINFO_USER_DOCKED As Long = (DOCKINFO_USER_SUPPLIED Or DOCKINFO_DOCKED)

' The computer is undocked, according to information provided by the user.
Public Const DOCKINFO_USER_UNDOCKED As Long = (DOCKINFO_USER_SUPPLIED Or DOCKINFO_UNDOCKED)

#If DefUnicode Then
    Const HW_PROFILE_GUIDLEN As Long = 78
    Const MAX_PROFILE_LEN As Long = 160
#Else
    Const HW_PROFILE_GUIDLEN As Long = 39 ' = 38Chars + 1NullChar
    Const MAX_PROFILE_LEN As Long = 80
#End If

Type THWProfileInfo
    dwDockInfo As Long
    szHwProfileGuid(1 To HW_PROFILE_GUIDLEN) As Byte
    szHwProfileName(1 To MAX_PROFILE_LEN) As Byte
End Type

#If DefUnicode Then

    Declare Function GetCurrentHwProfile Lib "advapi32.dll" _
                 Alias "GetCurrentHwProfileW" ( _
                 ByRef lpHwProfileInfo As THWProfileInfo) As Long

#Else

    Declare Function GetCurrentHwProfile Lib "advapi32.dll" _
                 Alias "GetCurrentHwProfileA" ( _
                 ByRef lpHwProfileInfo As THWProfileInfo) As Long

#End If

' -------- Ende Modul "ModSystem" alias ModSystem.bas --------

' -------------- Ende Projektdatei Projekt1.vbp --------------

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.