There's a utility that works perfectly here. Here's the source code :
just compile, then run it ;)
--------------------------------------------------------------------------------
----------------------------------------------------------------
What is IB_AFFINITY for?
------------------------
IB_AFFINITY is a console mode program that you can use to control the
affinity
mask of the running IBServer.exe process. That means you can predict on
which
processor in your multiprocessor machine IBServer is allowed to run.
IB_AFFINITY does run on Windows NT only, not on Win-9x where multiple
processors aren't supported anyway. The program was compiled with
Delphi-4 (UP3)
and tested on Windows NT-4 (SP5) with IB5.5.
Command line switches:
----------------------
-Q Query current affinity mask
Display the current affinity mask of IBServer.exe and the entire system
before
change.
-An New Affinity mask n (decimal) to set
(n AND system_mask) is the new mask to apply.
-N Dont try to enable SeDebugPrivilege
When you want to change the affinity mask of IBServer runnin as NT
service, you
need the debug privilege. The Administrator account has this privilege by
default. IB_AFFINITY tries to enable this privilege unless you specify
-N. If
you don't have the debug privilege you can for example use -Q -N to
query the
masks without changing them or you can use -An -N to change the
affinity mask of IBServer running as taskbar program.
-Rn,m Retry up to n times with m milliseconds delay to locate IBServer This
option is useful in batches that start IBServer or IBGuardian and modify the
affinity mask of IBServer immediately after. Under high load NT might
not have
finished to create the IBServer process when IB_AFFINITY starts. The retry
option is useful to wait for the IBServer process to be instanciated. An
value
of -R10,10000 is recommended, but will of course delay the return of
this tool
by 100 seconds if IBServer is really not started.
Example 1:
----------
C:\> IB_AFFINITY -Q
Current affinity mask: System=15, IBServer=15
This means you have four system processors installed (15 dec = 1111 bin) and
IBServer is allowed to utilize all four processors.
Example 2:
----------
C:\> IB_AFFINITY -Q -A12
Current affinity mask: System=15, IBServer=15
Affinity mask set to 12
C:\> IB_AFFINITY -Q
Current affinity mask: System=15, IBServer=12
This changes the affinity mask of the IBServer process to 12 (= 1100
bin), so
the process is allowed to run on the system processors 3 and 4.
Disclaimer:
-----------
IB_AFFINITY is freeware. The sourcecode is available. It comes to you AS-IS.
Use it or do not use it, but if you use is, you do it on your own risk.
Author: Karsten Strobel
email : ait-augsburg@t-online.de
Date : 26-JUN-1999
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
program IB_AFFINITY;
{$APPTYPE CONSOLE}
{ Compiled with Delphi4 (UP3) }
uses Windows, Sysutils;
var
MaskToSet: Integer = 0;
SetMask: Boolean = false;
QueryMask: Boolean = false;
NoDebugPrivilege: Boolean = false;
ib_hwnd: THandle = 0;
ib_processid: DWORD = 0;
ib_processh: THandle = 0;
own_token: THandle = 0;
process_affmask: DWORD = 0;
sys_affmask: DWORD = 0;
RetryCountdown: Integer = 0;
RetryDelay: Integer = 0;
function EnumWindowsProc(hwnd: THandle; lParam: DWORD): Boolean; stdcall;
var
s: string;
i: Integer;
begin
SetLength(s, 256);
i := GetWindowText(hwnd, @(s[1]), 256);
SetLength(s, i);
Result := s <> 'InterBase Server';
if not Result then ib_hwnd := hwnd;
end;
function MyAdjustTokenPrivileges(TokenHandle: THandle;
DisableAllPrivileges: BOOL;
const NewState: TTokenPrivileges; BufferLength: DWORD;
PreviousState: PTokenPrivileges; ReturnLength: PDWORD): BOOL; stdcall;
external advapi32 name 'AdjustTokenPrivileges';
function EnablePrivilege(h: THandle; AName: string; AState: Boolean):
Boolean;
var
tp: TTokenPrivileges;
begin
Result := false;
if not LookupPrivilegeValue(nil, PChar(AName), tp.Privileges[0].Luid)
then Exit;
tp.PrivilegeCount := 1;
if AState then tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else tp.Privileges[0].Attributes := 0;
Result := MyAdjustTokenPrivileges(h, false, tp, SizeOf(tp), nil, nil);
end;
procedure PrintHelp;
begin
writeln('With IB_AFFINITY you can control the affinity mask of the
IBServer process.');
writeln('IB_AFFINITY is freeware and comes AS-IS. Use it on your own
risk.');
writeln('IB_AFFINITY has been tested with Interbase V5.5 on Windows
NT4.');
writeln('V1.1, Author: Karsten Strobel');
writeln;
writeln('Available switches:');
writeln(' -Q Query current affinity mask');
writeln(' -An New Affinity mask n (decimal) to set');
writeln(' -N Don''t try to enable SeDebugPrivilege');
writeln(' -Rn,m Retry up to n times with m millisec. delay to
locate IBServer');
writeln;
Halt(1);
end;
var
i, j, k: Integer;
s: string;
begin
try
//eval cmdline switches
for i := 1 to ParamCount do
begin
s := UpperCase(ParamStr(i));
if s[1] <> '-' then PrintHelp;
case s[2] of
'A': begin
Delete(s, 1, 2);
MaskToSet := StrToIntDef(s, -1);
if (MaskToSet <= 0) or SetMask then PrintHelp;
SetMask := true;
end;
'Q': begin
if (Length(s) > 2) or QueryMask then PrintHelp;
QueryMask := true;
end;
'N': begin
if (Length(s) > 2) or NoDebugPrivilege then PrintHelp;
NoDebugPrivilege := true;
end;
'R': begin
Delete(s, 1, 2);
k := Pos(',', s);
if k = 0 then PrintHelp;
j := StrToIntDef(copy(s, 1, k-1), -1);
k := StrToIntDef(copy(s, k+1, Length(s)), -1);
if (j <= 0) or (k < 0) or (RetryCountdown > 0) then
PrintHelp;
RetryCountdown := j;
RetryDelay := k;
end;
else
PrintHelp;
end;
end;
if not (SetMask or QueryMask) then PrintHelp;
//check NT is running
if Win32Platform <> VER_PLATFORM_WIN32_NT then
raise Exception.Create('IB_AFFINITY requires Windows NT.');
//find running IBServer
repeat
EnumWindows(@EnumWindowsProc, 0);
if (ib_hwnd <> 0) or (RetryCountdown <= 0) then system.break;
Sleep(RetryDelay);
Dec(RetryCountdown);
until false;
if ib_hwnd = 0 then
raise Exception.Create('Unable to find IBServer process. Not
running?');
if GetWindowThreadProcessId(ib_hwnd, @ib_processid) = 0 then
RaiseLastWin32Error;
//enable SeDebugPrivilege
//(needed to be able to set affinity mask if IBServer runs as
service using the system account)
if not NoDebugPrivilege then
begin
Win32Check(OpenProcessToken(GetCurrentProcess,
TOKEN_ADJUST_PRIVILEGES, own_token));
Win32Check(EnablePrivilege(own_token, 'SeDebugPrivilege', true));
end;
//get handle of IBServer process
i := PROCESS_QUERY_INFORMATION;
if SetMask then i := i or PROCESS_SET_INFORMATION;
ib_processh := OpenProcess(i, false, ib_processid);
if ib_processh = 0 then RaiseLastWin32Error;
try
//query current affinity mask
Win32Check(GetProcessAffinityMask(ib_processh, process_affmask,
sys_affmask));
if QueryMask then
writeln(Format('Current affinity mask: System=%d, IBServer=%d',
[sys_affmask, process_affmask]));
//set new affinity mask
if SetMask then
begin
Win32Check(SetProcessAffinityMask(ib_processh, MaskToSet and
sys_affmask));
writeln(Format('Affinity mask set to %d', [MaskToSet and
sys_affmask]));
end;
finally
CloseHandle(ib_processh);
end;
except
on E:Exception do
begin
s := E.Message + #13#10;
WriteFile(GetStdHandle(STD_ERROR_HANDLE), s[1], Length(s),
DWORD(i), nil);
ExitCode := 1;
end;
end;
|