AHK: Изменение соответствия процессоров

Run, notepad,,, PID             ; здесь вместо "notepad" путь к исполнимому файлу приложения
Process, Wait, notepad.exe      ; здесь вместо "notepad.exe" реальное имя процесса

h_process := DllCall("OpenProcess", UInt, PROCESS_SET_INFORMATION := 0x200, Int, 0, UInt, PID)

DllCall("SetProcessAffinityMask", UInt, h_process, UInt, 1)  ; 1 — первый, 2 — второй, 3 — оба
DllCall("CloseHandle", UInt, h_process)

'**************************************
' Name: SetProcessAffinityMask API
' Description:This code allows you to set the process affinity on a running thread for multi processor computers. 
Get the process ID of a running thread by filename. Get the process handle by the PID. Set your custom Affinity Mask. Apply the affinity mask to the process thread.
' By: Justin Ploski
'
' Inputs:Process Name is the only variable input.
You'll need to customize the affinity mask - see comments by the MyMask assignment for information.
'
' Returns:The SetProcessAffinity API returns 0 if the affinity was set correctly. Anything <> 0 is an error.
'
' Assumes:This code is Windows API that allows you to specify a running process name and obtain the PID (Process ID). From the PID, it then obtains a handle on the process. You then set a custom affinity BitMask for the process, and pass the handle and affinity mask to the SetProcessAffinity function. Use GetCurrentProcess() API (always returns long -1) in place of the application handle to set the affinity on the current application.
See the comments when setting the MyMask variable to customize which processors will be used.
This is my first submission. I've been leeching off PlanetSourceCode for years, so I figured it's time to give something back. I've seen alot of questions but not many answers related to process affinity for multiprocessors. Please comment if you find this code useful.
'
' Side Effects:If using a single processor machine, the only valid process affinity is CPU0.
'
'This code is copyrighted and has' limited warranties.Please see http://www.Planet-Source-Code.com/vb/scripts/ShowCode.asp?txtCodeId=60478&lngWId=1'for details.'**************************************

Public Sub Main()
 Call SetAffinityByEXE("notepad.exe")
End Sub
Private Sub SetAffinityByEXE(strImageName As String)
 
 Const PROCESS_QUERY_INFORMATION = 1024
 Const PROCESS_VM_READ = 16
 Const MAX_PATH = 260
 Const STANDARD_RIGHTS_REQUIRED = &HF0000
 Const SYNCHRONIZE = &H100000
 Const PROCESS_ALL_ACCESS = &H1F0FFF
 Const TH32CS_SNAPPROCESS = &H2&
 Const hNull = 0
 Const WIN95_System_Found = 1
 Const WINNT_System_Found = 2
 Const Default_Log_Size = 10000000
 Const Default_Log_Days = 0
 Const SPECIFIC_RIGHTS_ALL = &HFFFF
 Const STANDARD_RIGHTS_ALL = &H1F0000
 
 Dim BitMasks() As Long, NumMasks As Long, LoopMasks As Long
 Dim MyMask As Long
 Const AffinityMask As Long = &HF ' 00001111b
 
 Dim lngPID As Long
 Dim lngHwndProcess
 lngPID = GetProcessID(strImageName)
 If lngPID = 0 Then
 MsgBox "Could not get process ID of " & strImageName, vbCritical, "Error"
 Exit Sub
 End If
 lngHwndProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, lngPID)
 If lngHwndProcess = 0 Then
 MsgBox "Could not obtain a handle for the Process ID: " & lngPID, vbCritical, "Error"
 Exit Sub
 End If
 BitMasks() = GetBitMasks(AffinityMask)
 
 'Use CPU0
 MyMask = BitMasks(0)
 
 'Use CPU1
 'MyMask = BitMasks(1)
 
 'Use CPU0 and CPU1
 'MyMask = BitMasks(0) Or BitMasks(1)
 
 
 'The CPUs to use are specified by the array index.
 'To use CPUs 0, 2, and 4, you would use:
 'MyMask = BitMasks(0) Or BitMasks(2) Or BitMasks(4)
 
 'To Set Affinity, pass the application handle and your custom affinity mask:
 'SetProcessAffinityMask(lngHwndProcess, MyMask)
 'Use GetCurrentProcess() API instead of lngHwndProcess to set affinity on the current app.
 If SetProcessAffinityMask(lngHwndProcess, MyMask) = 1 Then
 MsgBox "Affinity Set", vbInformation, "Success"
 Else
 MsgBox "Failed To Set Affinity", vbCritical, "Failure"
 End If
 
 
End Sub
Private Function GetBitMasks(ByVal inValue As Long) As Long()
 Dim RetArr() As Long, NumRet As Long
 Dim LoopBits As Long, BitMask As Long
 Const HighBit As Long = &H80000000
 ReDim RetArr(0 To 31) As Long
 For LoopBits = 0 To 30
 BitMask = 2 ^ LoopBits
 If (inValue And BitMask) Then
 RetArr(NumRet) = BitMask
 NumRet = NumRet + 1
 End If
 Next LoopBits
 If (inValue And HighBit) Then
 RetArr(NumRet) = HighBit
 NumRet = NumRet + 1
 End If
 If (NumRet > 0) Then ' Trim unused array items and return array
 If (NumRet < 32) Then ReDim Preserve RetArr(0 To NumRet - 1) As Long
 GetBitMasks = RetArr
 End If
