Но вот вопрос - процесс запускается либо с приоритетом "Нормальный" (NORMAL_PRIORITY_CLASS = &H20), либо "низкий" (IDLE_PRIORITY_CLASS = &H40). Но в диспетчере задач Windows есть еще "ниже среднего". Как его обеспечить?
Хочу сделать приоритет "ниже среднего" (чтоб неповадно было!)
Вот код программы, может кому интересно будет:
- Код: Выделить всё
Public Enum PriorityEnum
NORMAL_PRIORITY_CLASS = &H20
IDLE_PRIORITY_CLASS = &H40
HIGH_PRIORITY_CLASS = &H80
End Enum
Private Declare Function CreateProcessA Lib "kernel32" (ByVal lpApplicationName As Long, ByVal lpCommandLine _
As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, _
ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As _
STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const INFINITE = -1&
Private Const STARTF_USESHOWWINDOW = &H1
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
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 Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessID As Long
dwThreadID As Long
End Type
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
Option Explicit
'-----------------------------DIR-------------------------------------
Private Sub I7zip_Click() 'подпрограмма обработки нажатия кнопки dir
Dim Tmp As String, I As Integer, Kstr As String, DirArray() As String, Elaps As Date, Exist As Boolean
Elaps = Time 'Для вычисления времени работы
Kstr = App.Path 'Запись текущего пути
If Right$(Kstr, 1) <> "\" Then Kstr = Kstr & "\" 'Переход на уровень вниз
Tmp = Dir(Kstr, vbDirectory) 'Первый вызов функции Dir
Do Until Len(Tmp) = 0 'Выполнять, пока не получим пустой директорий
ReDim Preserve DirArray(I) 'Расширение массива
DirArray(I) = Tmp 'Запись очередного элемента
Okno1.Text = Okno1.Text & DirArray(I) + Chr(13) + Chr(10)
I = I + 1 'Следующий элемент
Tmp = Dir() 'Вызов Dir внутри цикла
Loop '
Okno1.Text = Okno1.Text & String(78, "-") + Chr(13) + Chr(10)
For I = LBound(DirArray) To UBound(DirArray) 'Цикл до окончания файла - шаблона
Kstr = DirArray(I) 'загрузить строку из файла - листинга
Exist = InStr(Kstr, ".") 'обрабатывать только каталоги
If Exist = 0 Then Okno1.Text = Okno1.Text + "C:\Progra~1\7-Zip\7zg.exe A " & Kstr + " " + Kstr + "\" + Chr(13) + Chr(10)
If Exist = 0 Then SystemExecute "C:\Progra~1\7-Zip\7zg.exe A " + Kstr + " " + Kstr + "\"
Next 'цикл создания bat - файла архивации
ElapsTime.Caption = "Время работы: " & Format(Time - Elaps, "hh:mm:ss") 'Вывод времени работы
MsgBox "Все ваши чертовы задания готовы" 'добавить оператор паузы в bat - файл
End Sub 'конец подпрограммы обработки нажатия кнопки dir
'---------------------------выход---------------------------------------
Private Sub CommEXIT_Click() 'обработчик кнопки Выход
End 'выход из программы
End Sub '
'---------------------------Таймер---------------------------------------
Private Sub Timer1_Timer() 'Обработчик часов
LabelTime.Caption = Format(Now, "hh:mm:ss, dddd, d mmmm") 'Отображение даты и времени
End Sub '
Private Sub Descript_Click()
MsgBox "Программа архивирует все папки (в своем директории) в архивы с теми же названиями. Выводится общее время работы. Последовательно запускается графический 7-zip, для архивации каждой папки."
End Sub
'А это и есть тот чудесный код, который сделал из моего говна настоящую программу
'Show: SW_HIDE = 0, SW_NORMAL = 1, SW_MAXIMIZE = 3, SW_MINIMIZE = 6
Public Function SystemExecute(ByRef CmdLine As String, Optional Show = 1) As Long
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim Res As Long
' Initialize the STARTUPINFO structure:
start.cb = Len(start)
start.dwFlags = STARTF_USESHOWWINDOW
start.wShowWindow = Show
' Start the shelled application:
Res = CreateProcessA(0&, CmdLine$, 0&, 0&, 1&, IDLE_PRIORITY_CLASS, 0&, 0&, start, proc)
' Wait for the shelled application to finish:
Res = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, Res)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
SystemExecute = Res
End Function
Готов впитать всю критику. Это моя первая программа на VB. Вообще - то я уже засомневался - а можно ли здесь приводить полный текст?
используется какой-то недоперевод