Unit ExThreads;
 
interface
 
uses
  Windows, Classes;
 
Function StartThread(ThreadFunc: TThreadFunc):LongInt;
Procedure StopThread(TID:Pointer);
 
Procedure Thread_SetAffinity(TID:Integer; CpuCoreID:Byte);  // 0 1 2 = 3 Core | 0 1 2 3 = 4 Core
Procedure Thread_Activate(TID:Pointer);
 Function Thread_IsActive(TID:Integer):Boolean;
 Function Thread_ActiveCount:LongInt;
 
Procedure Prms_Add(TID:Pointer; Prm:String);
Procedure Prms_Add_Ex(TID:LongInt; Prm:String);
 
Procedure Prms_Del(TID:Pointer; PrmID:LongInt);
 Function Prms_Get(TID:Pointer; PrmID:LongInt):String;
 
 Function Prms_Count(TID:Pointer):LongInt;
 
Function Process_SetAffinity(AProcessID: Cardinal; AProcessAffinity: Cardinal): Boolean;
 
Function System_GetNumberOfProcessors:Byte;
 
Implementation
 
function CallNtPowerInformation(InformationLevel: DWORD; InPutBuffer: Pointer; InputBufferSize: ULONG; OutPutBuffer:  Pointer; OutPutBufferSize: ULONG): DWORD; stdcall; external 'powrprof.dll';
 
Const
 MaxThread=2000;
 
Var
 ThreadActive:Boolean=False;
 Threads:Array[1..MaxThread] Of THandle;
 Threads_Activate:Array[1..MaxThread] Of Boolean;
    Prms:Array[1..MaxThread] Of TStringList;
 
Procedure Prms_Add(TID:Pointer; Prm:String);
Begin
 Prms[Integer(TID)].Add(Prm);
End;
 
Procedure Prms_Add_Ex(TID:LongInt; Prm:String);
Begin
 Prms[TID].Add(Prm);
End;
 
Procedure Prms_Del(TID:Pointer; PrmID:LongInt);
Begin
 Prms[Integer(TID)].Delete(PrmID);
End;
 
Function Prms_Get(TID:Pointer; PrmID:LongInt):String;
Begin
 Result:=Prms[Integer(TID)].Strings[PrmID];
End;
 
Function Prms_Count(TID:Pointer):LongInt;
Begin
 Result:=Prms[Integer(TID)].Count;
End;
 
Function GetEmty_TID:LongInt;
Var
 I:LongInt;
 
Begin
 Result:=0;
 For I:=1 To MaxThread Do
 Begin
  If Threads[I]=0 Then
  Begin
   Result:=I;
   Exit;
  End;
 End;
End;
 
Function Thread_ActiveCount:LongInt;
Var
 I:LongInt;
 
Begin
 Result:=0;
 For I:=1 To MaxThread Do
 Begin
  If Threads[I]>0 Then
  Begin
   Result:=Result+1;
  End;
 End;
End;
 
Function Process_SetAffinity(AProcessID: Cardinal; AProcessAffinity: Cardinal): Boolean;
var
  ProcessHandle: Integer;
begin
    ProcessHandle := OpenProcess( PROCESS_SET_INFORMATION, False, AProcessID);
    Result :=  SetProcessAffinityMask( ProcessHandle, AProcessAffinity);
end;
 
Function Thread_IsActive(TID:Integer):Boolean;
Begin
 Result:=Threads_Activate[TID];
End;
 
Procedure Thread_Activate(TID:Pointer);
Begin
 Threads_Activate[Integer(TID)]:=True;
End;
 
Procedure Thread_SetAffinity(TID:Integer; CpuCoreID:Byte); // 0 1 2 = 3 Core | 0 1 2 3 = 4 Core
Begin
 SetThreadAffinityMask(Threads[TID], CpuCoreID);
End;
 
Procedure StopThread(TID:Pointer);
Begin
 Sleep(1000);
 CloseHandle(Threads[Integer(TID)]);
 Threads[Integer(TID)]:=0;
 Prms[Integer(TID)].Destroy;
 Threads_Activate[Integer(TID)]:=False;
End;
 
Function System_GetNumberOfProcessors:Byte;
var
 size, ret: Cardinal;
 PowerInfos: Pointer;
 SysInfo: SYSTEM_INFO;
 
begin
 Result:=1;
 GetSystemInfo(SysInfo);
 size :=  SysInfo.dwNumberOfProcessors;
 GetMem(PowerInfos, size);
 ZeroMemory(PowerInfos, size);
 ret := CallNTPowerInformation(11, nil, 0, PowerInfos, size);
 If ret = ERROR_SUCCESS then
 begin
  Result:=SysInfo.dwNumberOfProcessors;
 end;
 FreeMem(PowerInfos, size);
end;
 
Function StartThread(ThreadFunc: TThreadFunc):LongInt;
Var
 Temp:DWORD;
  TID:LongInt;
 
Begin
 Result:=0;
 TID:=GetEmty_TID;
 If TID>0 Then
 Begin
  Try
   Threads_Activate[TID]:=False;
   Prms[TID]:=TStringList.Create;
   Prms[TID].Clear;
   Threads[TID]:=BeginThread(nil, 0, Addr(ThreadFunc), Pointer(TID), 0, Temp);
   SetThreadPriority(Threads[TID], THREAD_PRIORITY_NORMAL);
   Repeat
    Sleep(1);
   Until (Threads_Activate[TID]=True);
   Result:=TID;
  Except
   StopThread(Pointer(TID));
   Result:=0;
  End;
 End;
End;
 
End.