Tipp 0208 Windows-Ausführen-Dialog anzeigen
Autor/Einsender:
Datum:
  Detlev Schubert
16.03.2002
Entwicklungsumgebung:   VB 5
Das Ausführen fremder Programme aus der eigenen Anwendung heraus, ist mit der Shell-Funktion möglich. Dass es auch komfortabler und unkomplizierter gehen kann, zeigt die undokumentierte API-Funktion SHRunDialog. Mit ihr ist es möglich, den Ausführen-Dialog des Betriebssystems aufzurufen, und nicht nur einen eigenen Titel vorzugeben, sondern fast komplett mit einigen wenigen Handgriffen individuell zu konfigurieren.
Da die auf NT-basierenden Betriebssysteme intern nicht, wie VB, mit Unicodes arbeiten, muss hier eine Umwandlung der VB-Strings erfolgen. In diesem Beispiel wurden alle dazu notwendigen Funktionen integriert.
Code im Codebereich des Moduls
 
Option Explicit

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

Type OSVERSIONINFO
  dwOSVersionInfoSize As Long
  dwMajorVersion As Long
  dwMinorVersion As Long
  dwBuildNumber As Long
  dwPlatformId As Long
  szCSDVersion As String * 128
End Type

Const VER_PLATFORM_WIN32s = 0
Const VER_PLATFORM_WIN32_WINDOWS = 1
Const VER_PLATFORM_WIN32_NT = 2

Public g_fIsWinNT As Boolean

Public Function IsWinNT() As Boolean
  Dim osvi As OSVERSIONINFO

  osvi.dwOSVersionInfoSize = Len(osvi)
  GetVersionEx osvi
  IsWinNT = (osvi.dwPlatformId = VER_PLATFORM_WIN32_NT)
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private Declare Function SHRunDialog Lib "shell32" Alias _
      "#61" (ByVal hWnd As Long, ByVal hIcon As Long, _
      ByVal sPath As String, ByVal sTitle As String, _
      ByVal sPrompt As String, ByVal uFlags As Long) As Long

Private Declare Function ExtractIcon Lib "shell32.dll" Alias _
      "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName _
      As String, ByVal nIconIndex As Long) As Long

Private Declare Function GetSystemDirectory Lib "kernel32" _
      Alias "GetSystemDirectoryA" (ByVal lpBuffer As _
      String, ByVal nSize As Long) As Long

Dim RetVal As Long
Dim SysDir As String
Dim hIcon As Long

Private Sub Form_Load()
  g_fIsWinNT = IsWinNT
End Sub

Private Sub Command1_Click()
  Dim uFlag As Long
  Dim sTitle As String, sPrompt As String, sLw As String

  If Option1(0).Value = True Then
    SHRunDialog hWnd, 0, 0, vbNullString, vbNullString, 0

  Else
    If Check1(0).Value = 1 Then uFlag = &H3 Else uFlag = &H2

    If Check1(1).Value = 1 Then
      SysDir = Space$(256)
      RetVal = GetSystemDirectory(SysDir, Len(SysDir))

      If RetVal <> 0 Then
        SysDir = Left$(SysDir, Len(Trim$(SysDir)) - 1) & _
              "\Shell32.dll"
        hIcon = ExtractIcon(App.hInstance, SysDir, 11)
      End If
    Else
      hIcon = 0
    End If

    sTitle = Text1.Text
    sPrompt = Text2.Text
    sLw = Text3.Text

    If g_fIsWinNT Then
      sTitle = StrConv(sTitle, vbUnicode)
      sPrompt = StrConv(sPrompt, vbUnicode)
      sLw = StrConv(sLw, vbUnicode)
    End If

    SHRunDialog hWnd, hIcon, sLw, sTitle, sPrompt, uFlag
  End If
End Sub
 
Weitere Links zum Thema
Windows-Beenden-Dialog anzeigen
Windows-Öffnen-mit-Dialog anzeigen
Windows-Restart-Dialog anzeigen
Windows-Suchen-Dialog anzeigen

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4 kB) Downloads bisher: [ 1651 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Mittwoch, 17. August 2011