切换导航
首页
技术问答
编程语言
前端开发
移动开发
开发工具
程序设计
行业应用
CMS系统
服务器
频道导航
▸ PHP
▸ Java
▸ Java SE
▸ Python
▸ C#
▸ C&C++
▸ Ruby
▸ VB
▸ asp.Net
▸ Go
▸ Perl
▸ netty
▸ Django
▸ Delphi
▸ Jsp
▸ .NET Core
▸ Spring
▸ Flask
▸ Springboot
▸ SpringMVC
▸ Lua
▸ Laravel
▸ Mybatis
▸ Asp
▸ Groovy
▸ ThinkPHP
▸ Yii
▸ swoole
▸ HTML
▸ HTML5
▸ JavaScript
▸ CSS
▸ jQuery
▸ Bootstrap
▸ Angularjs
▸ TypeScript
▸ Vue
▸ Dojo
▸ Json
▸ Electron
▸ Node.js
▸ extjs
▸ Express
▸ XML
▸ ES6
▸ Ajax
▸ Flash
▸ Unity
▸ React
▸ Flex
▸ Ant Design
▸ Web前端
▸ 微信小程序
▸ 微信公众号
▸ iOS
▸ Android
▸ Swift
▸ Hybrid
▸ Cocos2d-x
▸ Flutter
▸ Xcode
▸ Silverlight
▸ cocoa
▸ Cordova
前端之家
VB
在VB中如何让线程或进程在指定的CPU上运行
在VB中如何让线程或进程在指定的CPU上运行
2019-09-01
VB
前端之家
前端之家
收集整理的这篇文章主要介绍了
在VB中如何让线程或进程在指定的CPU上运行
,
前端之家
小编觉得挺不错的,现在分享给大家,也给大家做个参考。
@H_
502
_0@
Option Explicit Private Declare Function WTSEnumerateProcesses Lib "wtsapi32.dll" Alias "WTSEnumerateProcessesA" (ByVal hServer As Long,ByVal Reserved As Long,ByVal Version As Long,ByRef ppProcessInfo As Long,ByRef pCount As Long) As Long Private Declare Function SetProcessAffinityMask Lib "kernel32.dll" (ByVal hProcess As Long,ByVal dwProcessAffinityMask As Long) As Long Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long,ByVal bInheritHandle As Long,ByVal dwProcId As Long) As Long Private Declare Sub WTSFreeMemory Lib "wtsapi32.dll" (ByVal pMemory As Long) Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any,Source As Any,ByVal Length As Long) Private Const WTS_CURRENT_SERVER_HANDLE = 0& Private Type WTS_PROCESS_INFO SessionID As Long ProcessID As Long pProcessName As Long pUserSid As Long End Type 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 Msg
Box
"Could Not Get process ID of " & strImageName,vbCritical,"Error" Exit Sub End If lngHwndProcess = OpenProcess(PROCESS_ALL_ACCESS,lngPID) If lngHwndProcess = 0 Then Msg
Box
"Could Not obtain a handle For the Process ID: " & lngPID,"Error" Exit Sub End If BitMasks() = GetBitMasks(AffinityMask) 'Use
cpu
0 MyMask = BitMasks(0) 'Use
cpu
1 'MyMask = BitMasks(1) 'Use
cpu
0 and
cpu
1 'MyMask = BitMasks(0) Or BitMasks(1) 'The
cpu
s to use are specified by the array index. 'To use
cpu
s 0,2,and 4,you would use: 'MyMask = BitMasks(0) Or BitMasks(2) Or BitMasks(4) 'To Set Affinity,pass the application h ' andle 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 Msg
Box
"Affinity Set",vbInformation,"Success" Else Msg
Box
"
Failed
To Set Affinity","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 'Msg
Box
"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 Msg
Box
"Error","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
上一篇:VB 属性集
下一篇:用VB实现循环队列算法收藏
猜你在找的VB相关文章
VB Format函数
Format[$] ( expr [ , fmt ] ) format 返回变体型 format$ 强制返回为文本 --------------...
作者:前端之家 时间:2020-08-07
vb6/ASP FORMAT MM/DD/YYYY
VB6或者ASP 格式化时间为 MM/dd/yyyy 格式,竟然没有好的办法, Format 或者FormatDateTi...
作者:前端之家 时间:2020-08-07
VB.net 捕获项目全局异常
在项目中添加如下代码:新建窗口来显示异常信息。 Namespace My ‘全局错误处理,新的...
作者:前端之家 时间:2020-08-07
实现用VB.Net/(C#)开发K/3 BOS 插件的真正可行方法
转了这一篇文章,原来一直想用C#做k3的插件开发,vb没有C#用的爽呀,这篇文章写与2011年,...
作者:前端之家 时间:2020-08-07
vb,wps,excel 分裂
Sub 分列() ‘以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m...
作者:前端之家 时间:2020-08-07
VB.NET MYSQL DataGridView 增删改查(INSERT,SELECT,UPDATE,DELETE)
Imports MySql.Data.MySqlClient Public Class Form1 ‘ GLOBAL DECLARATIONS ...
作者:前端之家 时间:2020-08-07
VB.NET 使用ADODB連接資料庫滙出到EXCEL
‘導入命名空間 Imports ADODB Imports Microsoft.Office.Interop Private Sub A1() Di...
作者:前端之家 时间:2020-08-07
vb.net 多线程運用 ping
Imports System.IO Imports System.Threading Imports System.Diagnostics Public Class F...
作者:前端之家 时间:2020-08-07
VB等待进程结束
VB运行EXE程序,并等待其运行结束 参考:https://blog.csdn.net/useway/article/details/5...
作者:前端之家 时间:2020-08-07
vb中去掉string数组的一部分
今天碰到一个问题,登陆的时候,如果不需要验证手机号为空,则不去验证手机号 因为登陆的时...
作者:前端之家 时间:2020-08-07
编程分类
PHP
Java
Java SE
Python
C#
C&C++
Ruby
VB
asp.Net
Go
Perl
netty
Django
Delphi
Jsp
.NET Core
Spring
Flask
Springboot
SpringMVC
Lua
Laravel
Mybatis
Asp
Groovy
ThinkPHP
Yii
swoole
最新文章
• VB Format函数
• vb6/ASP FORMAT MM/DD/YYY
• VB.net 捕获项目全局异常
• 实现用VB.Net/(C#)开发K/3
• vb,wps,excel 分裂
• VB文件 hash 查看器
• VB.NET MYSQL DataGridVie
• VB.NET 使用ADODB連接資料
• vb.net 多线程運用 ping
• VB等待进程结束
热门标签
更多 ►
文件时间
pythonm
相等性
PHP Warning
时间问题
问题解决
pcntl_signal
采样点
wav模块
动态文本
调用频率限制
对外暴露
多个访问请求
更新数据表
模型结构
type()方法
比较速度
手写体
sobel算子
保存模型
Image类
nn.Conv2d
pytorch1.0
kaggle
DCGAN
交并比
range()用法
打印模型
反卷积
卷积