vb-Zentrum
Systemfunktionen
http://www.vb-zentrum.de/tip_system.html

© 2011 vb-Zentrum

0004 Hat die eigene Anwendung den Fokus? - WM_ACTIVATEAPP

 

 

Mit den Prozeduren Form_GotFocus und Form_LostFocus können wir ermitteln, ob die aktuelle Form gerade aktiv ist (den Fokus hat), oder nicht. Manchmal wäre es jedoch besser zu wissen, ob die gesamte Anwendung den Fokus hat, oder nicht. So lassen sich z.B. aufwendigere Hintergrundarbeiten erledigen, wenn der Benutzer gerade mit einer anderen Anwendung arbeitet.
Hierfür stellt uns das Windows API die Konstante WM_ACTIVATEAPP zur Verfügung, die wir über das Subclassing unserer Hauptform als Message erhalten. Wir benötigen also den folgenden Code in einem neuen Modul (z.B.: appFocus.bas):

Option Explicit

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
        (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, _
        ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_WNDPROC = -4
Private Const WM_ACTIVATEAPP = &H1C

' Locale Variablen:
Private mainOldProc As Long       ' Pointer auf original Fensterprozedur

Global glbAppActive As Boolean    ' globale Überwachungsvariable

' Subclassing initialisieren:
Public Sub MainHook(ByVal hWnd As Long)
  glbAppActive = True ' Wenn wir starten, sind wir die aktive Anwendung
  mainOldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf winMain)
End Sub

' Subclassing beenden:
Public Sub MainUnHook(ByVal hWnd As Long)
  SetWindowLong hWnd, GWL_WNDPROC, mainOldProc
End Sub

' Unsere Erweiterung der Fensterprozedur:
Private Function winMain(ByVal hWnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&) As Long
  Select Case uMsg
    Case WM_ACTIVATEAPP
      If wParam Then  ' Anwendung wurde aktiviert
        glbAppActive = True
      Else            ' Anwendung wurde deaktiviert
        glbAppActive = False
      End If
  End Select
  winMain = CallWindowProc(mainOldProc, hWnd, uMsg, wParam, lParam)
End Function

In der Hauptform unserer Anwendung rufen wir dann in der Load Anweisung die Funktion MainHook auf und übergeben ihr das Handle der Form, also "Me.hWnd". In der QueryUnload Anweisung muss nun das Pendant MainUnHook (Me.hWnd) aufgerufen werden, sonst stürzt die Anwendung ab! Das war schon alles. - Die globale Variable glbAppActive kann dann z.B. über einen Timer abgefragt werden.
Bei der Initialisierung des Hooking muß die Variable glbAppActive zunächst 'manuell' auf True gesetzt werden: da wir beim Programmstart schon die aktive Anwendung sind, wird nämlich kein weiteres WM_ACTIVATEAPP Ereignis ausgelöst.

Verfügt Ihre Anwendung bereits über ein Hooking, so ist es noch einfacher:
legen Sie in Ihrem Modul die globale Variable glbAppActive und die Konstante WM_ACTIVATEAPP an und erweitern Sie in Ihrer Hooking Funktion (hier winMain) die Abfrage von uMsg wie oben im Quellcode zu sehen.

   0004_appfocus.zip

Autor: ralf schlegel
Stand: 06/2011

Nach oben

0003 UAC in Vista und Winows 7

 

Das leidige Thema des UAC (User Account Control, oder zu Deutsch: Benutzerkontensteuerung) beschäftigt uns VB-Programmierer immer wieder; haben wir doch plötzlich nicht mehr das Recht Dateien in unserem Applikationsverzeichnis zu ändern, wenn die Installation unter "..\Program Files\.." erfolgte - und das Registrieren von DLLs oder OCXs zur Laufzeit ist auch nicht mehr so leicht wie früher...
 
Ursache:

Versionen von Windows, die älter als Windows NT sind beziehungsweise nicht davon abstammen (also Windows 95, 98 und ME), waren Einzelbenutzersysteme, in denen der Benutzer die volle Systemkontrolle besaß.
Windowssysteme der NT-Reihe sind dagegen Mehrbenutzersysteme, in denen Benutzerrollen und Benutzerrechte verwaltet werden.
Diese Verwaltung hat Microsoft ab Windows Vista mit dem UAC nochmals verschärft, sodaß wir selbst als angemeldeter Administrator nicht mehr vollen Zugriff auf alle Verzeichnisse und Systemfunktionen haben.
 