End Function
Private Function GetProcessID(strProcessName As String) As Long
 Dim RetVal As Long
 Dim Count As Long
 Dim i As Integer
 Dim lpBuffer As Long
 Dim p As Long
 Dim udtProcessInfo As WTS_PROCESS_INFO
 
 Dim lngProcessID As Long
 Dim strTempProcessName As String
 RetVal = WTSEnumerateProcesses(WTS_CURRENT_SERVER_HANDLE, 0&, 1, lpBuffer, Count)
 If RetVal Then ' WTSEnumerateProcesses was successful
 p = lpBuffer
 For i = 1 To Count
 ' Count is the number of Structures in the buffer
 ' WTSEnumerateProcesses returns a pointer, so copy it to a
 ' WTS_PROCESS_INO UDT so you can access its members
 CopyMemory udtProcessInfo, ByVal p, LenB(udtProcessInfo)
 ' Add items to the ListView control
 
 lngProcessID = CLng(udtProcessInfo.ProcessID)
 
 ' Since pProcessName contains a pointer, call GetStringFromLP to get the
 ' variable length string it points to
 If udtProcessInfo.ProcessID = 0 Then
'MsgBox "System Idle Process"
 Else
strTempProcessName = GetStringFromLP(udtProcessInfo.pProcessName)
If UCase(strTempProcessName) = UCase(strProcessName) Then
GetProcessID = lngProcessID
End If
 End If
 
 p = p + LenB(udtProcessInfo)
 Next i
 WTSFreeMemory lpBuffer 'Free your memory buffer
 Else
 MsgBox "Error", vbCritical, "Fatal Error"
 End If
End Function
Private Function GetStringFromLP(ByVal StrPtr As Long) As String
 Dim b As Byte
 Dim tempStr As String
 Dim bufferStr As String
 Dim Done As Boolean
 Done = False
 Do
 ' Get the byte/character that StrPtr is pointing to.
 CopyMemory b, ByVal StrPtr, 1
 If b = 0 Then ' If you've found a null character, then you're done.
 Done = True
 Else
 tempStr = Chr$(b) ' Get the character for the byte's value
 bufferStr = bufferStr & tempStr 'Add it to the string
 
 StrPtr = StrPtr + 1 ' Increment the pointer to next byte/char
 End If
 Loop Until Done
 GetStringFromLP = bufferStr
End Function
 





Report Bad Submission 
Use this form to notify us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because: 

Your Vote! 

What do you think of this code(in the Intermediate category)?
(The code with your highest vote will win this month's coding contest!)
Excellent Good Average Below Average Poor See Voting Log 

Other User Comments 
5/12/2005 2:53:18 AM: Light Templer

Hardcore code! With upcomming of multiprocessor systems to the desktop there will be more people having the chance to check this out ;-)
My ***** for something really new in VB!
Regards - LiTe
(If this comment was disrespectful, please report it.) 



5/12/2005 12:25:14 PM: Mike Douglas

Call me ignorant, but what is process affinity:? and help me understand how to apply this code to multi-thread projects. Im a bit weak in the hardcore multi-thread arena, a little help would be cool.
(If this comment was disrespectful, please report it.) 



5/12/2005 1:35:54 PM: Justin Ploski

Press Control-Alt-Delete and open up the Task Manager. Select the Processes tab. If you're running a multiprocessor computer, when you right click on a running process, there will be a "Set Affinity" option. Open that up, and you'll be presented with a list where you can check or uncheck specific processors to use on the process.
(If this comment was disrespectful, please report it.) 



5/13/2005 5:16:28 PM: Richard Mewett

As LiTe says - highly original (and clearly coded). My 5*
(If this comment was disrespectful, please report it.) 



12/22/2006 12:44:50 AM: Dewey

my vb6 crashed when i call GetProcessID any idea why?
(If this comment was disrespectful, please report it.) 



4/21/2010 5:55:18 PM: Carlos

This code did exactly what I needed it to do. Thank you very much!
(If this comment was disrespectful, please report it.) 



8/1/2010 5:23:03 AM: ThePiper

Very interesting code. But why should we shunt the Windows task Scheduler? He optimize the recource-sharing better than we can do ever! ;-)
(If this comment was disrespectful, please report it.) 






Add Your Feedback!

 

Note:Not only will your feedback be posted, but an email will be sent to the code's author from the email account you registered on the site, so you can correspond directly.

NOTICE: The author of this code has been kind enough to share it with you. If you have a criticism, please state it politely or it will be deleted.

For feedback not related to this particular code, please click here.
 
To post feedback, first please login.
 
Quick search forChoose Language….NetASP / VbScriptC / C++Cold FusionDelphiJavaJavascriptPerlPHPSQLVisual BasicSearch Term…Search 

Login