' 發展單位：風禹科技驗證有限公司
' 撰寫人：鄭子璉(Tzu-Lien, Cheng, 璉璉) ，成大水博肄，微軟最有價值專家
' Web: http://tlcheng.twbbs.org/TLCheng/ E-Mail: qvb3377@ms5.hinet.net
' --------------------------------------------------------------------------------------

Module modProcessTool
#Region "Windows API 宣告"
	''' <summary>指定程序記憶體壓縮整理，移除目前未使用的工作區</summary>
	''' <param name="hProcess">程序代號</param>
	''' <returns>成功傳回非 0 值</returns>
	''' <remarks>Win2000 以後才支援</remarks>
	<Runtime.InteropServices.DllImport("Psapi.DLL", CharSet:=Runtime.InteropServices.CharSet.Auto)> _
	Private Function EmptyWorkingSet( _
		ByVal hProcess As IntPtr _
	) As Integer
	End Function

	<Runtime.InteropServices.DllImport("Kernel32.DLL", CharSet:=Runtime.InteropServices.CharSet.Auto)> _
	Private Function GetCurrentThread() As Integer ' 傳回 hThread
	End Function

	<Runtime.InteropServices.DllImport("Kernel32.DLL", CharSet:=Runtime.InteropServices.CharSet.Auto)> _
	 Private Function GetCurrentThreadId() As Integer ' 傳回 ThreadId
	End Function

	<Runtime.InteropServices.DllImport("Kernel32.DLL", CharSet:=Runtime.InteropServices.CharSet.Auto)> _
	 Private Function GetProcessAffinityMask( _
		ByVal hProcess As IntPtr, _
		ByRef lpProcessAffinityMask As Integer, _
		ByRef lpSystemAffinityMask As Integer _
	 ) As Integer
	End Function

	<Runtime.InteropServices.DllImport("Kernel32.DLL", CharSet:=Runtime.InteropServices.CharSet.Auto)> _
	Public Function FreeLibrary( _
	 ByVal hModule As IntPtr _
	) As Integer
	End Function
#End Region


	''' <summary>所有記憶體壓縮整理，移除目前未使用的工作區，不含系統</summary>
	''' <returns>程序數</returns>
	''' <remarks>Win2000 以後才支援</remarks>
	Friend Function CompressProcessesMemory() As Integer
		Dim ibp As Integer
		Dim arrProcess() As Process = Process.GetProcesses()
		Try
			For ibp = 0 To arrProcess.Length - 1
				CompressProcessMemory(arrProcess(ibp).Handle)
			Next
		Catch ex As Exception
			' 略
		End Try
		Return arrProcess.Length
	End Function

	''' <summary>指定程序記憶體壓縮整理，移除目前未使用的工作區</summary>
	''' <param name="hProcess">程序代號</param>
	''' <returns>成功</returns>
	''' <remarks>Win2000 以後才支援</remarks>
	Friend Function CompressProcessMemory(Optional ByVal hProcess As Integer = 0) As Boolean
		If hProcess = 0 Then hProcess = Process.GetCurrentProcess().Handle
		Return EmptyWorkingSet(New IntPtr(hProcess))
	End Function

	Public Sub SetThreadRunAtProcesser(Optional ByVal threadAffinityMask As Integer = -1)
		Dim pt As ProcessThread = GetCurrentProcessThread()
		pt.ProcessorAffinity = threadAffinityMask
	End Sub

	Private Function GetCurrentProcessThread() As ProcessThread
		Dim nowThreadId As Integer = GetCurrentThreadId()
		Dim colPT As ProcessThreadCollection = Process.GetCurrentProcess().Threads
		For Each pt As ProcessThread In colPT
			If nowThreadId = pt.Id Then Return pt
		Next
	End Function

	Public Function GetProcesserCounts() As Integer
		Dim currentProcess As Process = Process.GetCurrentProcess()
		Dim lpProcessAffinityMask, lpSystemAffinityMask As Integer
		GetProcessAffinityMask(currentProcess.Handle, lpProcessAffinityMask, lpSystemAffinityMask)
		Return Math.Log(lpSystemAffinityMask + 1, 2)
	End Function

	Private Function TerminateProcessByName(ByVal strProcessName As String) As Integer
		Dim arrProcess As Process() = System.Diagnostics.Process.GetProcessesByName(strProcessName)
		Dim ibp, ubp As Integer
		If IsArray(arrProcess) Then
			ubp = UBound(arrProcess)
			For ibp = 0 To UBound(arrProcess)
				arrProcess(ibp).Kill()
			Next
			ubp = ubp + 1
		End If
		Return ubp
	End Function
End Module