Как запустить программу через CreateProcess со стилем по умолчанию?

Dragokas · Регистрация: 25.12.2011

Студворк — интернет-сервис помощи студентам

Добрый вечер !

Подскажите, пожалуйста,
данный код запускает калькулятор Windows.

Внешний его вид выглядит как-то ущербно.
Какие нужно задать атрибуты при запуске, чтобы он выглядел как другие стандартные приложения windows 7.

Еще вопрос: lastDllError возвращает ERROR_NO_MORE_FILES (18).
Это нормальный код возврата для CreateProcess ?
Т.е., как я понимаю, обычно происходит поиск файла по путям PATH,
и если находит, то выдается такая ошибка?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Option Explicit
 
Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type
 
Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type
 
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, lpProcessAttributes As Any, lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, lpEnvironment As Any, ByVal lpCurrentDriectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Sub GetStartupInfo Lib "kernel32" Alias "GetStartupInfoA" (lpStartupInfo As STARTUPINFO)
 
 
Private Const SW_SHOWNORMAL             As Long = 1
 
Private si    As STARTUPINFO
Private pi    As PROCESS_INFORMATION
 
 
Private Sub Form_Load()
    Dim lr           As Long
    lr = ProcessRun("c:\windows\system32\calc.exe")     'calc.exe
End Sub
 
 
Public Function ProcessRun(Filename As String, Optional CommandLine As String, Optional WindowStyle As Long = SW_SHOWNORMAL)
    ' По-умолчанию стиль окна - SW_SHOWNORMAL
    
    Const STARTF_USESHOWWINDOW      As Long = 1
    Const NORMAL_PRIORITY_CLASS     As Long = &H20
    
    Dim n           As Long
    Dim lr          As Long
    Dim CmdLine     As String
    Dim argc        As Long
    Dim argv()      As String
    
    CmdLine = """" & Filename & """"                    ' Имя файла в кавычки
    
    If CommandLine <> "" Then                           ' Если есть аргументы, их тоже добавляем в кавычках
    
        'Parse_CMD CommandLine, argc, argv               ' Вместо CommandLineToArgvW
        For n = 1 To argc
            CmdLine = CmdLine & " """ & argv(n) & """"
        Next
    End If
    
    si.cb = Len(si)
    GetStartupInfo si                                   ' клонируем структуру текущего процесса
    si.dwFlags = STARTF_USESHOWWINDOW
    si.wShowWindow = WindowStyle                        ' Стиль окна
    
    lr = CreateProcess(vbNullString, _
                       CmdLine, _
                       ByVal 0, _
                       ByVal 0, _
                       False, _
                       NORMAL_PRIORITY_CLASS, _
                       ByVal 0, _
                       vbNullString, _
                       si, _
                       pi)
                       
    
    Debug.Print Err.LastDllError    ' not 0 is SUCCESS
    Stop
    
    ProcessRun = lr
End Function

@The trick · 17.07.2014, 00:40

Сообщение от Dragokas

Это нормальный код возврата для CreateProcess ?

Код возврата CreateProcess это Lr, если он не 0, значит функция выполнена успешно и GetLastError неопределено.
В данном случае все успешно, а GetLastError возвращает ERROR_NO_MORE_FILES (в моей Win7x64), т.к. внутри идет вызов FindFirstFile/FindNextFile/FindClose в цикле, и она возвращает при достижении конца списка файлов в директории ERROR_NO_MORE_FILES.
Насчет стилей, не могу сказать, у меня все отображается нормально. Попробуй скомпилировать и запустить EXE - такая же байда? Могу предположить что у тебя в свойствах vb6.exe отключено визуальное оформление. Если это так, то можно изменить либо блок окружения вызываемого процесса (lpEnvironment), либо свой на время вызова CreateProcess:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Public Function ProcessRun(Filename As String, Optional CommandLine As String, Optional WindowStyle As Long = SW_SHOWNORMAL)
    ' По-умолчанию стиль окна - SW_SHOWNORMAL
    
    Const STARTF_USESHOWWINDOW      As Long = 1
    Const NORMAL_PRIORITY_CLASS     As Long = &H20
    
    Dim n           As Long
    Dim lr          As Long
    Dim CmdLine     As String
    Dim argc        As Long
    Dim argv()      As String
    Dim cl          As String
    Dim cl_         As String
    
    CmdLine = """" & Filename & """"                    ' Имя файла в кавычки
    
    If CommandLine <> "" Then                           ' Если есть аргументы, их тоже добавляем в кавычках
    
        'Parse_CMD CommandLine, argc, argv               ' Вместо CommandLineToArgvW
        For n = 1 To argc
            CmdLine = CmdLine & " """ & argv(n) & """"
        Next
    End If
    
    si.cb = Len(si)
    GetStartupInfo si                                   ' клонируем структуру текущего процесса
    si.dwFlags = STARTF_USESHOWWINDOW
    si.wShowWindow = WindowStyle                        ' Стиль окна
    
    ' Получаем режим совместимости
    cl = Space(32767)
    GetEnvironmentVariable StrPtr("__COMPAT_LAYER"), StrPtr(cl), 32767
    cl = Left$(cl, InStr(1, cl, vbNullChar) - 1)
    ' Создаем переменную окружения для нового процесса, тут можно включить также запуск от имени администратора
    cl_ = Replace(cl, "DisableThemes", vbNullString)
    SetEnvironmentVariable StrPtr("__COMPAT_LAYER"), StrPtr(cl_)
    
    lr = CreateProcess(vbNullString, _
                       CmdLine, _
                       ByVal 0, _
                       ByVal 0, _
                       False, _
                       NORMAL_PRIORITY_CLASS, _
                       ByVal 0, _
                       vbNullString, _
                       si, _
                       pi)
                       
    ' Возвращаем на место
    SetEnvironmentVariable StrPtr("__COMPAT_LAYER"), StrPtr(cl)
    
    Debug.Print Err.LastDllError    ' not 0 is SUCCESS
    Stop
    
    ProcessRun = lr
End Function

Dragokas · 17.07.2014, 01:59 **[ТС]**

Сообщение от The trick

Код возврата CreateProcess это Lr, если он не 0, значит функция выполнена успешно и GetLastError неопределено.

Да, Sorry, неверно выразился.

Сообщение от The trick

FindFirstFile/FindNextFile/FindClose в цикле, и она возвращает при достижении конца списка файлов в директории ERROR_NO_MORE_FILES.

Понятно. Спасибо. В описании функции о том же идет речь.

Сообщение от The trick

Могу предположить что у тебя в свойствах vb6.exe отключено визуальное оформление.

Так и есть. Отключено.

Сообщение от The trick

GetEnvironmentVariable StrPtr("__COMPAT_LAYER"), StrPtr(cl), 32767

На счет переменных окружения - не знал, что это в них хранится.
Спасибо. Это будет очень ценная информация для моей статьи.

Новые блоги и статьи Все статьи Все блоги /
http://iceja.net/ математические сервисы iceja 20.01.2026 Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .	http://iceja.net/ сервер решения полиномов iceja 18.01.2026 Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .	Расчёт переходных процессов в цепи постоянного тока igorrr37 16.01.2026 / * Дана цепь постоянного тока с R, L, C, k(ключ), U, E, J. Программа составляет систему уравнений по 1 и 2 законам Кирхгофа, решает её и находит переходные токи и напряжения на элементах схемы. . . .	Восстановить юзерскрипты Greasemonkey из бэкапа браузера damix 15.01.2026 Если восстановить из бэкапа профиль Firefox после переустановки винды, то список юзерскриптов в Greasemonkey будет пустым. Но восстановить их можно так. Для этого понадобится консольная утилита. . .
Сукцессия микоризы: основная теория в виде двух уравнений. anaschu 11.01.2026 https:/ / rutube. ru/ video/ 7a537f578d808e67a3c6fd818a44a5c4/	WordPad для Windows 11 Jel 10.01.2026 WordPad для Windows 11 — это приложение, которое восстанавливает классический текстовый редактор WordPad в операционной системе Windows 11. После того как Microsoft исключила WordPad из. . .	Classic Notepad for Windows 11 Jel 10.01.2026 Old Classic Notepad for Windows 11 Приложение для Windows 11, позволяющее пользователям вернуть классическую версию текстового редактора «Блокнот» из Windows 10. Программа предоставляет более. . .	Почему дизайн решает? Neotwalker 09.01.2026 В современном мире, где конкуренция за внимание потребителя достигла пика, дизайн становится мощным инструментом для успеха бренда. Это не просто красивый внешний вид продукта или сайта — это. . .

Как запустить программу через CreateProcess со стилем по умолчанию?

Решение