Работа с ShellExecute -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [18.220.140.5]

Модераторы: SCINER, B.V.

Ссылки по теме:

Отправка по ссылке

Работа с ShellExecute

G-Hex

Сообщ. #1 , 05.08.06, 14:16

Senior Member

Профиль · PM

Рейтинг (т): 30

1.Как открыть зарегистрированный тип файла в системе в нужной программе?
2.Как открыть адрес URL в браузере по умолчанию?
3.Как открыть окно почтовой программы для создания письма на определенный адрес? (можно отнести ко второму)
4.Как распечатать на принтере содержимое файла?
5.Как отобразить стандартное окно поиска файлов Windows?

Код:

'Пример демонстрирует основные возможности применения функции 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

Сообщение отредактировано: B.V. - 05.08.06, 14:40

0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0172 ] [ 16 queries used ] [ Generated: 28.04.24, 14:39 GMT ]