Da die nachfolgende API-Funktion, "IsUserAnAdmin", nur auf NT-Systemen bekannt ist,
sollte sie mit dem Tipp "0001 NT-Betriebssystem?" verknüpft werden. Sie behebt zwar nicht das Problem, sagt uns aber mit welchen Rechten wir gerade unterwegs sind! Außerdem ist sie UAC kompatibel - d.h. gibt 'False' zurück, wenn unter Vista / Win7 ein Mitglied der Administratorengruppe angemeldet ist, dieses aber vom UAC auf Benutzerrechte zurückgestuft wurde!

Private Declare Function IsUserAnAdmin Lib "shell32.dll" () As Long

' Hat der Benutzer Administrator-Rechte?
Public Function isAdmin() As Boolean
  If isSystemNT Then  ' Siehe Tipp 0001
    isAdmin = CBool(IsUserAnAdmin())
  Else
    ' auf Einzelbenutzersystemen
    ' hat der User immer Adminrechte
    isAdmin = True
  End If
End Function

Lösungsansatz:
Vermeiden Sie das Anlagen und Schreiben von Dateien in Ihrem Anwendungsverzeichnis!
So wie Sie im Allgemeinen zu Beginn des Programms den Anwendungspfad ermitteln (glbAppPath = App.Path & "\") können Sie auch den ab Windows 2000 bereitgestellten Programmdatenpfad zur Laufzeit dynamisch auslesen und für Ihre Zwecke verwenden.
Benutzen Sie dazu die Funktion getSpecialFolder mit dem Parameter CSIDL_COMMON_APPDATA (&H23) in der Form:

glbDataPath = getSpecialFolder(CSIDL_COMMON_APPDATA)

  • ist die Variable glbDataPath leer, so handelt es sich um ein nicht NT-System und die Daten können nach wie vor problemlos im Anwendungsverzeichnis abgelegt werden - wir setzen also glbDataPath = glbAppPath.
  • anderenfalls erweitern Sie den zurückgegebenen Pfad um "\" & App.Title & "\" und legen ihn an, falls er nicht existiert. Hier darf auch bei aktivem UAC frei agiert werden!

Laden und speichern Sie zusätzliche Programmdaten, wie Konfigurationen und INI-Files im Verzeichnis glbDataPath. Egal unter welchem System Ihre Anwendung läuft: die Daten können nun problemlos geschrieben und verändert werden...

P.S.: Demo-Projekt folgt

Autor: ralf schlegel
Stand: 12/2009

Nach oben

0002 vbzMsgBox

 

Jeder nutzt sie - die VB-integrierte MsgBox Funktion! Sie erspart einem das Erstellen einer Form und ist einfach ideal für Benutzer-Informationen, oder interaktive Abfragen. Doch das Einfache hat auch wieder seinen Preis:
Viele Features dieser Box hat Microsoft den VB-Usern leider nicht zur Verfügung gestellt.

Mit dem hier zum Download bereit gestellten Beispiel können Sie die MsgBox endlich im vollen Umfang nutzen:

  • keine Blockade von Timern bei Aufruf der Box
  • Unterstützung der optionalen Hilfe Schaltfläche mit Kontext Nummer
  • optional frei definierbare Button-Beschriftung
  • optional automatisches Schließen nach Zeit
  • durchgängig verwendbar von Windows 98 bis Windows 7
  • 100% kompatibel zur VB-internen MsgBox!

Die Funktionen sind in einem einzigen Modul gekapselt und lassen sich so problemlos in Ihre Anwendungen implementieren, da Sie dort nur den Aufruf Ihrer bisherigen MsgBox durch vbzMsgBox ersetzen, bzw. erweitern müssen.
Der Quellcode ist ausführlichst dokumentiert und sollte somit auch wenig erfahrenen VB-lern keine Probleme bereiten...

   0002_vbzMsgBox.zip

Autor: ralf schlegel
Stand: 08/2009

Nach oben

0001 NT-Betriebssystem?

 

Damit Ihre Applikation auf den verschiedenen Windows-Plattformen lauffähig ist, ist es manchmal notwendig zwischen NT (NT/2000/XP) und Nicht-NT (Win9x/ME) Systemen zu unterscheiden, da zum Beispiel einige API-Aufrufe nur auf NT-Plattformen zur Verfügung stehen. Wenn auch die benutzte "GetVersionEx"-Funktion die genaue Betriebssystem-Version ermitteln kann, wollen wir uns in diesem Fall auf die Prüfung von NT-Basis beschränken:

' Deklaration:
Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
                 (lpVersionInformation As OSVERSIONINFO) As Long

' Typendefinition:
Private Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32_NT = 2


' Funktion:
' Prüft auf NT-Betriebssysteme: True bei NT/2000/XP, sonst False
Public Function isSystemNT() As Boolean
  Dim info As OSVERSIONINFO

  info.dwOSVersionInfoSize = Len(info)
  GetVersionEx info
  isSystemNT = (info.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function

Autor: ralf schlegel
Stand: 10/2004

Nach oben