'Пример демонстрирует основные возможности применения функции ShellExecute

 

'Пример от Djoser

'Части кода и редакция: B.V.; Api-Guide

Option Explicit

 

Private Declare Function FormatMessage Lib "kernel32.dll" Alias "FormatMessageA" (ByVal dwFlags As Long, ByRef lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, ByRef Arguments As Long) As Long

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

 

Private Const SW_SHOWNORMAL As Long = 1

Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000

Private Const MAX_SIZE As Long = 255

 

Public Enum ShellOperations

    SO_Mail = 1

    SO_Explore = 2

    SO_FindIn = 3

    SO_Edit = 4

    SO_URL = 5

    SO_Run = 6

    SO_Print = 7

End Enum

 

Public Function iShell(ByVal hWnd As Long, ByRef Action As ShellOperations, ByVal ActString As String, Optional ByVal strCmdLine As String = vbNullString) As String

    'функция возвращает пустую строку, если все нормально

    'функция возвращает описание ошибки, если произошла ошибка

    

    'В lRetval должен быть возвращен Instance запущенного приложения

    'Если значение меньше или равно 32 - произошла ошибка

    'Chr$(92) = "\"

    Dim lRetval As Long

    Dim strAct As String

    Select Case Action

        Case ShellOperations.SO_Mail

            'отправка почты (написать письмо)

            lRetval = ShellExecute(hWnd, "open", "mailto:" & ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_Explore

            'открытие папки в проводнике

            ActString = StrChek(ActString, "\")

            lRetval = ShellExecute(hWnd, "explore", ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_FindIn

            'поиск файлов в указанной папке средствами Windows

            ActString = StrChek(ActString, "\")

            lRetval = ShellExecute(hWnd, "find", ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_Edit

            'открывает файл в соответствующем редакторе, например: *bmp -> Paint

            lRetval = ShellExecute(hWnd, "edit", ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_URL

            'переход на ссылку URL

            ActString = StrChek(ActString, "/")

            lRetval = ShellExecute(hWnd, "open", "http://" & ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_Run

            'открывает документ или запускает программу

            lRetval = ShellExecute(hWnd, "open", ActString, strCmdLine, vbNullString, SW_SHOWNORMAL)

        Case ShellOperations.SO_Print

            'печатает документ (НЕ ТЕСТИРОВАЛОСЬ)

            lRetval = ShellExecute(hWnd, "print", ActString, vbNullString, vbNullString, SW_SHOWNORMAL)

    End Select

    If lRetval <= 32 Then

        iShell = GetErrorString(lRetval)

    End If

End Function

 

Private Function StrChek(ByVal strMath As String, ByVal strRepl As String) As String

    StrChek = IIf(Right$(strMath, 1) <> strRepl, strMath & strRepl, strMath)

End Function

 

'Текст ошибки

Private Function GetErrorString(ByVal lErr As Long) As String

    Dim strBuffer As String, lRetval As Long

    strBuffer = Space$(MAX_SIZE)

    lRetval = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, ByVal 0, lErr, 0, strBuffer, MAX_SIZE, 0)

    strBuffer = Left$(strBuffer, lRetval)

    GetErrorString = strBuffer

End Function

 

Private Sub Form_Load()

    'Пример запуска Блокнота

    Call iShell(0, SO_Run, "notepad.exe")

End Sub