小弟初学,想解决一个问题.
大家都知道,QQ这个软件可以开很多个..就是没有进程上的数量闲置.
一般大家写程序视情况而定都要写入
If App.PrevInstance Then
End
End If
目的是为了防止程序多次运行.现在小弟想做的是..如何限制某个程序多次运行...
例如QQ. 我想最多让他在我的机子上开 3 个..
用程序如何实现?
程序简要说明:
该程序运行时,它可以限制任何程序的打开次数.如果一个程序只能运行1次的话就算了.如果他可以多次运行的话..如何做到最多开启 N 个(N 为自定义数量),例如QQ,它可以开无穷无尽个,但是经过软件的限制后,它只能开我定义的个数,也就是进程中最多有N个QQ.exe(N为自定义..)小弟说的有点罗嗦,希望大家明白我的 意思...
求程序例子源码.谢谢!!!
20 分送上,如果问题解决.再加 50 分. 因为小弟很菜.所以分数不多..还请各位多多体谅.
大家都知道,QQ这个软件可以开很多个..就是没有进程上的数量闲置.
一般大家写程序视情况而定都要写入
If App.PrevInstance Then
End
End If
目的是为了防止程序多次运行.现在小弟想做的是..如何限制某个程序多次运行...
例如QQ. 我想最多让他在我的机子上开 3 个..
用程序如何实现?
程序简要说明:
该程序运行时,它可以限制任何程序的打开次数.如果一个程序只能运行1次的话就算了.如果他可以多次运行的话..如何做到最多开启 N 个(N 为自定义数量),例如QQ,它可以开无穷无尽个,但是经过软件的限制后,它只能开我定义的个数,也就是进程中最多有N个QQ.exe(N为自定义..)小弟说的有点罗嗦,希望大家明白我的 意思...
求程序例子源码.谢谢!!!
20 分送上,如果问题解决.再加 50 分. 因为小弟很菜.所以分数不多..还请各位多多体谅.
————————————————————————————————
模块：
Option Explicit
Public Declare Function Process32First Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function Process32Next Lib "kernel32" ( _
ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Public Declare Function CloseHandle Lib "Kernel32.dll" _
(ByVal Handle As Long) As Long
Public Declare Function OpenProcess Lib "Kernel32.dll" _
(ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, _
ByVal dwProcId As Long) As Long
Public Declare Function EnumProcesses Lib "psapi.dll" _
(ByRef lpidProcess As Long, ByVal cb As Long, _
ByRef cbNeeded As Long) As Long
Public Declare Function GetModuleFileNameExA Lib "psapi.dll" _
(ByVal hProcess As Long, ByVal hModule As Long, _
ByVal ModuleName As String, ByVal nSize As Long) As Long
Public Declare Function EnumProcessModules Lib "psapi.dll" _
(ByVal hProcess As Long, ByRef lphModule As Long, _
ByVal cb As Long, ByRef cbNeeded As Long) As Long
Public Declare Function CreateToolhelp32Snapshot Lib "kernel32" ( _
ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Public Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Public Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long ' This process
th32DefaultHeapID As Long
th32ModuleID As Long ' Associated exe
cntThreads As Long
th32ParentProcessID As Long ' This process's parent process
pcPriClassBase As Long ' Base priority of process threads
dwFlags As Long
szExeFile As String * 260 ' MAX_PATH
End Type
Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long '1 = Windows 95.
'2 = Windows NT
szCSDVersion As String * 128
End Type
Public Const PROCESS_QUERY_INFORMATION = 1024
Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const SYNCHRONIZE = &H100000
'STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0
Function StrZToStr(s As String) As String
StrZToStr = Left$(s, Len(s) - 1)
End Function
Public Function getVersion() As Long
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
getVersion = osinfo.dwPlatformId
End Function
窗体：（一个按钮，一个listbox，如果不需要显示可设为不可见）
Option Explicit
Private Sub Command1_Click()
List1.Clear
Select Case getVersion()
Case 1 'Windows 95/98
Dim f As Long, sname As String
Dim hSnap As Long, proc As PROCESSENTRY32
hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
If hSnap = hNull Then Exit Sub
proc.dwSize = Len(proc)
' Iterate through the processes
f = Process32First(hSnap, proc)
Do While f
sname = StrZToStr(proc.szExeFile)
List1.AddItem sname
f = Process32Next(hSnap, proc)
Loop
Case 2 'Windows NT
Dim cb As Long
Dim cbNeeded As Long
Dim NumElements As Long
Dim ProcessIDs() As Long
Dim cbNeeded2 As Long
Dim NumElements2 As Long
Dim Modules(1 To 200) As Long
Dim lRet As Long
Dim ModuleName As String
Dim nSize As Long
Dim hProcess As Long
Dim i As Long
'Get the array containing the process id's for each process object
cb = 8
cbNeeded = 96
Do While cb <= cbNeeded
cb = cb * 2
ReDim ProcessIDs(cb / 4) As Long
lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
Loop
NumElements = cbNeeded / 4
For i = 1 To NumElements
'Get a handle to the Process
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
Or PROCESS_VM_READ, 0, ProcessIDs(i))
'Got a Process handle
If hProcess <> 0 Then
'Get an array of the module handles for the specified
'process
lRet = EnumProcessModules(hProcess, Modules(1), 200, _
cbNeeded2)
'If the Module Array is retrieved, Get the ModuleFileName
If lRet <> 0 Then
ModuleName = Space(MAX_PATH)
nSize = 500
lRet = GetModuleFileNameExA(hProcess, Modules(1), _
ModuleName, nSize)
List1.AddItem Left(ModuleName, lRet)
End If
End If
'Close the handle to the process
lRet = CloseHandle(hProcess)
Next
End Select
MsgBox IsRun("winamp的路径")
End Sub
Private Function IsRun(ByVal filename As String) As Boolean
Dim i As Long
IsRun = False
For i = 1 To List1.ListCount
Debug.Print List1.List(i)
If List1.List(i) = UCase(filename) Then
IsRun = True
Exit Function
End If
Next
End Function
请来此接分~~~